daemon: write-file: Check range of size parameter (RHBZ#597135).
[libguestfs.git] / src / 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, [OptString "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, [OptString "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 dynamic linker functions
795 to find out if this symbol exists (if it doesn't, then
796 it's an earlier version).
797
798 The call returns a structure with four elements.  The first
799 three (C<major>, C<minor> and C<release>) are numbers and
800 correspond to the usual version triplet.  The fourth element
801 (C<extra>) is a string and is normally empty, but may be
802 used for distro-specific information.
803
804 To construct the original version string:
805 C<$major.$minor.$release$extra>
806
807 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
808
809 I<Note:> Don't use this call to test for availability
810 of features.  In enterprise distributions we backport
811 features from later versions into earlier versions,
812 making this an unreliable way to test for features.
813 Use C<guestfs_available> instead.");
814
815   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
816    [InitNone, Always, TestOutputTrue (
817       [["set_selinux"; "true"];
818        ["get_selinux"]])],
819    "set SELinux enabled or disabled at appliance boot",
820    "\
821 This sets the selinux flag that is passed to the appliance
822 at boot time.  The default is C<selinux=0> (disabled).
823
824 Note that if SELinux is enabled, it is always in
825 Permissive mode (C<enforcing=0>).
826
827 For more information on the architecture of libguestfs,
828 see L<guestfs(3)>.");
829
830   ("get_selinux", (RBool "selinux", []), -1, [],
831    [],
832    "get SELinux enabled flag",
833    "\
834 This returns the current setting of the selinux flag which
835 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
836
837 For more information on the architecture of libguestfs,
838 see L<guestfs(3)>.");
839
840   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
841    [InitNone, Always, TestOutputFalse (
842       [["set_trace"; "false"];
843        ["get_trace"]])],
844    "enable or disable command traces",
845    "\
846 If the command trace flag is set to 1, then commands are
847 printed on stdout before they are executed in a format
848 which is very similar to the one used by guestfish.  In
849 other words, you can run a program with this enabled, and
850 you will get out a script which you can feed to guestfish
851 to perform the same set of actions.
852
853 If you want to trace C API calls into libguestfs (and
854 other libraries) then possibly a better way is to use
855 the external ltrace(1) command.
856
857 Command traces are disabled unless the environment variable
858 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
859
860   ("get_trace", (RBool "trace", []), -1, [],
861    [],
862    "get command trace enabled flag",
863    "\
864 Return the command trace flag.");
865
866   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
867    [InitNone, Always, TestOutputFalse (
868       [["set_direct"; "false"];
869        ["get_direct"]])],
870    "enable or disable direct appliance mode",
871    "\
872 If the direct appliance mode flag is enabled, then stdin and
873 stdout are passed directly through to the appliance once it
874 is launched.
875
876 One consequence of this is that log messages aren't caught
877 by the library and handled by C<guestfs_set_log_message_callback>,
878 but go straight to stdout.
879
880 You probably don't want to use this unless you know what you
881 are doing.
882
883 The default is disabled.");
884
885   ("get_direct", (RBool "direct", []), -1, [],
886    [],
887    "get direct appliance mode flag",
888    "\
889 Return the direct appliance mode flag.");
890
891   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
892    [InitNone, Always, TestOutputTrue (
893       [["set_recovery_proc"; "true"];
894        ["get_recovery_proc"]])],
895    "enable or disable the recovery process",
896    "\
897 If this is called with the parameter C<false> then
898 C<guestfs_launch> does not create a recovery process.  The
899 purpose of the recovery process is to stop runaway qemu
900 processes in the case where the main program aborts abruptly.
901
902 This only has any effect if called before C<guestfs_launch>,
903 and the default is true.
904
905 About the only time when you would want to disable this is
906 if the main process will fork itself into the background
907 (\"daemonize\" itself).  In this case the recovery process
908 thinks that the main program has disappeared and so kills
909 qemu, which is not very helpful.");
910
911   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
912    [],
913    "get recovery process enabled flag",
914    "\
915 Return the recovery process enabled flag.");
916
917   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
918    [],
919    "add a drive specifying the QEMU block emulation to use",
920    "\
921 This is the same as C<guestfs_add_drive> but it allows you
922 to specify the QEMU interface emulation to use at run time.");
923
924   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
925    [],
926    "add a drive read-only specifying the QEMU block emulation to use",
927    "\
928 This is the same as C<guestfs_add_drive_ro> but it allows you
929 to specify the QEMU interface emulation to use at run time.");
930
931 ]
932
933 (* daemon_functions are any functions which cause some action
934  * to take place in the daemon.
935  *)
936
937 let daemon_functions = [
938   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
939    [InitEmpty, Always, TestOutput (
940       [["part_disk"; "/dev/sda"; "mbr"];
941        ["mkfs"; "ext2"; "/dev/sda1"];
942        ["mount"; "/dev/sda1"; "/"];
943        ["write_file"; "/new"; "new file contents"; "0"];
944        ["cat"; "/new"]], "new file contents")],
945    "mount a guest disk at a position in the filesystem",
946    "\
947 Mount a guest disk at a position in the filesystem.  Block devices
948 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
949 the guest.  If those block devices contain partitions, they will have
950 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
951 names can be used.
952
953 The rules are the same as for L<mount(2)>:  A filesystem must
954 first be mounted on C</> before others can be mounted.  Other
955 filesystems can only be mounted on directories which already
956 exist.
957
958 The mounted filesystem is writable, if we have sufficient permissions
959 on the underlying device.
960
961 B<Important note:>
962 When you use this call, the filesystem options C<sync> and C<noatime>
963 are set implicitly.  This was originally done because we thought it
964 would improve reliability, but it turns out that I<-o sync> has a
965 very large negative performance impact and negligible effect on
966 reliability.  Therefore we recommend that you avoid using
967 C<guestfs_mount> in any code that needs performance, and instead
968 use C<guestfs_mount_options> (use an empty string for the first
969 parameter if you don't want any options).");
970
971   ("sync", (RErr, []), 2, [],
972    [ InitEmpty, Always, TestRun [["sync"]]],
973    "sync disks, writes are flushed through to the disk image",
974    "\
975 This syncs the disk, so that any writes are flushed through to the
976 underlying disk image.
977
978 You should always call this if you have modified a disk image, before
979 closing the handle.");
980
981   ("touch", (RErr, [Pathname "path"]), 3, [],
982    [InitBasicFS, Always, TestOutputTrue (
983       [["touch"; "/new"];
984        ["exists"; "/new"]])],
985    "update file timestamps or create a new file",
986    "\
987 Touch acts like the L<touch(1)> command.  It can be used to
988 update the timestamps on a file, or, if the file does not exist,
989 to create a new zero-length file.");
990
991   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
992    [InitISOFS, Always, TestOutput (
993       [["cat"; "/known-2"]], "abcdef\n")],
994    "list the contents of a file",
995    "\
996 Return the contents of the file named C<path>.
997
998 Note that this function cannot correctly handle binary files
999 (specifically, files containing C<\\0> character which is treated
1000 as end of string).  For those you need to use the C<guestfs_read_file>
1001 or C<guestfs_download> functions which have a more complex interface.");
1002
1003   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1004    [], (* XXX Tricky to test because it depends on the exact format
1005         * of the 'ls -l' command, which changes between F10 and F11.
1006         *)
1007    "list the files in a directory (long format)",
1008    "\
1009 List the files in C<directory> (relative to the root directory,
1010 there is no cwd) in the format of 'ls -la'.
1011
1012 This command is mostly useful for interactive sessions.  It
1013 is I<not> intended that you try to parse the output string.");
1014
1015   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1016    [InitBasicFS, Always, TestOutputList (
1017       [["touch"; "/new"];
1018        ["touch"; "/newer"];
1019        ["touch"; "/newest"];
1020        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1021    "list the files in a directory",
1022    "\
1023 List the files in C<directory> (relative to the root directory,
1024 there is no cwd).  The '.' and '..' entries are not returned, but
1025 hidden files are shown.
1026
1027 This command is mostly useful for interactive sessions.  Programs
1028 should probably use C<guestfs_readdir> instead.");
1029
1030   ("list_devices", (RStringList "devices", []), 7, [],
1031    [InitEmpty, Always, TestOutputListOfDevices (
1032       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1033    "list the block devices",
1034    "\
1035 List all the block devices.
1036
1037 The full block device names are returned, eg. C</dev/sda>");
1038
1039   ("list_partitions", (RStringList "partitions", []), 8, [],
1040    [InitBasicFS, Always, TestOutputListOfDevices (
1041       [["list_partitions"]], ["/dev/sda1"]);
1042     InitEmpty, Always, TestOutputListOfDevices (
1043       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1044        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1045    "list the partitions",
1046    "\
1047 List all the partitions detected on all block devices.
1048
1049 The full partition device names are returned, eg. C</dev/sda1>
1050
1051 This does not return logical volumes.  For that you will need to
1052 call C<guestfs_lvs>.");
1053
1054   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1055    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1056       [["pvs"]], ["/dev/sda1"]);
1057     InitEmpty, Always, TestOutputListOfDevices (
1058       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1059        ["pvcreate"; "/dev/sda1"];
1060        ["pvcreate"; "/dev/sda2"];
1061        ["pvcreate"; "/dev/sda3"];
1062        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1063    "list the LVM physical volumes (PVs)",
1064    "\
1065 List all the physical volumes detected.  This is the equivalent
1066 of the L<pvs(8)> command.
1067
1068 This returns a list of just the device names that contain
1069 PVs (eg. C</dev/sda2>).
1070
1071 See also C<guestfs_pvs_full>.");
1072
1073   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1074    [InitBasicFSonLVM, Always, TestOutputList (
1075       [["vgs"]], ["VG"]);
1076     InitEmpty, Always, TestOutputList (
1077       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1078        ["pvcreate"; "/dev/sda1"];
1079        ["pvcreate"; "/dev/sda2"];
1080        ["pvcreate"; "/dev/sda3"];
1081        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1082        ["vgcreate"; "VG2"; "/dev/sda3"];
1083        ["vgs"]], ["VG1"; "VG2"])],
1084    "list the LVM volume groups (VGs)",
1085    "\
1086 List all the volumes groups detected.  This is the equivalent
1087 of the L<vgs(8)> command.
1088
1089 This returns a list of just the volume group names that were
1090 detected (eg. C<VolGroup00>).
1091
1092 See also C<guestfs_vgs_full>.");
1093
1094   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1095    [InitBasicFSonLVM, Always, TestOutputList (
1096       [["lvs"]], ["/dev/VG/LV"]);
1097     InitEmpty, Always, TestOutputList (
1098       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1099        ["pvcreate"; "/dev/sda1"];
1100        ["pvcreate"; "/dev/sda2"];
1101        ["pvcreate"; "/dev/sda3"];
1102        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1103        ["vgcreate"; "VG2"; "/dev/sda3"];
1104        ["lvcreate"; "LV1"; "VG1"; "50"];
1105        ["lvcreate"; "LV2"; "VG1"; "50"];
1106        ["lvcreate"; "LV3"; "VG2"; "50"];
1107        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1108    "list the LVM logical volumes (LVs)",
1109    "\
1110 List all the logical volumes detected.  This is the equivalent
1111 of the L<lvs(8)> command.
1112
1113 This returns a list of the logical volume device names
1114 (eg. C</dev/VolGroup00/LogVol00>).
1115
1116 See also C<guestfs_lvs_full>.");
1117
1118   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1119    [], (* XXX how to test? *)
1120    "list the LVM physical volumes (PVs)",
1121    "\
1122 List all the physical volumes detected.  This is the equivalent
1123 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1124
1125   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1126    [], (* XXX how to test? *)
1127    "list the LVM volume groups (VGs)",
1128    "\
1129 List all the volumes groups detected.  This is the equivalent
1130 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1131
1132   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1133    [], (* XXX how to test? *)
1134    "list the LVM logical volumes (LVs)",
1135    "\
1136 List all the logical volumes detected.  This is the equivalent
1137 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1138
1139   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1140    [InitISOFS, Always, TestOutputList (
1141       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1142     InitISOFS, Always, TestOutputList (
1143       [["read_lines"; "/empty"]], [])],
1144    "read file as lines",
1145    "\
1146 Return the contents of the file named C<path>.
1147
1148 The file contents are returned as a list of lines.  Trailing
1149 C<LF> and C<CRLF> character sequences are I<not> returned.
1150
1151 Note that this function cannot correctly handle binary files
1152 (specifically, files containing C<\\0> character which is treated
1153 as end of line).  For those you need to use the C<guestfs_read_file>
1154 function which has a more complex interface.");
1155
1156   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1157    [], (* XXX Augeas code needs tests. *)
1158    "create a new Augeas handle",
1159    "\
1160 Create a new Augeas handle for editing configuration files.
1161 If there was any previous Augeas handle associated with this
1162 guestfs session, then it is closed.
1163
1164 You must call this before using any other C<guestfs_aug_*>
1165 commands.
1166
1167 C<root> is the filesystem root.  C<root> must not be NULL,
1168 use C</> instead.
1169
1170 The flags are the same as the flags defined in
1171 E<lt>augeas.hE<gt>, the logical I<or> of the following
1172 integers:
1173
1174 =over 4
1175
1176 =item C<AUG_SAVE_BACKUP> = 1
1177
1178 Keep the original file with a C<.augsave> extension.
1179
1180 =item C<AUG_SAVE_NEWFILE> = 2
1181
1182 Save changes into a file with extension C<.augnew>, and
1183 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1184
1185 =item C<AUG_TYPE_CHECK> = 4
1186
1187 Typecheck lenses (can be expensive).
1188
1189 =item C<AUG_NO_STDINC> = 8
1190
1191 Do not use standard load path for modules.
1192
1193 =item C<AUG_SAVE_NOOP> = 16
1194
1195 Make save a no-op, just record what would have been changed.
1196
1197 =item C<AUG_NO_LOAD> = 32
1198
1199 Do not load the tree in C<guestfs_aug_init>.
1200
1201 =back
1202
1203 To close the handle, you can call C<guestfs_aug_close>.
1204
1205 To find out more about Augeas, see L<http://augeas.net/>.");
1206
1207   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1208    [], (* XXX Augeas code needs tests. *)
1209    "close the current Augeas handle",
1210    "\
1211 Close the current Augeas handle and free up any resources
1212 used by it.  After calling this, you have to call
1213 C<guestfs_aug_init> again before you can use any other
1214 Augeas functions.");
1215
1216   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1217    [], (* XXX Augeas code needs tests. *)
1218    "define an Augeas variable",
1219    "\
1220 Defines an Augeas variable C<name> whose value is the result
1221 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1222 undefined.
1223
1224 On success this returns the number of nodes in C<expr>, or
1225 C<0> if C<expr> evaluates to something which is not a nodeset.");
1226
1227   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1228    [], (* XXX Augeas code needs tests. *)
1229    "define an Augeas node",
1230    "\
1231 Defines a variable C<name> whose value is the result of
1232 evaluating C<expr>.
1233
1234 If C<expr> evaluates to an empty nodeset, a node is created,
1235 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1236 C<name> will be the nodeset containing that single node.
1237
1238 On success this returns a pair containing the
1239 number of nodes in the nodeset, and a boolean flag
1240 if a node was created.");
1241
1242   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1243    [], (* XXX Augeas code needs tests. *)
1244    "look up the value of an Augeas path",
1245    "\
1246 Look up the value associated with C<path>.  If C<path>
1247 matches exactly one node, the C<value> is returned.");
1248
1249   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1250    [], (* XXX Augeas code needs tests. *)
1251    "set Augeas path to value",
1252    "\
1253 Set the value associated with C<path> to C<value>.");
1254
1255   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1256    [], (* XXX Augeas code needs tests. *)
1257    "insert a sibling Augeas node",
1258    "\
1259 Create a new sibling C<label> for C<path>, inserting it into
1260 the tree before or after C<path> (depending on the boolean
1261 flag C<before>).
1262
1263 C<path> must match exactly one existing node in the tree, and
1264 C<label> must be a label, ie. not contain C</>, C<*> or end
1265 with a bracketed index C<[N]>.");
1266
1267   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1268    [], (* XXX Augeas code needs tests. *)
1269    "remove an Augeas path",
1270    "\
1271 Remove C<path> and all of its children.
1272
1273 On success this returns the number of entries which were removed.");
1274
1275   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1276    [], (* XXX Augeas code needs tests. *)
1277    "move Augeas node",
1278    "\
1279 Move the node C<src> to C<dest>.  C<src> must match exactly
1280 one node.  C<dest> is overwritten if it exists.");
1281
1282   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1283    [], (* XXX Augeas code needs tests. *)
1284    "return Augeas nodes which match augpath",
1285    "\
1286 Returns a list of paths which match the path expression C<path>.
1287 The returned paths are sufficiently qualified so that they match
1288 exactly one node in the current tree.");
1289
1290   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1291    [], (* XXX Augeas code needs tests. *)
1292    "write all pending Augeas changes to disk",
1293    "\
1294 This writes all pending changes to disk.
1295
1296 The flags which were passed to C<guestfs_aug_init> affect exactly
1297 how files are saved.");
1298
1299   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1300    [], (* XXX Augeas code needs tests. *)
1301    "load files into the tree",
1302    "\
1303 Load files into the tree.
1304
1305 See C<aug_load> in the Augeas documentation for the full gory
1306 details.");
1307
1308   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1309    [], (* XXX Augeas code needs tests. *)
1310    "list Augeas nodes under augpath",
1311    "\
1312 This is just a shortcut for listing C<guestfs_aug_match>
1313 C<path/*> and sorting the resulting nodes into alphabetical order.");
1314
1315   ("rm", (RErr, [Pathname "path"]), 29, [],
1316    [InitBasicFS, Always, TestRun
1317       [["touch"; "/new"];
1318        ["rm"; "/new"]];
1319     InitBasicFS, Always, TestLastFail
1320       [["rm"; "/new"]];
1321     InitBasicFS, Always, TestLastFail
1322       [["mkdir"; "/new"];
1323        ["rm"; "/new"]]],
1324    "remove a file",
1325    "\
1326 Remove the single file C<path>.");
1327
1328   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1329    [InitBasicFS, Always, TestRun
1330       [["mkdir"; "/new"];
1331        ["rmdir"; "/new"]];
1332     InitBasicFS, Always, TestLastFail
1333       [["rmdir"; "/new"]];
1334     InitBasicFS, Always, TestLastFail
1335       [["touch"; "/new"];
1336        ["rmdir"; "/new"]]],
1337    "remove a directory",
1338    "\
1339 Remove the single directory C<path>.");
1340
1341   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1342    [InitBasicFS, Always, TestOutputFalse
1343       [["mkdir"; "/new"];
1344        ["mkdir"; "/new/foo"];
1345        ["touch"; "/new/foo/bar"];
1346        ["rm_rf"; "/new"];
1347        ["exists"; "/new"]]],
1348    "remove a file or directory recursively",
1349    "\
1350 Remove the file or directory C<path>, recursively removing the
1351 contents if its a directory.  This is like the C<rm -rf> shell
1352 command.");
1353
1354   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1355    [InitBasicFS, Always, TestOutputTrue
1356       [["mkdir"; "/new"];
1357        ["is_dir"; "/new"]];
1358     InitBasicFS, Always, TestLastFail
1359       [["mkdir"; "/new/foo/bar"]]],
1360    "create a directory",
1361    "\
1362 Create a directory named C<path>.");
1363
1364   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1365    [InitBasicFS, Always, TestOutputTrue
1366       [["mkdir_p"; "/new/foo/bar"];
1367        ["is_dir"; "/new/foo/bar"]];
1368     InitBasicFS, Always, TestOutputTrue
1369       [["mkdir_p"; "/new/foo/bar"];
1370        ["is_dir"; "/new/foo"]];
1371     InitBasicFS, Always, TestOutputTrue
1372       [["mkdir_p"; "/new/foo/bar"];
1373        ["is_dir"; "/new"]];
1374     (* Regression tests for RHBZ#503133: *)
1375     InitBasicFS, Always, TestRun
1376       [["mkdir"; "/new"];
1377        ["mkdir_p"; "/new"]];
1378     InitBasicFS, Always, TestLastFail
1379       [["touch"; "/new"];
1380        ["mkdir_p"; "/new"]]],
1381    "create a directory and parents",
1382    "\
1383 Create a directory named C<path>, creating any parent directories
1384 as necessary.  This is like the C<mkdir -p> shell command.");
1385
1386   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1387    [], (* XXX Need stat command to test *)
1388    "change file mode",
1389    "\
1390 Change the mode (permissions) of C<path> to C<mode>.  Only
1391 numeric modes are supported.
1392
1393 I<Note>: When using this command from guestfish, C<mode>
1394 by default would be decimal, unless you prefix it with
1395 C<0> to get octal, ie. use C<0700> not C<700>.
1396
1397 The mode actually set is affected by the umask.");
1398
1399   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1400    [], (* XXX Need stat command to test *)
1401    "change file owner and group",
1402    "\
1403 Change the file owner to C<owner> and group to C<group>.
1404
1405 Only numeric uid and gid are supported.  If you want to use
1406 names, you will need to locate and parse the password file
1407 yourself (Augeas support makes this relatively easy).");
1408
1409   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1410    [InitISOFS, Always, TestOutputTrue (
1411       [["exists"; "/empty"]]);
1412     InitISOFS, Always, TestOutputTrue (
1413       [["exists"; "/directory"]])],
1414    "test if file or directory exists",
1415    "\
1416 This returns C<true> if and only if there is a file, directory
1417 (or anything) with the given C<path> name.
1418
1419 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1420
1421   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1422    [InitISOFS, Always, TestOutputTrue (
1423       [["is_file"; "/known-1"]]);
1424     InitISOFS, Always, TestOutputFalse (
1425       [["is_file"; "/directory"]])],
1426    "test if file exists",
1427    "\
1428 This returns C<true> if and only if there is a file
1429 with the given C<path> name.  Note that it returns false for
1430 other objects like directories.
1431
1432 See also C<guestfs_stat>.");
1433
1434   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1435    [InitISOFS, Always, TestOutputFalse (
1436       [["is_dir"; "/known-3"]]);
1437     InitISOFS, Always, TestOutputTrue (
1438       [["is_dir"; "/directory"]])],
1439    "test if file exists",
1440    "\
1441 This returns C<true> if and only if there is a directory
1442 with the given C<path> name.  Note that it returns false for
1443 other objects like files.
1444
1445 See also C<guestfs_stat>.");
1446
1447   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1448    [InitEmpty, Always, TestOutputListOfDevices (
1449       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1450        ["pvcreate"; "/dev/sda1"];
1451        ["pvcreate"; "/dev/sda2"];
1452        ["pvcreate"; "/dev/sda3"];
1453        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1454    "create an LVM physical volume",
1455    "\
1456 This creates an LVM physical volume on the named C<device>,
1457 where C<device> should usually be a partition name such
1458 as C</dev/sda1>.");
1459
1460   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1461    [InitEmpty, Always, TestOutputList (
1462       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1463        ["pvcreate"; "/dev/sda1"];
1464        ["pvcreate"; "/dev/sda2"];
1465        ["pvcreate"; "/dev/sda3"];
1466        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1467        ["vgcreate"; "VG2"; "/dev/sda3"];
1468        ["vgs"]], ["VG1"; "VG2"])],
1469    "create an LVM volume group",
1470    "\
1471 This creates an LVM volume group called C<volgroup>
1472 from the non-empty list of physical volumes C<physvols>.");
1473
1474   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1475    [InitEmpty, Always, TestOutputList (
1476       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1477        ["pvcreate"; "/dev/sda1"];
1478        ["pvcreate"; "/dev/sda2"];
1479        ["pvcreate"; "/dev/sda3"];
1480        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1481        ["vgcreate"; "VG2"; "/dev/sda3"];
1482        ["lvcreate"; "LV1"; "VG1"; "50"];
1483        ["lvcreate"; "LV2"; "VG1"; "50"];
1484        ["lvcreate"; "LV3"; "VG2"; "50"];
1485        ["lvcreate"; "LV4"; "VG2"; "50"];
1486        ["lvcreate"; "LV5"; "VG2"; "50"];
1487        ["lvs"]],
1488       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1489        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1490    "create an LVM logical volume",
1491    "\
1492 This creates an LVM logical volume called C<logvol>
1493 on the volume group C<volgroup>, with C<size> megabytes.");
1494
1495   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1496    [InitEmpty, Always, TestOutput (
1497       [["part_disk"; "/dev/sda"; "mbr"];
1498        ["mkfs"; "ext2"; "/dev/sda1"];
1499        ["mount_options"; ""; "/dev/sda1"; "/"];
1500        ["write_file"; "/new"; "new file contents"; "0"];
1501        ["cat"; "/new"]], "new file contents")],
1502    "make a filesystem",
1503    "\
1504 This creates a filesystem on C<device> (usually a partition
1505 or LVM logical volume).  The filesystem type is C<fstype>, for
1506 example C<ext3>.");
1507
1508   ("sfdisk", (RErr, [Device "device";
1509                      Int "cyls"; Int "heads"; Int "sectors";
1510                      StringList "lines"]), 43, [DangerWillRobinson],
1511    [],
1512    "create partitions on a block device",
1513    "\
1514 This is a direct interface to the L<sfdisk(8)> program for creating
1515 partitions on block devices.
1516
1517 C<device> should be a block device, for example C</dev/sda>.
1518
1519 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1520 and sectors on the device, which are passed directly to sfdisk as
1521 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1522 of these, then the corresponding parameter is omitted.  Usually for
1523 'large' disks, you can just pass C<0> for these, but for small
1524 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1525 out the right geometry and you will need to tell it.
1526
1527 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1528 information refer to the L<sfdisk(8)> manpage.
1529
1530 To create a single partition occupying the whole disk, you would
1531 pass C<lines> as a single element list, when the single element being
1532 the string C<,> (comma).
1533
1534 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1535 C<guestfs_part_init>");
1536
1537   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1538    [InitBasicFS, Always, TestOutput (
1539       [["write_file"; "/new"; "new file contents"; "0"];
1540        ["cat"; "/new"]], "new file contents");
1541     InitBasicFS, Always, TestOutput (
1542       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1543        ["cat"; "/new"]], "\nnew file contents\n");
1544     InitBasicFS, Always, TestOutput (
1545       [["write_file"; "/new"; "\n\n"; "0"];
1546        ["cat"; "/new"]], "\n\n");
1547     InitBasicFS, Always, TestOutput (
1548       [["write_file"; "/new"; ""; "0"];
1549        ["cat"; "/new"]], "");
1550     InitBasicFS, Always, TestOutput (
1551       [["write_file"; "/new"; "\n\n\n"; "0"];
1552        ["cat"; "/new"]], "\n\n\n");
1553     InitBasicFS, Always, TestOutput (
1554       [["write_file"; "/new"; "\n"; "0"];
1555        ["cat"; "/new"]], "\n");
1556     (* Regression test for RHBZ#597135. *)
1557     InitBasicFS, Always, TestLastFail
1558       [["write_file"; "/new"; "abc"; "10000"]]],
1559    "create a file",
1560    "\
1561 This call creates a file called C<path>.  The contents of the
1562 file is the string C<content> (which can contain any 8 bit data),
1563 with length C<size>.
1564
1565 As a special case, if C<size> is C<0>
1566 then the length is calculated using C<strlen> (so in this case
1567 the content cannot contain embedded ASCII NULs).
1568
1569 I<NB.> Owing to a bug, writing content containing ASCII NUL
1570 characters does I<not> work, even if the length is specified.
1571 We hope to resolve this bug in a future version.  In the meantime
1572 use C<guestfs_upload>.");
1573
1574   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1575    [InitEmpty, Always, TestOutputListOfDevices (
1576       [["part_disk"; "/dev/sda"; "mbr"];
1577        ["mkfs"; "ext2"; "/dev/sda1"];
1578        ["mount_options"; ""; "/dev/sda1"; "/"];
1579        ["mounts"]], ["/dev/sda1"]);
1580     InitEmpty, Always, TestOutputList (
1581       [["part_disk"; "/dev/sda"; "mbr"];
1582        ["mkfs"; "ext2"; "/dev/sda1"];
1583        ["mount_options"; ""; "/dev/sda1"; "/"];
1584        ["umount"; "/"];
1585        ["mounts"]], [])],
1586    "unmount a filesystem",
1587    "\
1588 This unmounts the given filesystem.  The filesystem may be
1589 specified either by its mountpoint (path) or the device which
1590 contains the filesystem.");
1591
1592   ("mounts", (RStringList "devices", []), 46, [],
1593    [InitBasicFS, Always, TestOutputListOfDevices (
1594       [["mounts"]], ["/dev/sda1"])],
1595    "show mounted filesystems",
1596    "\
1597 This returns the list of currently mounted filesystems.  It returns
1598 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1599
1600 Some internal mounts are not shown.
1601
1602 See also: C<guestfs_mountpoints>");
1603
1604   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1605    [InitBasicFS, Always, TestOutputList (
1606       [["umount_all"];
1607        ["mounts"]], []);
1608     (* check that umount_all can unmount nested mounts correctly: *)
1609     InitEmpty, Always, TestOutputList (
1610       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1611        ["mkfs"; "ext2"; "/dev/sda1"];
1612        ["mkfs"; "ext2"; "/dev/sda2"];
1613        ["mkfs"; "ext2"; "/dev/sda3"];
1614        ["mount_options"; ""; "/dev/sda1"; "/"];
1615        ["mkdir"; "/mp1"];
1616        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1617        ["mkdir"; "/mp1/mp2"];
1618        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1619        ["mkdir"; "/mp1/mp2/mp3"];
1620        ["umount_all"];
1621        ["mounts"]], [])],
1622    "unmount all filesystems",
1623    "\
1624 This unmounts all mounted filesystems.
1625
1626 Some internal mounts are not unmounted by this call.");
1627
1628   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1629    [],
1630    "remove all LVM LVs, VGs and PVs",
1631    "\
1632 This command removes all LVM logical volumes, volume groups
1633 and physical volumes.");
1634
1635   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1636    [InitISOFS, Always, TestOutput (
1637       [["file"; "/empty"]], "empty");
1638     InitISOFS, Always, TestOutput (
1639       [["file"; "/known-1"]], "ASCII text");
1640     InitISOFS, Always, TestLastFail (
1641       [["file"; "/notexists"]])],
1642    "determine file type",
1643    "\
1644 This call uses the standard L<file(1)> command to determine
1645 the type or contents of the file.  This also works on devices,
1646 for example to find out whether a partition contains a filesystem.
1647
1648 This call will also transparently look inside various types
1649 of compressed file.
1650
1651 The exact command which runs is C<file -zbsL path>.  Note in
1652 particular that the filename is not prepended to the output
1653 (the C<-b> option).");
1654
1655   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1656    [InitBasicFS, Always, TestOutput (
1657       [["upload"; "test-command"; "/test-command"];
1658        ["chmod"; "0o755"; "/test-command"];
1659        ["command"; "/test-command 1"]], "Result1");
1660     InitBasicFS, Always, TestOutput (
1661       [["upload"; "test-command"; "/test-command"];
1662        ["chmod"; "0o755"; "/test-command"];
1663        ["command"; "/test-command 2"]], "Result2\n");
1664     InitBasicFS, Always, TestOutput (
1665       [["upload"; "test-command"; "/test-command"];
1666        ["chmod"; "0o755"; "/test-command"];
1667        ["command"; "/test-command 3"]], "\nResult3");
1668     InitBasicFS, Always, TestOutput (
1669       [["upload"; "test-command"; "/test-command"];
1670        ["chmod"; "0o755"; "/test-command"];
1671        ["command"; "/test-command 4"]], "\nResult4\n");
1672     InitBasicFS, Always, TestOutput (
1673       [["upload"; "test-command"; "/test-command"];
1674        ["chmod"; "0o755"; "/test-command"];
1675        ["command"; "/test-command 5"]], "\nResult5\n\n");
1676     InitBasicFS, Always, TestOutput (
1677       [["upload"; "test-command"; "/test-command"];
1678        ["chmod"; "0o755"; "/test-command"];
1679        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1680     InitBasicFS, Always, TestOutput (
1681       [["upload"; "test-command"; "/test-command"];
1682        ["chmod"; "0o755"; "/test-command"];
1683        ["command"; "/test-command 7"]], "");
1684     InitBasicFS, Always, TestOutput (
1685       [["upload"; "test-command"; "/test-command"];
1686        ["chmod"; "0o755"; "/test-command"];
1687        ["command"; "/test-command 8"]], "\n");
1688     InitBasicFS, Always, TestOutput (
1689       [["upload"; "test-command"; "/test-command"];
1690        ["chmod"; "0o755"; "/test-command"];
1691        ["command"; "/test-command 9"]], "\n\n");
1692     InitBasicFS, Always, TestOutput (
1693       [["upload"; "test-command"; "/test-command"];
1694        ["chmod"; "0o755"; "/test-command"];
1695        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1696     InitBasicFS, Always, TestOutput (
1697       [["upload"; "test-command"; "/test-command"];
1698        ["chmod"; "0o755"; "/test-command"];
1699        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1700     InitBasicFS, Always, TestLastFail (
1701       [["upload"; "test-command"; "/test-command"];
1702        ["chmod"; "0o755"; "/test-command"];
1703        ["command"; "/test-command"]])],
1704    "run a command from the guest filesystem",
1705    "\
1706 This call runs a command from the guest filesystem.  The
1707 filesystem must be mounted, and must contain a compatible
1708 operating system (ie. something Linux, with the same
1709 or compatible processor architecture).
1710
1711 The single parameter is an argv-style list of arguments.
1712 The first element is the name of the program to run.
1713 Subsequent elements are parameters.  The list must be
1714 non-empty (ie. must contain a program name).  Note that
1715 the command runs directly, and is I<not> invoked via
1716 the shell (see C<guestfs_sh>).
1717
1718 The return value is anything printed to I<stdout> by
1719 the command.
1720
1721 If the command returns a non-zero exit status, then
1722 this function returns an error message.  The error message
1723 string is the content of I<stderr> from the command.
1724
1725 The C<$PATH> environment variable will contain at least
1726 C</usr/bin> and C</bin>.  If you require a program from
1727 another location, you should provide the full path in the
1728 first parameter.
1729
1730 Shared libraries and data files required by the program
1731 must be available on filesystems which are mounted in the
1732 correct places.  It is the caller's responsibility to ensure
1733 all filesystems that are needed are mounted at the right
1734 locations.");
1735
1736   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1737    [InitBasicFS, Always, TestOutputList (
1738       [["upload"; "test-command"; "/test-command"];
1739        ["chmod"; "0o755"; "/test-command"];
1740        ["command_lines"; "/test-command 1"]], ["Result1"]);
1741     InitBasicFS, Always, TestOutputList (
1742       [["upload"; "test-command"; "/test-command"];
1743        ["chmod"; "0o755"; "/test-command"];
1744        ["command_lines"; "/test-command 2"]], ["Result2"]);
1745     InitBasicFS, Always, TestOutputList (
1746       [["upload"; "test-command"; "/test-command"];
1747        ["chmod"; "0o755"; "/test-command"];
1748        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1749     InitBasicFS, Always, TestOutputList (
1750       [["upload"; "test-command"; "/test-command"];
1751        ["chmod"; "0o755"; "/test-command"];
1752        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1753     InitBasicFS, Always, TestOutputList (
1754       [["upload"; "test-command"; "/test-command"];
1755        ["chmod"; "0o755"; "/test-command"];
1756        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1757     InitBasicFS, Always, TestOutputList (
1758       [["upload"; "test-command"; "/test-command"];
1759        ["chmod"; "0o755"; "/test-command"];
1760        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1761     InitBasicFS, Always, TestOutputList (
1762       [["upload"; "test-command"; "/test-command"];
1763        ["chmod"; "0o755"; "/test-command"];
1764        ["command_lines"; "/test-command 7"]], []);
1765     InitBasicFS, Always, TestOutputList (
1766       [["upload"; "test-command"; "/test-command"];
1767        ["chmod"; "0o755"; "/test-command"];
1768        ["command_lines"; "/test-command 8"]], [""]);
1769     InitBasicFS, Always, TestOutputList (
1770       [["upload"; "test-command"; "/test-command"];
1771        ["chmod"; "0o755"; "/test-command"];
1772        ["command_lines"; "/test-command 9"]], ["";""]);
1773     InitBasicFS, Always, TestOutputList (
1774       [["upload"; "test-command"; "/test-command"];
1775        ["chmod"; "0o755"; "/test-command"];
1776        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1777     InitBasicFS, Always, TestOutputList (
1778       [["upload"; "test-command"; "/test-command"];
1779        ["chmod"; "0o755"; "/test-command"];
1780        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1781    "run a command, returning lines",
1782    "\
1783 This is the same as C<guestfs_command>, but splits the
1784 result into a list of lines.
1785
1786 See also: C<guestfs_sh_lines>");
1787
1788   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1789    [InitISOFS, Always, TestOutputStruct (
1790       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1791    "get file information",
1792    "\
1793 Returns file information for the given C<path>.
1794
1795 This is the same as the C<stat(2)> system call.");
1796
1797   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1798    [InitISOFS, Always, TestOutputStruct (
1799       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1800    "get file information for a symbolic link",
1801    "\
1802 Returns file information for the given C<path>.
1803
1804 This is the same as C<guestfs_stat> except that if C<path>
1805 is a symbolic link, then the link is stat-ed, not the file it
1806 refers to.
1807
1808 This is the same as the C<lstat(2)> system call.");
1809
1810   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1811    [InitISOFS, Always, TestOutputStruct (
1812       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1813    "get file system statistics",
1814    "\
1815 Returns file system statistics for any mounted file system.
1816 C<path> should be a file or directory in the mounted file system
1817 (typically it is the mount point itself, but it doesn't need to be).
1818
1819 This is the same as the C<statvfs(2)> system call.");
1820
1821   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1822    [], (* XXX test *)
1823    "get ext2/ext3/ext4 superblock details",
1824    "\
1825 This returns the contents of the ext2, ext3 or ext4 filesystem
1826 superblock on C<device>.
1827
1828 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1829 manpage for more details.  The list of fields returned isn't
1830 clearly defined, and depends on both the version of C<tune2fs>
1831 that libguestfs was built against, and the filesystem itself.");
1832
1833   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1834    [InitEmpty, Always, TestOutputTrue (
1835       [["blockdev_setro"; "/dev/sda"];
1836        ["blockdev_getro"; "/dev/sda"]])],
1837    "set block device to read-only",
1838    "\
1839 Sets the block device named C<device> to read-only.
1840
1841 This uses the L<blockdev(8)> command.");
1842
1843   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1844    [InitEmpty, Always, TestOutputFalse (
1845       [["blockdev_setrw"; "/dev/sda"];
1846        ["blockdev_getro"; "/dev/sda"]])],
1847    "set block device to read-write",
1848    "\
1849 Sets the block device named C<device> to read-write.
1850
1851 This uses the L<blockdev(8)> command.");
1852
1853   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1854    [InitEmpty, Always, TestOutputTrue (
1855       [["blockdev_setro"; "/dev/sda"];
1856        ["blockdev_getro"; "/dev/sda"]])],
1857    "is block device set to read-only",
1858    "\
1859 Returns a boolean indicating if the block device is read-only
1860 (true if read-only, false if not).
1861
1862 This uses the L<blockdev(8)> command.");
1863
1864   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1865    [InitEmpty, Always, TestOutputInt (
1866       [["blockdev_getss"; "/dev/sda"]], 512)],
1867    "get sectorsize of block device",
1868    "\
1869 This returns the size of sectors on a block device.
1870 Usually 512, but can be larger for modern devices.
1871
1872 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1873 for that).
1874
1875 This uses the L<blockdev(8)> command.");
1876
1877   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1878    [InitEmpty, Always, TestOutputInt (
1879       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1880    "get blocksize of block device",
1881    "\
1882 This returns the block size of a device.
1883
1884 (Note this is different from both I<size in blocks> and
1885 I<filesystem block size>).
1886
1887 This uses the L<blockdev(8)> command.");
1888
1889   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1890    [], (* XXX test *)
1891    "set blocksize of block device",
1892    "\
1893 This sets the block size of a device.
1894
1895 (Note this is different from both I<size in blocks> and
1896 I<filesystem block size>).
1897
1898 This uses the L<blockdev(8)> command.");
1899
1900   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1901    [InitEmpty, Always, TestOutputInt (
1902       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1903    "get total size of device in 512-byte sectors",
1904    "\
1905 This returns the size of the device in units of 512-byte sectors
1906 (even if the sectorsize isn't 512 bytes ... weird).
1907
1908 See also C<guestfs_blockdev_getss> for the real sector size of
1909 the device, and C<guestfs_blockdev_getsize64> for the more
1910 useful I<size in bytes>.
1911
1912 This uses the L<blockdev(8)> command.");
1913
1914   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1915    [InitEmpty, Always, TestOutputInt (
1916       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1917    "get total size of device in bytes",
1918    "\
1919 This returns the size of the device in bytes.
1920
1921 See also C<guestfs_blockdev_getsz>.
1922
1923 This uses the L<blockdev(8)> command.");
1924
1925   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1926    [InitEmpty, Always, TestRun
1927       [["blockdev_flushbufs"; "/dev/sda"]]],
1928    "flush device buffers",
1929    "\
1930 This tells the kernel to flush internal buffers associated
1931 with C<device>.
1932
1933 This uses the L<blockdev(8)> command.");
1934
1935   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1936    [InitEmpty, Always, TestRun
1937       [["blockdev_rereadpt"; "/dev/sda"]]],
1938    "reread partition table",
1939    "\
1940 Reread the partition table on C<device>.
1941
1942 This uses the L<blockdev(8)> command.");
1943
1944   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1945    [InitBasicFS, Always, TestOutput (
1946       (* Pick a file from cwd which isn't likely to change. *)
1947       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1948        ["checksum"; "md5"; "/COPYING.LIB"]],
1949       Digest.to_hex (Digest.file "COPYING.LIB"))],
1950    "upload a file from the local machine",
1951    "\
1952 Upload local file C<filename> to C<remotefilename> on the
1953 filesystem.
1954
1955 C<filename> can also be a named pipe.
1956
1957 See also C<guestfs_download>.");
1958
1959   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1960    [InitBasicFS, Always, TestOutput (
1961       (* Pick a file from cwd which isn't likely to change. *)
1962       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1963        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1964        ["upload"; "testdownload.tmp"; "/upload"];
1965        ["checksum"; "md5"; "/upload"]],
1966       Digest.to_hex (Digest.file "COPYING.LIB"))],
1967    "download a file to the local machine",
1968    "\
1969 Download file C<remotefilename> and save it as C<filename>
1970 on the local machine.
1971
1972 C<filename> can also be a named pipe.
1973
1974 See also C<guestfs_upload>, C<guestfs_cat>.");
1975
1976   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1977    [InitISOFS, Always, TestOutput (
1978       [["checksum"; "crc"; "/known-3"]], "2891671662");
1979     InitISOFS, Always, TestLastFail (
1980       [["checksum"; "crc"; "/notexists"]]);
1981     InitISOFS, Always, TestOutput (
1982       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1983     InitISOFS, Always, TestOutput (
1984       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1985     InitISOFS, Always, TestOutput (
1986       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1987     InitISOFS, Always, TestOutput (
1988       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1989     InitISOFS, Always, TestOutput (
1990       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1991     InitISOFS, Always, TestOutput (
1992       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1993    "compute MD5, SHAx or CRC checksum of file",
1994    "\
1995 This call computes the MD5, SHAx or CRC checksum of the
1996 file named C<path>.
1997
1998 The type of checksum to compute is given by the C<csumtype>
1999 parameter which must have one of the following values:
2000
2001 =over 4
2002
2003 =item C<crc>
2004
2005 Compute the cyclic redundancy check (CRC) specified by POSIX
2006 for the C<cksum> command.
2007
2008 =item C<md5>
2009
2010 Compute the MD5 hash (using the C<md5sum> program).
2011
2012 =item C<sha1>
2013
2014 Compute the SHA1 hash (using the C<sha1sum> program).
2015
2016 =item C<sha224>
2017
2018 Compute the SHA224 hash (using the C<sha224sum> program).
2019
2020 =item C<sha256>
2021
2022 Compute the SHA256 hash (using the C<sha256sum> program).
2023
2024 =item C<sha384>
2025
2026 Compute the SHA384 hash (using the C<sha384sum> program).
2027
2028 =item C<sha512>
2029
2030 Compute the SHA512 hash (using the C<sha512sum> program).
2031
2032 =back
2033
2034 The checksum is returned as a printable string.");
2035
2036   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2037    [InitBasicFS, Always, TestOutput (
2038       [["tar_in"; "../images/helloworld.tar"; "/"];
2039        ["cat"; "/hello"]], "hello\n")],
2040    "unpack tarfile to directory",
2041    "\
2042 This command uploads and unpacks local file C<tarfile> (an
2043 I<uncompressed> tar file) into C<directory>.
2044
2045 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2046
2047   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2048    [],
2049    "pack directory into tarfile",
2050    "\
2051 This command packs the contents of C<directory> and downloads
2052 it to local file C<tarfile>.
2053
2054 To download a compressed tarball, use C<guestfs_tgz_out>.");
2055
2056   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2057    [InitBasicFS, Always, TestOutput (
2058       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2059        ["cat"; "/hello"]], "hello\n")],
2060    "unpack compressed tarball to directory",
2061    "\
2062 This command uploads and unpacks local file C<tarball> (a
2063 I<gzip compressed> tar file) into C<directory>.
2064
2065 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2066
2067   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2068    [],
2069    "pack directory into compressed tarball",
2070    "\
2071 This command packs the contents of C<directory> and downloads
2072 it to local file C<tarball>.
2073
2074 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2075
2076   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2077    [InitBasicFS, Always, TestLastFail (
2078       [["umount"; "/"];
2079        ["mount_ro"; "/dev/sda1"; "/"];
2080        ["touch"; "/new"]]);
2081     InitBasicFS, Always, TestOutput (
2082       [["write_file"; "/new"; "data"; "0"];
2083        ["umount"; "/"];
2084        ["mount_ro"; "/dev/sda1"; "/"];
2085        ["cat"; "/new"]], "data")],
2086    "mount a guest disk, read-only",
2087    "\
2088 This is the same as the C<guestfs_mount> command, but it
2089 mounts the filesystem with the read-only (I<-o ro>) flag.");
2090
2091   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2092    [],
2093    "mount a guest disk with mount options",
2094    "\
2095 This is the same as the C<guestfs_mount> command, but it
2096 allows you to set the mount options as for the
2097 L<mount(8)> I<-o> flag.
2098
2099 If the C<options> parameter is an empty string, then
2100 no options are passed (all options default to whatever
2101 the filesystem uses).");
2102
2103   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2104    [],
2105    "mount a guest disk with mount options and vfstype",
2106    "\
2107 This is the same as the C<guestfs_mount> command, but it
2108 allows you to set both the mount options and the vfstype
2109 as for the L<mount(8)> I<-o> and I<-t> flags.");
2110
2111   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2112    [],
2113    "debugging and internals",
2114    "\
2115 The C<guestfs_debug> command exposes some internals of
2116 C<guestfsd> (the guestfs daemon) that runs inside the
2117 qemu subprocess.
2118
2119 There is no comprehensive help for this command.  You have
2120 to look at the file C<daemon/debug.c> in the libguestfs source
2121 to find out what you can do.");
2122
2123   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
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/LV1"];
2131        ["lvs"]], ["/dev/VG/LV2"]);
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        ["lvs"]], []);
2140     InitEmpty, Always, TestOutputList (
2141       [["part_disk"; "/dev/sda"; "mbr"];
2142        ["pvcreate"; "/dev/sda1"];
2143        ["vgcreate"; "VG"; "/dev/sda1"];
2144        ["lvcreate"; "LV1"; "VG"; "50"];
2145        ["lvcreate"; "LV2"; "VG"; "50"];
2146        ["lvremove"; "/dev/VG"];
2147        ["vgs"]], ["VG"])],
2148    "remove an LVM logical volume",
2149    "\
2150 Remove an LVM logical volume C<device>, where C<device> is
2151 the path to the LV, such as C</dev/VG/LV>.
2152
2153 You can also remove all LVs in a volume group by specifying
2154 the VG name, C</dev/VG>.");
2155
2156   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
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        ["lvs"]], []);
2165     InitEmpty, Always, TestOutputList (
2166       [["part_disk"; "/dev/sda"; "mbr"];
2167        ["pvcreate"; "/dev/sda1"];
2168        ["vgcreate"; "VG"; "/dev/sda1"];
2169        ["lvcreate"; "LV1"; "VG"; "50"];
2170        ["lvcreate"; "LV2"; "VG"; "50"];
2171        ["vgremove"; "VG"];
2172        ["vgs"]], [])],
2173    "remove an LVM volume group",
2174    "\
2175 Remove an LVM volume group C<vgname>, (for example C<VG>).
2176
2177 This also forcibly removes all logical volumes in the volume
2178 group (if any).");
2179
2180   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2181    [InitEmpty, Always, TestOutputListOfDevices (
2182       [["part_disk"; "/dev/sda"; "mbr"];
2183        ["pvcreate"; "/dev/sda1"];
2184        ["vgcreate"; "VG"; "/dev/sda1"];
2185        ["lvcreate"; "LV1"; "VG"; "50"];
2186        ["lvcreate"; "LV2"; "VG"; "50"];
2187        ["vgremove"; "VG"];
2188        ["pvremove"; "/dev/sda1"];
2189        ["lvs"]], []);
2190     InitEmpty, Always, TestOutputListOfDevices (
2191       [["part_disk"; "/dev/sda"; "mbr"];
2192        ["pvcreate"; "/dev/sda1"];
2193        ["vgcreate"; "VG"; "/dev/sda1"];
2194        ["lvcreate"; "LV1"; "VG"; "50"];
2195        ["lvcreate"; "LV2"; "VG"; "50"];
2196        ["vgremove"; "VG"];
2197        ["pvremove"; "/dev/sda1"];
2198        ["vgs"]], []);
2199     InitEmpty, Always, TestOutputListOfDevices (
2200       [["part_disk"; "/dev/sda"; "mbr"];
2201        ["pvcreate"; "/dev/sda1"];
2202        ["vgcreate"; "VG"; "/dev/sda1"];
2203        ["lvcreate"; "LV1"; "VG"; "50"];
2204        ["lvcreate"; "LV2"; "VG"; "50"];
2205        ["vgremove"; "VG"];
2206        ["pvremove"; "/dev/sda1"];
2207        ["pvs"]], [])],
2208    "remove an LVM physical volume",
2209    "\
2210 This wipes a physical volume C<device> so that LVM will no longer
2211 recognise it.
2212
2213 The implementation uses the C<pvremove> command which refuses to
2214 wipe physical volumes that contain any volume groups, so you have
2215 to remove those first.");
2216
2217   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2218    [InitBasicFS, Always, TestOutput (
2219       [["set_e2label"; "/dev/sda1"; "testlabel"];
2220        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2221    "set the ext2/3/4 filesystem label",
2222    "\
2223 This sets the ext2/3/4 filesystem label of the filesystem on
2224 C<device> to C<label>.  Filesystem labels are limited to
2225 16 characters.
2226
2227 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2228 to return the existing label on a filesystem.");
2229
2230   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2231    [],
2232    "get the ext2/3/4 filesystem label",
2233    "\
2234 This returns the ext2/3/4 filesystem label of the filesystem on
2235 C<device>.");
2236
2237   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2238    (let uuid = uuidgen () in
2239     [InitBasicFS, Always, TestOutput (
2240        [["set_e2uuid"; "/dev/sda1"; uuid];
2241         ["get_e2uuid"; "/dev/sda1"]], uuid);
2242      InitBasicFS, Always, TestOutput (
2243        [["set_e2uuid"; "/dev/sda1"; "clear"];
2244         ["get_e2uuid"; "/dev/sda1"]], "");
2245      (* We can't predict what UUIDs will be, so just check the commands run. *)
2246      InitBasicFS, Always, TestRun (
2247        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2248      InitBasicFS, Always, TestRun (
2249        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2250    "set the ext2/3/4 filesystem UUID",
2251    "\
2252 This sets the ext2/3/4 filesystem UUID of the filesystem on
2253 C<device> to C<uuid>.  The format of the UUID and alternatives
2254 such as C<clear>, C<random> and C<time> are described in the
2255 L<tune2fs(8)> manpage.
2256
2257 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2258 to return the existing UUID of a filesystem.");
2259
2260   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2261    [],
2262    "get the ext2/3/4 filesystem UUID",
2263    "\
2264 This returns the ext2/3/4 filesystem UUID of the filesystem on
2265 C<device>.");
2266
2267   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2268    [InitBasicFS, Always, TestOutputInt (
2269       [["umount"; "/dev/sda1"];
2270        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2271     InitBasicFS, Always, TestOutputInt (
2272       [["umount"; "/dev/sda1"];
2273        ["zero"; "/dev/sda1"];
2274        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2275    "run the filesystem checker",
2276    "\
2277 This runs the filesystem checker (fsck) on C<device> which
2278 should have filesystem type C<fstype>.
2279
2280 The returned integer is the status.  See L<fsck(8)> for the
2281 list of status codes from C<fsck>.
2282
2283 Notes:
2284
2285 =over 4
2286
2287 =item *
2288
2289 Multiple status codes can be summed together.
2290
2291 =item *
2292
2293 A non-zero return code can mean \"success\", for example if
2294 errors have been corrected on the filesystem.
2295
2296 =item *
2297
2298 Checking or repairing NTFS volumes is not supported
2299 (by linux-ntfs).
2300
2301 =back
2302
2303 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2304
2305   ("zero", (RErr, [Device "device"]), 85, [],
2306    [InitBasicFS, Always, TestOutput (
2307       [["umount"; "/dev/sda1"];
2308        ["zero"; "/dev/sda1"];
2309        ["file"; "/dev/sda1"]], "data")],
2310    "write zeroes to the device",
2311    "\
2312 This command writes zeroes over the first few blocks of C<device>.
2313
2314 How many blocks are zeroed isn't specified (but it's I<not> enough
2315 to securely wipe the device).  It should be sufficient to remove
2316 any partition tables, filesystem superblocks and so on.
2317
2318 See also: C<guestfs_scrub_device>.");
2319
2320   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2321    (* Test disabled because grub-install incompatible with virtio-blk driver.
2322     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2323     *)
2324    [InitBasicFS, Disabled, TestOutputTrue (
2325       [["grub_install"; "/"; "/dev/sda1"];
2326        ["is_dir"; "/boot"]])],
2327    "install GRUB",
2328    "\
2329 This command installs GRUB (the Grand Unified Bootloader) on
2330 C<device>, with the root directory being C<root>.");
2331
2332   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2333    [InitBasicFS, Always, TestOutput (
2334       [["write_file"; "/old"; "file content"; "0"];
2335        ["cp"; "/old"; "/new"];
2336        ["cat"; "/new"]], "file content");
2337     InitBasicFS, Always, TestOutputTrue (
2338       [["write_file"; "/old"; "file content"; "0"];
2339        ["cp"; "/old"; "/new"];
2340        ["is_file"; "/old"]]);
2341     InitBasicFS, Always, TestOutput (
2342       [["write_file"; "/old"; "file content"; "0"];
2343        ["mkdir"; "/dir"];
2344        ["cp"; "/old"; "/dir/new"];
2345        ["cat"; "/dir/new"]], "file content")],
2346    "copy a file",
2347    "\
2348 This copies a file from C<src> to C<dest> where C<dest> is
2349 either a destination filename or destination directory.");
2350
2351   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2352    [InitBasicFS, Always, TestOutput (
2353       [["mkdir"; "/olddir"];
2354        ["mkdir"; "/newdir"];
2355        ["write_file"; "/olddir/file"; "file content"; "0"];
2356        ["cp_a"; "/olddir"; "/newdir"];
2357        ["cat"; "/newdir/olddir/file"]], "file content")],
2358    "copy a file or directory recursively",
2359    "\
2360 This copies a file or directory from C<src> to C<dest>
2361 recursively using the C<cp -a> command.");
2362
2363   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2364    [InitBasicFS, Always, TestOutput (
2365       [["write_file"; "/old"; "file content"; "0"];
2366        ["mv"; "/old"; "/new"];
2367        ["cat"; "/new"]], "file content");
2368     InitBasicFS, Always, TestOutputFalse (
2369       [["write_file"; "/old"; "file content"; "0"];
2370        ["mv"; "/old"; "/new"];
2371        ["is_file"; "/old"]])],
2372    "move a file",
2373    "\
2374 This moves a file from C<src> to C<dest> where C<dest> is
2375 either a destination filename or destination directory.");
2376
2377   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2378    [InitEmpty, Always, TestRun (
2379       [["drop_caches"; "3"]])],
2380    "drop kernel page cache, dentries and inodes",
2381    "\
2382 This instructs the guest kernel to drop its page cache,
2383 and/or dentries and inode caches.  The parameter C<whattodrop>
2384 tells the kernel what precisely to drop, see
2385 L<http://linux-mm.org/Drop_Caches>
2386
2387 Setting C<whattodrop> to 3 should drop everything.
2388
2389 This automatically calls L<sync(2)> before the operation,
2390 so that the maximum guest memory is freed.");
2391
2392   ("dmesg", (RString "kmsgs", []), 91, [],
2393    [InitEmpty, Always, TestRun (
2394       [["dmesg"]])],
2395    "return kernel messages",
2396    "\
2397 This returns the kernel messages (C<dmesg> output) from
2398 the guest kernel.  This is sometimes useful for extended
2399 debugging of problems.
2400
2401 Another way to get the same information is to enable
2402 verbose messages with C<guestfs_set_verbose> or by setting
2403 the environment variable C<LIBGUESTFS_DEBUG=1> before
2404 running the program.");
2405
2406   ("ping_daemon", (RErr, []), 92, [],
2407    [InitEmpty, Always, TestRun (
2408       [["ping_daemon"]])],
2409    "ping the guest daemon",
2410    "\
2411 This is a test probe into the guestfs daemon running inside
2412 the qemu subprocess.  Calling this function checks that the
2413 daemon responds to the ping message, without affecting the daemon
2414 or attached block device(s) in any other way.");
2415
2416   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2417    [InitBasicFS, Always, TestOutputTrue (
2418       [["write_file"; "/file1"; "contents of a file"; "0"];
2419        ["cp"; "/file1"; "/file2"];
2420        ["equal"; "/file1"; "/file2"]]);
2421     InitBasicFS, Always, TestOutputFalse (
2422       [["write_file"; "/file1"; "contents of a file"; "0"];
2423        ["write_file"; "/file2"; "contents of another file"; "0"];
2424        ["equal"; "/file1"; "/file2"]]);
2425     InitBasicFS, Always, TestLastFail (
2426       [["equal"; "/file1"; "/file2"]])],
2427    "test if two files have equal contents",
2428    "\
2429 This compares the two files C<file1> and C<file2> and returns
2430 true if their content is exactly equal, or false otherwise.
2431
2432 The external L<cmp(1)> program is used for the comparison.");
2433
2434   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2435    [InitISOFS, Always, TestOutputList (
2436       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2437     InitISOFS, Always, TestOutputList (
2438       [["strings"; "/empty"]], [])],
2439    "print the printable strings in a file",
2440    "\
2441 This runs the L<strings(1)> command on a file and returns
2442 the list of printable strings found.");
2443
2444   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2445    [InitISOFS, Always, TestOutputList (
2446       [["strings_e"; "b"; "/known-5"]], []);
2447     InitBasicFS, Disabled, TestOutputList (
2448       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2449        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2450    "print the printable strings in a file",
2451    "\
2452 This is like the C<guestfs_strings> command, but allows you to
2453 specify the encoding of strings that are looked for in
2454 the source file C<path>.
2455
2456 Allowed encodings are:
2457
2458 =over 4
2459
2460 =item s
2461
2462 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2463 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2464
2465 =item S
2466
2467 Single 8-bit-byte characters.
2468
2469 =item b
2470
2471 16-bit big endian strings such as those encoded in
2472 UTF-16BE or UCS-2BE.
2473
2474 =item l (lower case letter L)
2475
2476 16-bit little endian such as UTF-16LE and UCS-2LE.
2477 This is useful for examining binaries in Windows guests.
2478
2479 =item B
2480
2481 32-bit big endian such as UCS-4BE.
2482
2483 =item L
2484
2485 32-bit little endian such as UCS-4LE.
2486
2487 =back
2488
2489 The returned strings are transcoded to UTF-8.");
2490
2491   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2492    [InitISOFS, Always, TestOutput (
2493       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2494     (* Test for RHBZ#501888c2 regression which caused large hexdump
2495      * commands to segfault.
2496      *)
2497     InitISOFS, Always, TestRun (
2498       [["hexdump"; "/100krandom"]])],
2499    "dump a file in hexadecimal",
2500    "\
2501 This runs C<hexdump -C> on the given C<path>.  The result is
2502 the human-readable, canonical hex dump of the file.");
2503
2504   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2505    [InitNone, Always, TestOutput (
2506       [["part_disk"; "/dev/sda"; "mbr"];
2507        ["mkfs"; "ext3"; "/dev/sda1"];
2508        ["mount_options"; ""; "/dev/sda1"; "/"];
2509        ["write_file"; "/new"; "test file"; "0"];
2510        ["umount"; "/dev/sda1"];
2511        ["zerofree"; "/dev/sda1"];
2512        ["mount_options"; ""; "/dev/sda1"; "/"];
2513        ["cat"; "/new"]], "test file")],
2514    "zero unused inodes and disk blocks on ext2/3 filesystem",
2515    "\
2516 This runs the I<zerofree> program on C<device>.  This program
2517 claims to zero unused inodes and disk blocks on an ext2/3
2518 filesystem, thus making it possible to compress the filesystem
2519 more effectively.
2520
2521 You should B<not> run this program if the filesystem is
2522 mounted.
2523
2524 It is possible that using this program can damage the filesystem
2525 or data on the filesystem.");
2526
2527   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2528    [],
2529    "resize an LVM physical volume",
2530    "\
2531 This resizes (expands or shrinks) an existing LVM physical
2532 volume to match the new size of the underlying device.");
2533
2534   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2535                        Int "cyls"; Int "heads"; Int "sectors";
2536                        String "line"]), 99, [DangerWillRobinson],
2537    [],
2538    "modify a single partition on a block device",
2539    "\
2540 This runs L<sfdisk(8)> option to modify just the single
2541 partition C<n> (note: C<n> counts from 1).
2542
2543 For other parameters, see C<guestfs_sfdisk>.  You should usually
2544 pass C<0> for the cyls/heads/sectors parameters.
2545
2546 See also: C<guestfs_part_add>");
2547
2548   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2549    [],
2550    "display the partition table",
2551    "\
2552 This displays the partition table on C<device>, in the
2553 human-readable output of the L<sfdisk(8)> command.  It is
2554 not intended to be parsed.
2555
2556 See also: C<guestfs_part_list>");
2557
2558   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2559    [],
2560    "display the kernel geometry",
2561    "\
2562 This displays the kernel's idea of the geometry of C<device>.
2563
2564 The result is in human-readable format, and not designed to
2565 be parsed.");
2566
2567   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2568    [],
2569    "display the disk geometry from the partition table",
2570    "\
2571 This displays the disk geometry of C<device> read from the
2572 partition table.  Especially in the case where the underlying
2573 block device has been resized, this can be different from the
2574 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2575
2576 The result is in human-readable format, and not designed to
2577 be parsed.");
2578
2579   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2580    [],
2581    "activate or deactivate all volume groups",
2582    "\
2583 This command activates or (if C<activate> is false) deactivates
2584 all logical volumes in all volume groups.
2585 If activated, then they are made known to the
2586 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2587 then those devices disappear.
2588
2589 This command is the same as running C<vgchange -a y|n>");
2590
2591   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2592    [],
2593    "activate or deactivate some volume groups",
2594    "\
2595 This command activates or (if C<activate> is false) deactivates
2596 all logical volumes in the listed volume groups C<volgroups>.
2597 If activated, then they are made known to the
2598 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2599 then those devices disappear.
2600
2601 This command is the same as running C<vgchange -a y|n volgroups...>
2602
2603 Note that if C<volgroups> is an empty list then B<all> volume groups
2604 are activated or deactivated.");
2605
2606   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2607    [InitNone, Always, TestOutput (
2608       [["part_disk"; "/dev/sda"; "mbr"];
2609        ["pvcreate"; "/dev/sda1"];
2610        ["vgcreate"; "VG"; "/dev/sda1"];
2611        ["lvcreate"; "LV"; "VG"; "10"];
2612        ["mkfs"; "ext2"; "/dev/VG/LV"];
2613        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2614        ["write_file"; "/new"; "test content"; "0"];
2615        ["umount"; "/"];
2616        ["lvresize"; "/dev/VG/LV"; "20"];
2617        ["e2fsck_f"; "/dev/VG/LV"];
2618        ["resize2fs"; "/dev/VG/LV"];
2619        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2620        ["cat"; "/new"]], "test content");
2621     InitNone, Always, TestRun (
2622       (* Make an LV smaller to test RHBZ#587484. *)
2623       [["part_disk"; "/dev/sda"; "mbr"];
2624        ["pvcreate"; "/dev/sda1"];
2625        ["vgcreate"; "VG"; "/dev/sda1"];
2626        ["lvcreate"; "LV"; "VG"; "20"];
2627        ["lvresize"; "/dev/VG/LV"; "10"]])],
2628    "resize an LVM logical volume",
2629    "\
2630 This resizes (expands or shrinks) an existing LVM logical
2631 volume to C<mbytes>.  When reducing, data in the reduced part
2632 is lost.");
2633
2634   ("resize2fs", (RErr, [Device "device"]), 106, [],
2635    [], (* lvresize tests this *)
2636    "resize an ext2/ext3 filesystem",
2637    "\
2638 This resizes an ext2 or ext3 filesystem to match the size of
2639 the underlying device.
2640
2641 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2642 on the C<device> before calling this command.  For unknown reasons
2643 C<resize2fs> sometimes gives an error about this and sometimes not.
2644 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2645 calling this function.");
2646
2647   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2648    [InitBasicFS, Always, TestOutputList (
2649       [["find"; "/"]], ["lost+found"]);
2650     InitBasicFS, Always, TestOutputList (
2651       [["touch"; "/a"];
2652        ["mkdir"; "/b"];
2653        ["touch"; "/b/c"];
2654        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2655     InitBasicFS, Always, TestOutputList (
2656       [["mkdir_p"; "/a/b/c"];
2657        ["touch"; "/a/b/c/d"];
2658        ["find"; "/a/b/"]], ["c"; "c/d"])],
2659    "find all files and directories",
2660    "\
2661 This command lists out all files and directories, recursively,
2662 starting at C<directory>.  It is essentially equivalent to
2663 running the shell command C<find directory -print> but some
2664 post-processing happens on the output, described below.
2665
2666 This returns a list of strings I<without any prefix>.  Thus
2667 if the directory structure was:
2668
2669  /tmp/a
2670  /tmp/b
2671  /tmp/c/d
2672
2673 then the returned list from C<guestfs_find> C</tmp> would be
2674 4 elements:
2675
2676  a
2677  b
2678  c
2679  c/d
2680
2681 If C<directory> is not a directory, then this command returns
2682 an error.
2683
2684 The returned list is sorted.
2685
2686 See also C<guestfs_find0>.");
2687
2688   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2689    [], (* lvresize tests this *)
2690    "check an ext2/ext3 filesystem",
2691    "\
2692 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2693 filesystem checker on C<device>, noninteractively (C<-p>),
2694 even if the filesystem appears to be clean (C<-f>).
2695
2696 This command is only needed because of C<guestfs_resize2fs>
2697 (q.v.).  Normally you should use C<guestfs_fsck>.");
2698
2699   ("sleep", (RErr, [Int "secs"]), 109, [],
2700    [InitNone, Always, TestRun (
2701       [["sleep"; "1"]])],
2702    "sleep for some seconds",
2703    "\
2704 Sleep for C<secs> seconds.");
2705
2706   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2707    [InitNone, Always, TestOutputInt (
2708       [["part_disk"; "/dev/sda"; "mbr"];
2709        ["mkfs"; "ntfs"; "/dev/sda1"];
2710        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2711     InitNone, Always, TestOutputInt (
2712       [["part_disk"; "/dev/sda"; "mbr"];
2713        ["mkfs"; "ext2"; "/dev/sda1"];
2714        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2715    "probe NTFS volume",
2716    "\
2717 This command runs the L<ntfs-3g.probe(8)> command which probes
2718 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2719 be mounted read-write, and some cannot be mounted at all).
2720
2721 C<rw> is a boolean flag.  Set it to true if you want to test
2722 if the volume can be mounted read-write.  Set it to false if
2723 you want to test if the volume can be mounted read-only.
2724
2725 The return value is an integer which C<0> if the operation
2726 would succeed, or some non-zero value documented in the
2727 L<ntfs-3g.probe(8)> manual page.");
2728
2729   ("sh", (RString "output", [String "command"]), 111, [],
2730    [], (* XXX needs tests *)
2731    "run a command via the shell",
2732    "\
2733 This call runs a command from the guest filesystem via the
2734 guest's C</bin/sh>.
2735
2736 This is like C<guestfs_command>, but passes the command to:
2737
2738  /bin/sh -c \"command\"
2739
2740 Depending on the guest's shell, this usually results in
2741 wildcards being expanded, shell expressions being interpolated
2742 and so on.
2743
2744 All the provisos about C<guestfs_command> apply to this call.");
2745
2746   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2747    [], (* XXX needs tests *)
2748    "run a command via the shell returning lines",
2749    "\
2750 This is the same as C<guestfs_sh>, but splits the result
2751 into a list of lines.
2752
2753 See also: C<guestfs_command_lines>");
2754
2755   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2756    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2757     * code in stubs.c, since all valid glob patterns must start with "/".
2758     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2759     *)
2760    [InitBasicFS, Always, TestOutputList (
2761       [["mkdir_p"; "/a/b/c"];
2762        ["touch"; "/a/b/c/d"];
2763        ["touch"; "/a/b/c/e"];
2764        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2765     InitBasicFS, Always, TestOutputList (
2766       [["mkdir_p"; "/a/b/c"];
2767        ["touch"; "/a/b/c/d"];
2768        ["touch"; "/a/b/c/e"];
2769        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2770     InitBasicFS, Always, TestOutputList (
2771       [["mkdir_p"; "/a/b/c"];
2772        ["touch"; "/a/b/c/d"];
2773        ["touch"; "/a/b/c/e"];
2774        ["glob_expand"; "/a/*/x/*"]], [])],
2775    "expand a wildcard path",
2776    "\
2777 This command searches for all the pathnames matching
2778 C<pattern> according to the wildcard expansion rules
2779 used by the shell.
2780
2781 If no paths match, then this returns an empty list
2782 (note: not an error).
2783
2784 It is just a wrapper around the C L<glob(3)> function
2785 with flags C<GLOB_MARK|GLOB_BRACE>.
2786 See that manual page for more details.");
2787
2788   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2789    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2790       [["scrub_device"; "/dev/sdc"]])],
2791    "scrub (securely wipe) a device",
2792    "\
2793 This command writes patterns over C<device> to make data retrieval
2794 more difficult.
2795
2796 It is an interface to the L<scrub(1)> program.  See that
2797 manual page for more details.");
2798
2799   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2800    [InitBasicFS, Always, TestRun (
2801       [["write_file"; "/file"; "content"; "0"];
2802        ["scrub_file"; "/file"]])],
2803    "scrub (securely wipe) a file",
2804    "\
2805 This command writes patterns over a file to make data retrieval
2806 more difficult.
2807
2808 The file is I<removed> after scrubbing.
2809
2810 It is an interface to the L<scrub(1)> program.  See that
2811 manual page for more details.");
2812
2813   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2814    [], (* XXX needs testing *)
2815    "scrub (securely wipe) free space",
2816    "\
2817 This command creates the directory C<dir> and then fills it
2818 with files until the filesystem is full, and scrubs the files
2819 as for C<guestfs_scrub_file>, and deletes them.
2820 The intention is to scrub any free space on the partition
2821 containing C<dir>.
2822
2823 It is an interface to the L<scrub(1)> program.  See that
2824 manual page for more details.");
2825
2826   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2827    [InitBasicFS, Always, TestRun (
2828       [["mkdir"; "/tmp"];
2829        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2830    "create a temporary directory",
2831    "\
2832 This command creates a temporary directory.  The
2833 C<template> parameter should be a full pathname for the
2834 temporary directory name with the final six characters being
2835 \"XXXXXX\".
2836
2837 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2838 the second one being suitable for Windows filesystems.
2839
2840 The name of the temporary directory that was created
2841 is returned.
2842
2843 The temporary directory is created with mode 0700
2844 and is owned by root.
2845
2846 The caller is responsible for deleting the temporary
2847 directory and its contents after use.
2848
2849 See also: L<mkdtemp(3)>");
2850
2851   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2852    [InitISOFS, Always, TestOutputInt (
2853       [["wc_l"; "/10klines"]], 10000)],
2854    "count lines in a file",
2855    "\
2856 This command counts the lines in a file, using the
2857 C<wc -l> external command.");
2858
2859   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2860    [InitISOFS, Always, TestOutputInt (
2861       [["wc_w"; "/10klines"]], 10000)],
2862    "count words in a file",
2863    "\
2864 This command counts the words in a file, using the
2865 C<wc -w> external command.");
2866
2867   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2868    [InitISOFS, Always, TestOutputInt (
2869       [["wc_c"; "/100kallspaces"]], 102400)],
2870    "count characters in a file",
2871    "\
2872 This command counts the characters in a file, using the
2873 C<wc -c> external command.");
2874
2875   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2876    [InitISOFS, Always, TestOutputList (
2877       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2878    "return first 10 lines of a file",
2879    "\
2880 This command returns up to the first 10 lines of a file as
2881 a list of strings.");
2882
2883   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2884    [InitISOFS, Always, TestOutputList (
2885       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2886     InitISOFS, Always, TestOutputList (
2887       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2888     InitISOFS, Always, TestOutputList (
2889       [["head_n"; "0"; "/10klines"]], [])],
2890    "return first N lines of a file",
2891    "\
2892 If the parameter C<nrlines> is a positive number, this returns the first
2893 C<nrlines> lines of the file C<path>.
2894
2895 If the parameter C<nrlines> is a negative number, this returns lines
2896 from the file C<path>, excluding the last C<nrlines> lines.
2897
2898 If the parameter C<nrlines> is zero, this returns an empty list.");
2899
2900   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2901    [InitISOFS, Always, TestOutputList (
2902       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2903    "return last 10 lines of a file",
2904    "\
2905 This command returns up to the last 10 lines of a file as
2906 a list of strings.");
2907
2908   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2909    [InitISOFS, Always, TestOutputList (
2910       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2911     InitISOFS, Always, TestOutputList (
2912       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2913     InitISOFS, Always, TestOutputList (
2914       [["tail_n"; "0"; "/10klines"]], [])],
2915    "return last N lines of a file",
2916    "\
2917 If the parameter C<nrlines> is a positive number, this returns the last
2918 C<nrlines> lines of the file C<path>.
2919
2920 If the parameter C<nrlines> is a negative number, this returns lines
2921 from the file C<path>, starting with the C<-nrlines>th line.
2922
2923 If the parameter C<nrlines> is zero, this returns an empty list.");
2924
2925   ("df", (RString "output", []), 125, [],
2926    [], (* XXX Tricky to test because it depends on the exact format
2927         * of the 'df' command and other imponderables.
2928         *)
2929    "report file system disk space usage",
2930    "\
2931 This command runs the C<df> command to report disk space used.
2932
2933 This command is mostly useful for interactive sessions.  It
2934 is I<not> intended that you try to parse the output string.
2935 Use C<statvfs> from programs.");
2936
2937   ("df_h", (RString "output", []), 126, [],
2938    [], (* XXX Tricky to test because it depends on the exact format
2939         * of the 'df' command and other imponderables.
2940         *)
2941    "report file system disk space usage (human readable)",
2942    "\
2943 This command runs the C<df -h> command to report disk space used
2944 in human-readable format.
2945
2946 This command is mostly useful for interactive sessions.  It
2947 is I<not> intended that you try to parse the output string.
2948 Use C<statvfs> from programs.");
2949
2950   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2951    [InitISOFS, Always, TestOutputInt (
2952       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2953    "estimate file space usage",
2954    "\
2955 This command runs the C<du -s> command to estimate file space
2956 usage for C<path>.
2957
2958 C<path> can be a file or a directory.  If C<path> is a directory
2959 then the estimate includes the contents of the directory and all
2960 subdirectories (recursively).
2961
2962 The result is the estimated size in I<kilobytes>
2963 (ie. units of 1024 bytes).");
2964
2965   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2966    [InitISOFS, Always, TestOutputList (
2967       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2968    "list files in an initrd",
2969    "\
2970 This command lists out files contained in an initrd.
2971
2972 The files are listed without any initial C</> character.  The
2973 files are listed in the order they appear (not necessarily
2974 alphabetical).  Directory names are listed as separate items.
2975
2976 Old Linux kernels (2.4 and earlier) used a compressed ext2
2977 filesystem as initrd.  We I<only> support the newer initramfs
2978 format (compressed cpio files).");
2979
2980   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2981    [],
2982    "mount a file using the loop device",
2983    "\
2984 This command lets you mount C<file> (a filesystem image
2985 in a file) on a mount point.  It is entirely equivalent to
2986 the command C<mount -o loop file mountpoint>.");
2987
2988   ("mkswap", (RErr, [Device "device"]), 130, [],
2989    [InitEmpty, Always, TestRun (
2990       [["part_disk"; "/dev/sda"; "mbr"];
2991        ["mkswap"; "/dev/sda1"]])],
2992    "create a swap partition",
2993    "\
2994 Create a swap partition on C<device>.");
2995
2996   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
2997    [InitEmpty, Always, TestRun (
2998       [["part_disk"; "/dev/sda"; "mbr"];
2999        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3000    "create a swap partition with a label",
3001    "\
3002 Create a swap partition on C<device> with label C<label>.
3003
3004 Note that you cannot attach a swap label to a block device
3005 (eg. C</dev/sda>), just to a partition.  This appears to be
3006 a limitation of the kernel or swap tools.");
3007
3008   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3009    (let uuid = uuidgen () in
3010     [InitEmpty, Always, TestRun (
3011        [["part_disk"; "/dev/sda"; "mbr"];
3012         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3013    "create a swap partition with an explicit UUID",
3014    "\
3015 Create a swap partition on C<device> with UUID C<uuid>.");
3016
3017   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3018    [InitBasicFS, Always, TestOutputStruct (
3019       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3020        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3021        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3022     InitBasicFS, Always, TestOutputStruct (
3023       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3024        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3025    "make block, character or FIFO devices",
3026    "\
3027 This call creates block or character special devices, or
3028 named pipes (FIFOs).
3029
3030 The C<mode> parameter should be the mode, using the standard
3031 constants.  C<devmajor> and C<devminor> are the
3032 device major and minor numbers, only used when creating block
3033 and character special devices.
3034
3035 Note that, just like L<mknod(2)>, the mode must be bitwise
3036 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3037 just creates a regular file).  These constants are
3038 available in the standard Linux header files, or you can use
3039 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3040 which are wrappers around this command which bitwise OR
3041 in the appropriate constant for you.
3042
3043 The mode actually set is affected by the umask.");
3044
3045   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3046    [InitBasicFS, Always, TestOutputStruct (
3047       [["mkfifo"; "0o777"; "/node"];
3048        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3049    "make FIFO (named pipe)",
3050    "\
3051 This call creates a FIFO (named pipe) called C<path> with
3052 mode C<mode>.  It is just a convenient wrapper around
3053 C<guestfs_mknod>.
3054
3055 The mode actually set is affected by the umask.");
3056
3057   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3058    [InitBasicFS, Always, TestOutputStruct (
3059       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3060        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3061    "make block device node",
3062    "\
3063 This call creates a block device node called C<path> with
3064 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3065 It is just a convenient wrapper around C<guestfs_mknod>.
3066
3067 The mode actually set is affected by the umask.");
3068
3069   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3070    [InitBasicFS, Always, TestOutputStruct (
3071       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3072        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3073    "make char device node",
3074    "\
3075 This call creates a char device node called C<path> with
3076 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3077 It is just a convenient wrapper around C<guestfs_mknod>.
3078
3079 The mode actually set is affected by the umask.");
3080
3081   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3082    [InitEmpty, Always, TestOutputInt (
3083       [["umask"; "0o22"]], 0o22)],
3084    "set file mode creation mask (umask)",
3085    "\
3086 This function sets the mask used for creating new files and
3087 device nodes to C<mask & 0777>.
3088
3089 Typical umask values would be C<022> which creates new files
3090 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3091 C<002> which creates new files with permissions like
3092 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3093
3094 The default umask is C<022>.  This is important because it
3095 means that directories and device nodes will be created with
3096 C<0644> or C<0755> mode even if you specify C<0777>.
3097
3098 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3099
3100 This call returns the previous umask.");
3101
3102   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3103    [],
3104    "read directories entries",
3105    "\
3106 This returns the list of directory entries in directory C<dir>.
3107
3108 All entries in the directory are returned, including C<.> and
3109 C<..>.  The entries are I<not> sorted, but returned in the same
3110 order as the underlying filesystem.
3111
3112 Also this call returns basic file type information about each
3113 file.  The C<ftyp> field will contain one of the following characters:
3114
3115 =over 4
3116
3117 =item 'b'
3118
3119 Block special
3120
3121 =item 'c'
3122
3123 Char special
3124
3125 =item 'd'
3126
3127 Directory
3128
3129 =item 'f'
3130
3131 FIFO (named pipe)
3132
3133 =item 'l'
3134
3135 Symbolic link
3136
3137 =item 'r'
3138
3139 Regular file
3140
3141 =item 's'
3142
3143 Socket
3144
3145 =item 'u'
3146
3147 Unknown file type
3148
3149 =item '?'
3150
3151 The L<readdir(3)> call returned a C<d_type> field with an
3152 unexpected value
3153
3154 =back
3155
3156 This function is primarily intended for use by programs.  To
3157 get a simple list of names, use C<guestfs_ls>.  To get a printable
3158 directory for human consumption, use C<guestfs_ll>.");
3159
3160   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3161    [],
3162    "create partitions on a block device",
3163    "\
3164 This is a simplified interface to the C<guestfs_sfdisk>
3165 command, where partition sizes are specified in megabytes
3166 only (rounded to the nearest cylinder) and you don't need
3167 to specify the cyls, heads and sectors parameters which
3168 were rarely if ever used anyway.
3169
3170 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3171 and C<guestfs_part_disk>");
3172
3173   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3174    [],
3175    "determine file type inside a compressed file",
3176    "\
3177 This command runs C<file> after first decompressing C<path>
3178 using C<method>.
3179
3180 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3181
3182 Since 1.0.63, use C<guestfs_file> instead which can now
3183 process compressed files.");
3184
3185   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3186    [],
3187    "list extended attributes of a file or directory",
3188    "\
3189 This call lists the extended attributes of the file or directory
3190 C<path>.
3191
3192 At the system call level, this is a combination of the
3193 L<listxattr(2)> and L<getxattr(2)> calls.
3194
3195 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3196
3197   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3198    [],
3199    "list extended attributes of a file or directory",
3200    "\
3201 This is the same as C<guestfs_getxattrs>, but if C<path>
3202 is a symbolic link, then it returns the extended attributes
3203 of the link itself.");
3204
3205   ("setxattr", (RErr, [String "xattr";
3206                        String "val"; Int "vallen"; (* will be BufferIn *)
3207                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3208    [],
3209    "set extended attribute of a file or directory",
3210    "\
3211 This call sets the extended attribute named C<xattr>
3212 of the file C<path> to the value C<val> (of length C<vallen>).
3213 The value is arbitrary 8 bit data.
3214
3215 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3216
3217   ("lsetxattr", (RErr, [String "xattr";
3218                         String "val"; Int "vallen"; (* will be BufferIn *)
3219                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3220    [],
3221    "set extended attribute of a file or directory",
3222    "\
3223 This is the same as C<guestfs_setxattr>, but if C<path>
3224 is a symbolic link, then it sets an extended attribute
3225 of the link itself.");
3226
3227   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3228    [],
3229    "remove extended attribute of a file or directory",
3230    "\
3231 This call removes the extended attribute named C<xattr>
3232 of the file C<path>.
3233
3234 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3235
3236   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3237    [],
3238    "remove extended attribute of a file or directory",
3239    "\
3240 This is the same as C<guestfs_removexattr>, but if C<path>
3241 is a symbolic link, then it removes an extended attribute
3242 of the link itself.");
3243
3244   ("mountpoints", (RHashtable "mps", []), 147, [],
3245    [],
3246    "show mountpoints",
3247    "\
3248 This call is similar to C<guestfs_mounts>.  That call returns
3249 a list of devices.  This one returns a hash table (map) of
3250 device name to directory where the device is mounted.");
3251
3252   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3253    (* This is a special case: while you would expect a parameter
3254     * of type "Pathname", that doesn't work, because it implies
3255     * NEED_ROOT in the generated calling code in stubs.c, and
3256     * this function cannot use NEED_ROOT.
3257     *)
3258    [],
3259    "create a mountpoint",
3260    "\
3261 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3262 specialized calls that can be used to create extra mountpoints
3263 before mounting the first filesystem.
3264
3265 These calls are I<only> necessary in some very limited circumstances,
3266 mainly the case where you want to mount a mix of unrelated and/or
3267 read-only filesystems together.
3268
3269 For example, live CDs often contain a \"Russian doll\" nest of
3270 filesystems, an ISO outer layer, with a squashfs image inside, with
3271 an ext2/3 image inside that.  You can unpack this as follows
3272 in guestfish:
3273
3274  add-ro Fedora-11-i686-Live.iso
3275  run
3276  mkmountpoint /cd
3277  mkmountpoint /squash
3278  mkmountpoint /ext3
3279  mount /dev/sda /cd
3280  mount-loop /cd/LiveOS/squashfs.img /squash
3281  mount-loop /squash/LiveOS/ext3fs.img /ext3
3282
3283 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3284
3285   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3286    [],
3287    "remove a mountpoint",
3288    "\
3289 This calls removes a mountpoint that was previously created
3290 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3291 for full details.");
3292
3293   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3294    [InitISOFS, Always, TestOutputBuffer (
3295       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3296     (* Test various near large, large and too large files (RHBZ#589039). *)
3297     InitBasicFS, Always, TestLastFail (
3298       [["touch"; "/a"];
3299        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3300        ["read_file"; "/a"]]);
3301     InitBasicFS, Always, TestLastFail (
3302       [["touch"; "/a"];
3303        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3304        ["read_file"; "/a"]]);
3305     InitBasicFS, Always, TestLastFail (
3306       [["touch"; "/a"];
3307        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3308        ["read_file"; "/a"]])],
3309    "read a file",
3310    "\
3311 This calls returns the contents of the file C<path> as a
3312 buffer.
3313
3314 Unlike C<guestfs_cat>, this function can correctly
3315 handle files that contain embedded ASCII NUL characters.
3316 However unlike C<guestfs_download>, this function is limited
3317 in the total size of file that can be handled.");
3318
3319   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3320    [InitISOFS, Always, TestOutputList (
3321       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3322     InitISOFS, Always, TestOutputList (
3323       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3324    "return lines matching a pattern",
3325    "\
3326 This calls the external C<grep> program and returns the
3327 matching lines.");
3328
3329   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3330    [InitISOFS, Always, TestOutputList (
3331       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3332    "return lines matching a pattern",
3333    "\
3334 This calls the external C<egrep> program and returns the
3335 matching lines.");
3336
3337   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3338    [InitISOFS, Always, TestOutputList (
3339       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3340    "return lines matching a pattern",
3341    "\
3342 This calls the external C<fgrep> program and returns the
3343 matching lines.");
3344
3345   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3346    [InitISOFS, Always, TestOutputList (
3347       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3348    "return lines matching a pattern",
3349    "\
3350 This calls the external C<grep -i> program and returns the
3351 matching lines.");
3352
3353   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3354    [InitISOFS, Always, TestOutputList (
3355       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3356    "return lines matching a pattern",
3357    "\
3358 This calls the external C<egrep -i> program and returns the
3359 matching lines.");
3360
3361   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3362    [InitISOFS, Always, TestOutputList (
3363       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3364    "return lines matching a pattern",
3365    "\
3366 This calls the external C<fgrep -i> program and returns the
3367 matching lines.");
3368
3369   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3370    [InitISOFS, Always, TestOutputList (
3371       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3372    "return lines matching a pattern",
3373    "\
3374 This calls the external C<zgrep> program and returns the
3375 matching lines.");
3376
3377   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3378    [InitISOFS, Always, TestOutputList (
3379       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3380    "return lines matching a pattern",
3381    "\
3382 This calls the external C<zegrep> program and returns the
3383 matching lines.");
3384
3385   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3386    [InitISOFS, Always, TestOutputList (
3387       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3388    "return lines matching a pattern",
3389    "\
3390 This calls the external C<zfgrep> program and returns the
3391 matching lines.");
3392
3393   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3394    [InitISOFS, Always, TestOutputList (
3395       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3396    "return lines matching a pattern",
3397    "\
3398 This calls the external C<zgrep -i> program and returns the
3399 matching lines.");
3400
3401   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3402    [InitISOFS, Always, TestOutputList (
3403       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3404    "return lines matching a pattern",
3405    "\
3406 This calls the external C<zegrep -i> program and returns the
3407 matching lines.");
3408
3409   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3410    [InitISOFS, Always, TestOutputList (
3411       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3412    "return lines matching a pattern",
3413    "\
3414 This calls the external C<zfgrep -i> program and returns the
3415 matching lines.");
3416
3417   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3418    [InitISOFS, Always, TestOutput (
3419       [["realpath"; "/../directory"]], "/directory")],
3420    "canonicalized absolute pathname",
3421    "\
3422 Return the canonicalized absolute pathname of C<path>.  The
3423 returned path has no C<.>, C<..> or symbolic link path elements.");
3424
3425   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3426    [InitBasicFS, Always, TestOutputStruct (
3427       [["touch"; "/a"];
3428        ["ln"; "/a"; "/b"];
3429        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3430    "create a hard link",
3431    "\
3432 This command creates a hard link using the C<ln> command.");
3433
3434   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3435    [InitBasicFS, Always, TestOutputStruct (
3436       [["touch"; "/a"];
3437        ["touch"; "/b"];
3438        ["ln_f"; "/a"; "/b"];
3439        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3440    "create a hard link",
3441    "\
3442 This command creates a hard link using the C<ln -f> command.
3443 The C<-f> option removes the link (C<linkname>) if it exists already.");
3444
3445   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3446    [InitBasicFS, Always, TestOutputStruct (
3447       [["touch"; "/a"];
3448        ["ln_s"; "a"; "/b"];
3449        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3450    "create a symbolic link",
3451    "\
3452 This command creates a symbolic link using the C<ln -s> command.");
3453
3454   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3455    [InitBasicFS, Always, TestOutput (
3456       [["mkdir_p"; "/a/b"];
3457        ["touch"; "/a/b/c"];
3458        ["ln_sf"; "../d"; "/a/b/c"];
3459        ["readlink"; "/a/b/c"]], "../d")],
3460    "create a symbolic link",
3461    "\
3462 This command creates a symbolic link using the C<ln -sf> command,
3463 The C<-f> option removes the link (C<linkname>) if it exists already.");
3464
3465   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3466    [] (* XXX tested above *),
3467    "read the target of a symbolic link",
3468    "\
3469 This command reads the target of a symbolic link.");
3470
3471   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3472    [InitBasicFS, Always, TestOutputStruct (
3473       [["fallocate"; "/a"; "1000000"];
3474        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3475    "preallocate a file in the guest filesystem",
3476    "\
3477 This command preallocates a file (containing zero bytes) named
3478 C<path> of size C<len> bytes.  If the file exists already, it
3479 is overwritten.
3480
3481 Do not confuse this with the guestfish-specific
3482 C<alloc> command which allocates a file in the host and
3483 attaches it as a device.");
3484
3485   ("swapon_device", (RErr, [Device "device"]), 170, [],
3486    [InitPartition, Always, TestRun (
3487       [["mkswap"; "/dev/sda1"];
3488        ["swapon_device"; "/dev/sda1"];
3489        ["swapoff_device"; "/dev/sda1"]])],
3490    "enable swap on device",
3491    "\
3492 This command enables the libguestfs appliance to use the
3493 swap device or partition named C<device>.  The increased
3494 memory is made available for all commands, for example
3495 those run using C<guestfs_command> or C<guestfs_sh>.
3496
3497 Note that you should not swap to existing guest swap
3498 partitions unless you know what you are doing.  They may
3499 contain hibernation information, or other information that
3500 the guest doesn't want you to trash.  You also risk leaking
3501 information about the host to the guest this way.  Instead,
3502 attach a new host device to the guest and swap on that.");
3503
3504   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3505    [], (* XXX tested by swapon_device *)
3506    "disable swap on device",
3507    "\
3508 This command disables the libguestfs appliance swap
3509 device or partition named C<device>.
3510 See C<guestfs_swapon_device>.");
3511
3512   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3513    [InitBasicFS, Always, TestRun (
3514       [["fallocate"; "/swap"; "8388608"];
3515        ["mkswap_file"; "/swap"];
3516        ["swapon_file"; "/swap"];
3517        ["swapoff_file"; "/swap"]])],
3518    "enable swap on file",
3519    "\
3520 This command enables swap to a file.
3521 See C<guestfs_swapon_device> for other notes.");
3522
3523   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3524    [], (* XXX tested by swapon_file *)
3525    "disable swap on file",
3526    "\
3527 This command disables the libguestfs appliance swap on file.");
3528
3529   ("swapon_label", (RErr, [String "label"]), 174, [],
3530    [InitEmpty, Always, TestRun (
3531       [["part_disk"; "/dev/sdb"; "mbr"];
3532        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3533        ["swapon_label"; "swapit"];
3534        ["swapoff_label"; "swapit"];
3535        ["zero"; "/dev/sdb"];
3536        ["blockdev_rereadpt"; "/dev/sdb"]])],
3537    "enable swap on labeled swap partition",
3538    "\
3539 This command enables swap to a labeled swap partition.
3540 See C<guestfs_swapon_device> for other notes.");
3541
3542   ("swapoff_label", (RErr, [String "label"]), 175, [],
3543    [], (* XXX tested by swapon_label *)
3544    "disable swap on labeled swap partition",
3545    "\
3546 This command disables the libguestfs appliance swap on
3547 labeled swap partition.");
3548
3549   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3550    (let uuid = uuidgen () in
3551     [InitEmpty, Always, TestRun (
3552        [["mkswap_U"; uuid; "/dev/sdb"];
3553         ["swapon_uuid"; uuid];
3554         ["swapoff_uuid"; uuid]])]),
3555    "enable swap on swap partition by UUID",
3556    "\
3557 This command enables swap to a swap partition with the given UUID.
3558 See C<guestfs_swapon_device> for other notes.");
3559
3560   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3561    [], (* XXX tested by swapon_uuid *)
3562    "disable swap on swap partition by UUID",
3563    "\
3564 This command disables the libguestfs appliance swap partition
3565 with the given UUID.");
3566
3567   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3568    [InitBasicFS, Always, TestRun (
3569       [["fallocate"; "/swap"; "8388608"];
3570        ["mkswap_file"; "/swap"]])],
3571    "create a swap file",
3572    "\
3573 Create a swap file.
3574
3575 This command just writes a swap file signature to an existing
3576 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3577
3578   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3579    [InitISOFS, Always, TestRun (
3580       [["inotify_init"; "0"]])],
3581    "create an inotify handle",
3582    "\
3583 This command creates a new inotify handle.
3584 The inotify subsystem can be used to notify events which happen to
3585 objects in the guest filesystem.
3586
3587 C<maxevents> is the maximum number of events which will be
3588 queued up between calls to C<guestfs_inotify_read> or
3589 C<guestfs_inotify_files>.
3590 If this is passed as C<0>, then the kernel (or previously set)
3591 default is used.  For Linux 2.6.29 the default was 16384 events.
3592 Beyond this limit, the kernel throws away events, but records
3593 the fact that it threw them away by setting a flag
3594 C<IN_Q_OVERFLOW> in the returned structure list (see
3595 C<guestfs_inotify_read>).
3596
3597 Before any events are generated, you have to add some
3598 watches to the internal watch list.  See:
3599 C<guestfs_inotify_add_watch>,
3600 C<guestfs_inotify_rm_watch> and
3601 C<guestfs_inotify_watch_all>.
3602
3603 Queued up events should be read periodically by calling
3604 C<guestfs_inotify_read>
3605 (or C<guestfs_inotify_files> which is just a helpful
3606 wrapper around C<guestfs_inotify_read>).  If you don't
3607 read the events out often enough then you risk the internal
3608 queue overflowing.
3609
3610 The handle should be closed after use by calling
3611 C<guestfs_inotify_close>.  This also removes any
3612 watches automatically.
3613
3614 See also L<inotify(7)> for an overview of the inotify interface
3615 as exposed by the Linux kernel, which is roughly what we expose
3616 via libguestfs.  Note that there is one global inotify handle
3617 per libguestfs instance.");
3618
3619   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3620    [InitBasicFS, Always, TestOutputList (
3621       [["inotify_init"; "0"];
3622        ["inotify_add_watch"; "/"; "1073741823"];
3623        ["touch"; "/a"];
3624        ["touch"; "/b"];
3625        ["inotify_files"]], ["a"; "b"])],
3626    "add an inotify watch",
3627    "\
3628 Watch C<path> for the events listed in C<mask>.
3629
3630 Note that if C<path> is a directory then events within that
3631 directory are watched, but this does I<not> happen recursively
3632 (in subdirectories).
3633
3634 Note for non-C or non-Linux callers: the inotify events are
3635 defined by the Linux kernel ABI and are listed in
3636 C</usr/include/sys/inotify.h>.");
3637
3638   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3639    [],
3640    "remove an inotify watch",
3641    "\
3642 Remove a previously defined inotify watch.
3643 See C<guestfs_inotify_add_watch>.");
3644
3645   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3646    [],
3647    "return list of inotify events",
3648    "\
3649 Return the complete queue of events that have happened
3650 since the previous read call.
3651
3652 If no events have happened, this returns an empty list.
3653
3654 I<Note>: In order to make sure that all events have been
3655 read, you must call this function repeatedly until it
3656 returns an empty list.  The reason is that the call will
3657 read events up to the maximum appliance-to-host message
3658 size and leave remaining events in the queue.");
3659
3660   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3661    [],
3662    "return list of watched files that had events",
3663    "\
3664 This function is a helpful wrapper around C<guestfs_inotify_read>
3665 which just returns a list of pathnames of objects that were
3666 touched.  The returned pathnames are sorted and deduplicated.");
3667
3668   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3669    [],
3670    "close the inotify handle",
3671    "\
3672 This closes the inotify handle which was previously
3673 opened by inotify_init.  It removes all watches, throws
3674 away any pending events, and deallocates all resources.");
3675
3676   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3677    [],
3678    "set SELinux security context",
3679    "\
3680 This sets the SELinux security context of the daemon
3681 to the string C<context>.
3682
3683 See the documentation about SELINUX in L<guestfs(3)>.");
3684
3685   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3686    [],
3687    "get SELinux security context",
3688    "\
3689 This gets the SELinux security context of the daemon.
3690
3691 See the documentation about SELINUX in L<guestfs(3)>,
3692 and C<guestfs_setcon>");
3693
3694   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3695    [InitEmpty, Always, TestOutput (
3696       [["part_disk"; "/dev/sda"; "mbr"];
3697        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3698        ["mount_options"; ""; "/dev/sda1"; "/"];
3699        ["write_file"; "/new"; "new file contents"; "0"];
3700        ["cat"; "/new"]], "new file contents")],
3701    "make a filesystem with block size",
3702    "\
3703 This call is similar to C<guestfs_mkfs>, but it allows you to
3704 control the block size of the resulting filesystem.  Supported
3705 block sizes depend on the filesystem type, but typically they
3706 are C<1024>, C<2048> or C<4096> only.");
3707
3708   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3709    [InitEmpty, Always, TestOutput (
3710       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3711        ["mke2journal"; "4096"; "/dev/sda1"];
3712        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3713        ["mount_options"; ""; "/dev/sda2"; "/"];
3714        ["write_file"; "/new"; "new file contents"; "0"];
3715        ["cat"; "/new"]], "new file contents")],
3716    "make ext2/3/4 external journal",
3717    "\
3718 This creates an ext2 external journal on C<device>.  It is equivalent
3719 to the command:
3720
3721  mke2fs -O journal_dev -b blocksize device");
3722
3723   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3724    [InitEmpty, Always, TestOutput (
3725       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3726        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3727        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3728        ["mount_options"; ""; "/dev/sda2"; "/"];
3729        ["write_file"; "/new"; "new file contents"; "0"];
3730        ["cat"; "/new"]], "new file contents")],
3731    "make ext2/3/4 external journal with label",
3732    "\
3733 This creates an ext2 external journal on C<device> with label C<label>.");
3734
3735   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3736    (let uuid = uuidgen () in
3737     [InitEmpty, Always, TestOutput (
3738        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3739         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3740         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3741         ["mount_options"; ""; "/dev/sda2"; "/"];
3742         ["write_file"; "/new"; "new file contents"; "0"];
3743         ["cat"; "/new"]], "new file contents")]),
3744    "make ext2/3/4 external journal with UUID",
3745    "\
3746 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3747
3748   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3749    [],
3750    "make ext2/3/4 filesystem with external journal",
3751    "\
3752 This creates an ext2/3/4 filesystem on C<device> with
3753 an external journal on C<journal>.  It is equivalent
3754 to the command:
3755
3756  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3757
3758 See also C<guestfs_mke2journal>.");
3759
3760   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3761    [],
3762    "make ext2/3/4 filesystem with external journal",
3763    "\
3764 This creates an ext2/3/4 filesystem on C<device> with
3765 an external journal on the journal labeled C<label>.
3766
3767 See also C<guestfs_mke2journal_L>.");
3768
3769   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3770    [],
3771    "make ext2/3/4 filesystem with external journal",
3772    "\
3773 This creates an ext2/3/4 filesystem on C<device> with
3774 an external journal on the journal with UUID C<uuid>.
3775
3776 See also C<guestfs_mke2journal_U>.");
3777
3778   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3779    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3780    "load a kernel module",
3781    "\
3782 This loads a kernel module in the appliance.
3783
3784 The kernel module must have been whitelisted when libguestfs
3785 was built (see C<appliance/kmod.whitelist.in> in the source).");
3786
3787   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3788    [InitNone, Always, TestOutput (
3789       [["echo_daemon"; "This is a test"]], "This is a test"
3790     )],
3791    "echo arguments back to the client",
3792    "\
3793 This command concatenates the list of C<words> passed with single spaces
3794 between them and returns the resulting string.
3795
3796 You can use this command to test the connection through to the daemon.
3797
3798 See also C<guestfs_ping_daemon>.");
3799
3800   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3801    [], (* There is a regression test for this. *)
3802    "find all files and directories, returning NUL-separated list",
3803    "\
3804 This command lists out all files and directories, recursively,
3805 starting at C<directory>, placing the resulting list in the
3806 external file called C<files>.
3807
3808 This command works the same way as C<guestfs_find> with the
3809 following exceptions:
3810
3811 =over 4
3812
3813 =item *
3814
3815 The resulting list is written to an external file.
3816
3817 =item *
3818
3819 Items (filenames) in the result are separated
3820 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3821
3822 =item *
3823
3824 This command is not limited in the number of names that it
3825 can return.
3826
3827 =item *
3828
3829 The result list is not sorted.
3830
3831 =back");
3832
3833   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3834    [InitISOFS, Always, TestOutput (
3835       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3836     InitISOFS, Always, TestOutput (
3837       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3838     InitISOFS, Always, TestOutput (
3839       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3840     InitISOFS, Always, TestLastFail (
3841       [["case_sensitive_path"; "/Known-1/"]]);
3842     InitBasicFS, Always, TestOutput (
3843       [["mkdir"; "/a"];
3844        ["mkdir"; "/a/bbb"];
3845        ["touch"; "/a/bbb/c"];
3846        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3847     InitBasicFS, Always, TestOutput (
3848       [["mkdir"; "/a"];
3849        ["mkdir"; "/a/bbb"];
3850        ["touch"; "/a/bbb/c"];
3851        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3852     InitBasicFS, Always, TestLastFail (
3853       [["mkdir"; "/a"];
3854        ["mkdir"; "/a/bbb"];
3855        ["touch"; "/a/bbb/c"];
3856        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3857    "return true path on case-insensitive filesystem",
3858    "\
3859 This can be used to resolve case insensitive paths on
3860 a filesystem which is case sensitive.  The use case is
3861 to resolve paths which you have read from Windows configuration
3862 files or the Windows Registry, to the true path.
3863
3864 The command handles a peculiarity of the Linux ntfs-3g
3865 filesystem driver (and probably others), which is that although
3866 the underlying filesystem is case-insensitive, the driver
3867 exports the filesystem to Linux as case-sensitive.
3868
3869 One consequence of this is that special directories such
3870 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3871 (or other things) depending on the precise details of how
3872 they were created.  In Windows itself this would not be
3873 a problem.
3874
3875 Bug or feature?  You decide:
3876 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3877
3878 This function resolves the true case of each element in the
3879 path and returns the case-sensitive path.
3880
3881 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3882 might return C<\"/WINDOWS/system32\"> (the exact return value
3883 would depend on details of how the directories were originally
3884 created under Windows).
3885
3886 I<Note>:
3887 This function does not handle drive names, backslashes etc.
3888
3889 See also C<guestfs_realpath>.");
3890
3891   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3892    [InitBasicFS, Always, TestOutput (
3893       [["vfs_type"; "/dev/sda1"]], "ext2")],
3894    "get the Linux VFS type corresponding to a mounted device",
3895    "\
3896 This command gets the filesystem type corresponding to
3897 the filesystem on C<device>.
3898
3899 For most filesystems, the result is the name of the Linux
3900 VFS module which would be used to mount this filesystem
3901 if you mounted it without specifying the filesystem type.
3902 For example a string such as C<ext3> or C<ntfs>.");
3903
3904   ("truncate", (RErr, [Pathname "path"]), 199, [],
3905    [InitBasicFS, Always, TestOutputStruct (
3906       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3907        ["truncate"; "/test"];
3908        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3909    "truncate a file to zero size",
3910    "\
3911 This command truncates C<path> to a zero-length file.  The
3912 file must exist already.");
3913
3914   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3915    [InitBasicFS, Always, TestOutputStruct (
3916       [["touch"; "/test"];
3917        ["truncate_size"; "/test"; "1000"];
3918        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3919    "truncate a file to a particular size",
3920    "\
3921 This command truncates C<path> to size C<size> bytes.  The file
3922 must exist already.
3923
3924 If the current file size is less than C<size> then
3925 the file is extended to the required size with zero bytes.
3926 This creates a sparse file (ie. disk blocks are not allocated
3927 for the file until you write to it).  To create a non-sparse
3928 file of zeroes, use C<guestfs_fallocate64> instead.");
3929
3930   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3931    [InitBasicFS, Always, TestOutputStruct (
3932       [["touch"; "/test"];
3933        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3934        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3935    "set timestamp of a file with nanosecond precision",
3936    "\
3937 This command sets the timestamps of a file with nanosecond
3938 precision.
3939
3940 C<atsecs, atnsecs> are the last access time (atime) in secs and
3941 nanoseconds from the epoch.
3942
3943 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3944 secs and nanoseconds from the epoch.
3945
3946 If the C<*nsecs> field contains the special value C<-1> then
3947 the corresponding timestamp is set to the current time.  (The
3948 C<*secs> field is ignored in this case).
3949
3950 If the C<*nsecs> field contains the special value C<-2> then
3951 the corresponding timestamp is left unchanged.  (The
3952 C<*secs> field is ignored in this case).");
3953
3954   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3955    [InitBasicFS, Always, TestOutputStruct (
3956       [["mkdir_mode"; "/test"; "0o111"];
3957        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3958    "create a directory with a particular mode",
3959    "\
3960 This command creates a directory, setting the initial permissions
3961 of the directory to C<mode>.
3962
3963 For common Linux filesystems, the actual mode which is set will
3964 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3965 interpret the mode in other ways.
3966
3967 See also C<guestfs_mkdir>, C<guestfs_umask>");
3968
3969   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3970    [], (* XXX *)
3971    "change file owner and group",
3972    "\
3973 Change the file owner to C<owner> and group to C<group>.
3974 This is like C<guestfs_chown> but if C<path> is a symlink then
3975 the link itself is changed, not the target.
3976
3977 Only numeric uid and gid are supported.  If you want to use
3978 names, you will need to locate and parse the password file
3979 yourself (Augeas support makes this relatively easy).");
3980
3981   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3982    [], (* XXX *)
3983    "lstat on multiple files",
3984    "\
3985 This call allows you to perform the C<guestfs_lstat> operation
3986 on multiple files, where all files are in the directory C<path>.
3987 C<names> is the list of files from this directory.
3988
3989 On return you get a list of stat structs, with a one-to-one
3990 correspondence to the C<names> list.  If any name did not exist
3991 or could not be lstat'd, then the C<ino> field of that structure
3992 is set to C<-1>.
3993
3994 This call is intended for programs that want to efficiently
3995 list a directory contents without making many round-trips.
3996 See also C<guestfs_lxattrlist> for a similarly efficient call
3997 for getting extended attributes.  Very long directory listings
3998 might cause the protocol message size to be exceeded, causing
3999 this call to fail.  The caller must split up such requests
4000 into smaller groups of names.");
4001
4002   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4003    [], (* XXX *)
4004    "lgetxattr on multiple files",
4005    "\
4006 This call allows you to get the extended attributes
4007 of multiple files, where all files are in the directory C<path>.
4008 C<names> is the list of files from this directory.
4009
4010 On return you get a flat list of xattr structs which must be
4011 interpreted sequentially.  The first xattr struct always has a zero-length
4012 C<attrname>.  C<attrval> in this struct is zero-length
4013 to indicate there was an error doing C<lgetxattr> for this
4014 file, I<or> is a C string which is a decimal number
4015 (the number of following attributes for this file, which could
4016 be C<\"0\">).  Then after the first xattr struct are the
4017 zero or more attributes for the first named file.
4018 This repeats for the second and subsequent files.
4019
4020 This call is intended for programs that want to efficiently
4021 list a directory contents without making many round-trips.
4022 See also C<guestfs_lstatlist> for a similarly efficient call
4023 for getting standard stats.  Very long directory listings
4024 might cause the protocol message size to be exceeded, causing
4025 this call to fail.  The caller must split up such requests
4026 into smaller groups of names.");
4027
4028   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4029    [], (* XXX *)
4030    "readlink on multiple files",
4031    "\
4032 This call allows you to do a C<readlink> operation
4033 on multiple files, where all files are in the directory C<path>.
4034 C<names> is the list of files from this directory.
4035
4036 On return you get a list of strings, with a one-to-one
4037 correspondence to the C<names> list.  Each string is the
4038 value of the symbolic link.
4039
4040 If the C<readlink(2)> operation fails on any name, then
4041 the corresponding result string is the empty string C<\"\">.
4042 However the whole operation is completed even if there
4043 were C<readlink(2)> errors, and so you can call this
4044 function with names where you don't know if they are
4045 symbolic links already (albeit slightly less efficient).
4046
4047 This call is intended for programs that want to efficiently
4048 list a directory contents without making many round-trips.
4049 Very long directory listings might cause the protocol
4050 message size to be exceeded, causing
4051 this call to fail.  The caller must split up such requests
4052 into smaller groups of names.");
4053
4054   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4055    [InitISOFS, Always, TestOutputBuffer (
4056       [["pread"; "/known-4"; "1"; "3"]], "\n");
4057     InitISOFS, Always, TestOutputBuffer (
4058       [["pread"; "/empty"; "0"; "100"]], "")],
4059    "read part of a file",
4060    "\
4061 This command lets you read part of a file.  It reads C<count>
4062 bytes of the file, starting at C<offset>, from file C<path>.
4063
4064 This may read fewer bytes than requested.  For further details
4065 see the L<pread(2)> system call.");
4066
4067   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4068    [InitEmpty, Always, TestRun (
4069       [["part_init"; "/dev/sda"; "gpt"]])],
4070    "create an empty partition table",
4071    "\
4072 This creates an empty partition table on C<device> of one of the
4073 partition types listed below.  Usually C<parttype> should be
4074 either C<msdos> or C<gpt> (for large disks).
4075
4076 Initially there are no partitions.  Following this, you should
4077 call C<guestfs_part_add> for each partition required.
4078
4079 Possible values for C<parttype> are:
4080
4081 =over 4
4082
4083 =item B<efi> | B<gpt>
4084
4085 Intel EFI / GPT partition table.
4086
4087 This is recommended for >= 2 TB partitions that will be accessed
4088 from Linux and Intel-based Mac OS X.  It also has limited backwards
4089 compatibility with the C<mbr> format.
4090
4091 =item B<mbr> | B<msdos>
4092
4093 The standard PC \"Master Boot Record\" (MBR) format used
4094 by MS-DOS and Windows.  This partition type will B<only> work
4095 for device sizes up to 2 TB.  For large disks we recommend
4096 using C<gpt>.
4097
4098 =back
4099
4100 Other partition table types that may work but are not
4101 supported include:
4102
4103 =over 4
4104
4105 =item B<aix>
4106
4107 AIX disk labels.
4108
4109 =item B<amiga> | B<rdb>
4110
4111 Amiga \"Rigid Disk Block\" format.
4112
4113 =item B<bsd>
4114
4115 BSD disk labels.
4116
4117 =item B<dasd>
4118
4119 DASD, used on IBM mainframes.
4120
4121 =item B<dvh>
4122
4123 MIPS/SGI volumes.
4124
4125 =item B<mac>
4126
4127 Old Mac partition format.  Modern Macs use C<gpt>.
4128
4129 =item B<pc98>
4130
4131 NEC PC-98 format, common in Japan apparently.
4132
4133 =item B<sun>
4134
4135 Sun disk labels.
4136
4137 =back");
4138
4139   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4140    [InitEmpty, Always, TestRun (
4141       [["part_init"; "/dev/sda"; "mbr"];
4142        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4143     InitEmpty, Always, TestRun (
4144       [["part_init"; "/dev/sda"; "gpt"];
4145        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4146        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4147     InitEmpty, Always, TestRun (
4148       [["part_init"; "/dev/sda"; "mbr"];
4149        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4150        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4151        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4152        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4153    "add a partition to the device",
4154    "\
4155 This command adds a partition to C<device>.  If there is no partition
4156 table on the device, call C<guestfs_part_init> first.
4157
4158 The C<prlogex> parameter is the type of partition.  Normally you
4159 should pass C<p> or C<primary> here, but MBR partition tables also
4160 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4161 types.
4162
4163 C<startsect> and C<endsect> are the start and end of the partition
4164 in I<sectors>.  C<endsect> may be negative, which means it counts
4165 backwards from the end of the disk (C<-1> is the last sector).
4166
4167 Creating a partition which covers the whole disk is not so easy.
4168 Use C<guestfs_part_disk> to do that.");
4169
4170   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4171    [InitEmpty, Always, TestRun (
4172       [["part_disk"; "/dev/sda"; "mbr"]]);
4173     InitEmpty, Always, TestRun (
4174       [["part_disk"; "/dev/sda"; "gpt"]])],
4175    "partition whole disk with a single primary partition",
4176    "\
4177 This command is simply a combination of C<guestfs_part_init>
4178 followed by C<guestfs_part_add> to create a single primary partition
4179 covering the whole disk.
4180
4181 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4182 but other possible values are described in C<guestfs_part_init>.");
4183
4184   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4185    [InitEmpty, Always, TestRun (
4186       [["part_disk"; "/dev/sda"; "mbr"];
4187        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4188    "make a partition bootable",
4189    "\
4190 This sets the bootable flag on partition numbered C<partnum> on
4191 device C<device>.  Note that partitions are numbered from 1.
4192
4193 The bootable flag is used by some operating systems (notably
4194 Windows) to determine which partition to boot from.  It is by
4195 no means universally recognized.");
4196
4197   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4198    [InitEmpty, Always, TestRun (
4199       [["part_disk"; "/dev/sda"; "gpt"];
4200        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4201    "set partition name",
4202    "\
4203 This sets the partition name on partition numbered C<partnum> on
4204 device C<device>.  Note that partitions are numbered from 1.
4205
4206 The partition name can only be set on certain types of partition
4207 table.  This works on C<gpt> but not on C<mbr> partitions.");
4208
4209   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4210    [], (* XXX Add a regression test for this. *)
4211    "list partitions on a device",
4212    "\
4213 This command parses the partition table on C<device> and
4214 returns the list of partitions found.
4215
4216 The fields in the returned structure are:
4217
4218 =over 4
4219
4220 =item B<part_num>
4221
4222 Partition number, counting from 1.
4223
4224 =item B<part_start>
4225
4226 Start of the partition I<in bytes>.  To get sectors you have to
4227 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4228
4229 =item B<part_end>
4230
4231 End of the partition in bytes.
4232
4233 =item B<part_size>
4234
4235 Size of the partition in bytes.
4236
4237 =back");
4238
4239   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4240    [InitEmpty, Always, TestOutput (
4241       [["part_disk"; "/dev/sda"; "gpt"];
4242        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4243    "get the partition table type",
4244    "\
4245 This command examines the partition table on C<device> and
4246 returns the partition table type (format) being used.
4247
4248 Common return values include: C<msdos> (a DOS/Windows style MBR
4249 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4250 values are possible, although unusual.  See C<guestfs_part_init>
4251 for a full list.");
4252
4253   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4254    [InitBasicFS, Always, TestOutputBuffer (
4255       [["fill"; "0x63"; "10"; "/test"];
4256        ["read_file"; "/test"]], "cccccccccc")],
4257    "fill a file with octets",
4258    "\
4259 This command creates a new file called C<path>.  The initial
4260 content of the file is C<len> octets of C<c>, where C<c>
4261 must be a number in the range C<[0..255]>.
4262
4263 To fill a file with zero bytes (sparsely), it is
4264 much more efficient to use C<guestfs_truncate_size>.");
4265
4266   ("available", (RErr, [StringList "groups"]), 216, [],
4267    [InitNone, Always, TestRun [["available"; ""]]],
4268    "test availability of some parts of the API",
4269    "\
4270 This command is used to check the availability of some
4271 groups of functionality in the appliance, which not all builds of
4272 the libguestfs appliance will be able to provide.
4273
4274 The libguestfs groups, and the functions that those
4275 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4276
4277 The argument C<groups> is a list of group names, eg:
4278 C<[\"inotify\", \"augeas\"]> would check for the availability of
4279 the Linux inotify functions and Augeas (configuration file
4280 editing) functions.
4281
4282 The command returns no error if I<all> requested groups are available.
4283
4284 It fails with an error if one or more of the requested
4285 groups is unavailable in the appliance.
4286
4287 If an unknown group name is included in the
4288 list of groups then an error is always returned.
4289
4290 I<Notes:>
4291
4292 =over 4
4293
4294 =item *
4295
4296 You must call C<guestfs_launch> before calling this function.
4297
4298 The reason is because we don't know what groups are
4299 supported by the appliance/daemon until it is running and can
4300 be queried.
4301
4302 =item *
4303
4304 If a group of functions is available, this does not necessarily
4305 mean that they will work.  You still have to check for errors
4306 when calling individual API functions even if they are
4307 available.
4308
4309 =item *
4310
4311 It is usually the job of distro packagers to build
4312 complete functionality into the libguestfs appliance.
4313 Upstream libguestfs, if built from source with all
4314 requirements satisfied, will support everything.
4315
4316 =item *
4317
4318 This call was added in version C<1.0.80>.  In previous
4319 versions of libguestfs all you could do would be to speculatively
4320 execute a command to find out if the daemon implemented it.
4321 See also C<guestfs_version>.
4322
4323 =back");
4324
4325   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4326    [InitBasicFS, Always, TestOutputBuffer (
4327       [["write_file"; "/src"; "hello, world"; "0"];
4328        ["dd"; "/src"; "/dest"];
4329        ["read_file"; "/dest"]], "hello, world")],
4330    "copy from source to destination using dd",
4331    "\
4332 This command copies from one source device or file C<src>
4333 to another destination device or file C<dest>.  Normally you
4334 would use this to copy to or from a device or partition, for
4335 example to duplicate a filesystem.
4336
4337 If the destination is a device, it must be as large or larger
4338 than the source file or device, otherwise the copy will fail.
4339 This command cannot do partial copies (see C<guestfs_copy_size>).");
4340
4341   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4342    [InitBasicFS, Always, TestOutputInt (
4343       [["write_file"; "/file"; "hello, world"; "0"];
4344        ["filesize"; "/file"]], 12)],
4345    "return the size of the file in bytes",
4346    "\
4347 This command returns the size of C<file> in bytes.
4348
4349 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4350 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4351 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4352
4353   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4354    [InitBasicFSonLVM, Always, TestOutputList (
4355       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4356        ["lvs"]], ["/dev/VG/LV2"])],
4357    "rename an LVM logical volume",
4358    "\
4359 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4360
4361   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4362    [InitBasicFSonLVM, Always, TestOutputList (
4363       [["umount"; "/"];
4364        ["vg_activate"; "false"; "VG"];
4365        ["vgrename"; "VG"; "VG2"];
4366        ["vg_activate"; "true"; "VG2"];
4367        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4368        ["vgs"]], ["VG2"])],
4369    "rename an LVM volume group",
4370    "\
4371 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4372
4373   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4374    [InitISOFS, Always, TestOutputBuffer (
4375       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4376    "list the contents of a single file in an initrd",
4377    "\
4378 This command unpacks the file C<filename> from the initrd file
4379 called C<initrdpath>.  The filename must be given I<without> the
4380 initial C</> character.
4381
4382 For example, in guestfish you could use the following command
4383 to examine the boot script (usually called C</init>)
4384 contained in a Linux initrd or initramfs image:
4385
4386  initrd-cat /boot/initrd-<version>.img init
4387
4388 See also C<guestfs_initrd_list>.");
4389
4390   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4391    [],
4392    "get the UUID of a physical volume",
4393    "\
4394 This command returns the UUID of the LVM PV C<device>.");
4395
4396   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4397    [],
4398    "get the UUID of a volume group",
4399    "\
4400 This command returns the UUID of the LVM VG named C<vgname>.");
4401
4402   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4403    [],
4404    "get the UUID of a logical volume",
4405    "\
4406 This command returns the UUID of the LVM LV C<device>.");
4407
4408   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4409    [],
4410    "get the PV UUIDs containing the volume group",
4411    "\
4412 Given a VG called C<vgname>, this returns the UUIDs of all
4413 the physical volumes that this volume group resides on.
4414
4415 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4416 calls to associate physical volumes and volume groups.
4417
4418 See also C<guestfs_vglvuuids>.");
4419
4420   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4421    [],
4422    "get the LV UUIDs of all LVs in the volume group",
4423    "\
4424 Given a VG called C<vgname>, this returns the UUIDs of all
4425 the logical volumes created in this volume group.
4426
4427 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4428 calls to associate logical volumes and volume groups.
4429
4430 See also C<guestfs_vgpvuuids>.");
4431
4432   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4433    [InitBasicFS, Always, TestOutputBuffer (
4434       [["write_file"; "/src"; "hello, world"; "0"];
4435        ["copy_size"; "/src"; "/dest"; "5"];
4436        ["read_file"; "/dest"]], "hello")],
4437    "copy size bytes from source to destination using dd",
4438    "\
4439 This command copies exactly C<size> bytes from one source device
4440 or file C<src> to another destination device or file C<dest>.
4441
4442 Note this will fail if the source is too short or if the destination
4443 is not large enough.");
4444
4445   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4446    [InitEmpty, Always, TestRun (
4447       [["part_init"; "/dev/sda"; "mbr"];
4448        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4449        ["part_del"; "/dev/sda"; "1"]])],
4450    "delete a partition",
4451    "\
4452 This command deletes the partition numbered C<partnum> on C<device>.
4453
4454 Note that in the case of MBR partitioning, deleting an
4455 extended partition also deletes any logical partitions
4456 it contains.");
4457
4458   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4459    [InitEmpty, Always, TestOutputTrue (
4460       [["part_init"; "/dev/sda"; "mbr"];
4461        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4462        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4463        ["part_get_bootable"; "/dev/sda"; "1"]])],
4464    "return true if a partition is bootable",
4465    "\
4466 This command returns true if the partition C<partnum> on
4467 C<device> has the bootable flag set.
4468
4469 See also C<guestfs_part_set_bootable>.");
4470
4471   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4472    [InitEmpty, Always, TestOutputInt (
4473       [["part_init"; "/dev/sda"; "mbr"];
4474        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4475        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4476        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4477    "get the MBR type byte (ID byte) from a partition",
4478    "\
4479 Returns the MBR type byte (also known as the ID byte) from
4480 the numbered partition C<partnum>.
4481
4482 Note that only MBR (old DOS-style) partitions have type bytes.
4483 You will get undefined results for other partition table
4484 types (see C<guestfs_part_get_parttype>).");
4485
4486   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4487    [], (* tested by part_get_mbr_id *)
4488    "set the MBR type byte (ID byte) of a partition",
4489    "\
4490 Sets the MBR type byte (also known as the ID byte) of
4491 the numbered partition C<partnum> to C<idbyte>.  Note
4492 that the type bytes quoted in most documentation are
4493 in fact hexadecimal numbers, but usually documented
4494 without any leading \"0x\" which might be confusing.
4495
4496 Note that only MBR (old DOS-style) partitions have type bytes.
4497 You will get undefined results for other partition table
4498 types (see C<guestfs_part_get_parttype>).");
4499
4500 ]
4501
4502 let all_functions = non_daemon_functions @ daemon_functions
4503
4504 (* In some places we want the functions to be displayed sorted
4505  * alphabetically, so this is useful:
4506  *)
4507 let all_functions_sorted =
4508   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4509                compare n1 n2) all_functions
4510
4511 (* Field types for structures. *)
4512 type field =
4513   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4514   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4515   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4516   | FUInt32
4517   | FInt32
4518   | FUInt64
4519   | FInt64
4520   | FBytes                      (* Any int measure that counts bytes. *)
4521   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4522   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4523
4524 (* Because we generate extra parsing code for LVM command line tools,
4525  * we have to pull out the LVM columns separately here.
4526  *)
4527 let lvm_pv_cols = [
4528   "pv_name", FString;
4529   "pv_uuid", FUUID;
4530   "pv_fmt", FString;
4531   "pv_size", FBytes;
4532   "dev_size", FBytes;
4533   "pv_free", FBytes;
4534   "pv_used", FBytes;
4535   "pv_attr", FString (* XXX *);
4536   "pv_pe_count", FInt64;
4537   "pv_pe_alloc_count", FInt64;
4538   "pv_tags", FString;
4539   "pe_start", FBytes;
4540   "pv_mda_count", FInt64;
4541   "pv_mda_free", FBytes;
4542   (* Not in Fedora 10:
4543      "pv_mda_size", FBytes;
4544   *)
4545 ]
4546 let lvm_vg_cols = [
4547   "vg_name", FString;
4548   "vg_uuid", FUUID;
4549   "vg_fmt", FString;
4550   "vg_attr", FString (* XXX *);
4551   "vg_size", FBytes;
4552   "vg_free", FBytes;
4553   "vg_sysid", FString;
4554   "vg_extent_size", FBytes;
4555   "vg_extent_count", FInt64;
4556   "vg_free_count", FInt64;
4557   "max_lv", FInt64;
4558   "max_pv", FInt64;
4559   "pv_count", FInt64;
4560   "lv_count", FInt64;
4561   "snap_count", FInt64;
4562   "vg_seqno", FInt64;
4563   "vg_tags", FString;
4564   "vg_mda_count", FInt64;
4565   "vg_mda_free", FBytes;
4566   (* Not in Fedora 10:
4567      "vg_mda_size", FBytes;
4568   *)
4569 ]
4570 let lvm_lv_cols = [
4571   "lv_name", FString;
4572   "lv_uuid", FUUID;
4573   "lv_attr", FString (* XXX *);
4574   "lv_major", FInt64;
4575   "lv_minor", FInt64;
4576   "lv_kernel_major", FInt64;
4577   "lv_kernel_minor", FInt64;
4578   "lv_size", FBytes;
4579   "seg_count", FInt64;
4580   "origin", FString;
4581   "snap_percent", FOptPercent;
4582   "copy_percent", FOptPercent;
4583   "move_pv", FString;
4584   "lv_tags", FString;
4585   "mirror_log", FString;
4586   "modules", FString;
4587 ]
4588
4589 (* Names and fields in all structures (in RStruct and RStructList)
4590  * that we support.
4591  *)
4592 let structs = [
4593   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4594    * not use this struct in any new code.
4595    *)
4596   "int_bool", [
4597     "i", FInt32;                (* for historical compatibility *)
4598     "b", FInt32;                (* for historical compatibility *)
4599   ];
4600
4601   (* LVM PVs, VGs, LVs. *)
4602   "lvm_pv", lvm_pv_cols;
4603   "lvm_vg", lvm_vg_cols;
4604   "lvm_lv", lvm_lv_cols;
4605
4606   (* Column names and types from stat structures.
4607    * NB. Can't use things like 'st_atime' because glibc header files
4608    * define some of these as macros.  Ugh.
4609    *)
4610   "stat", [
4611     "dev", FInt64;
4612     "ino", FInt64;
4613     "mode", FInt64;
4614     "nlink", FInt64;
4615     "uid", FInt64;
4616     "gid", FInt64;
4617     "rdev", FInt64;
4618     "size", FInt64;
4619     "blksize", FInt64;
4620     "blocks", FInt64;
4621     "atime", FInt64;
4622     "mtime", FInt64;
4623     "ctime", FInt64;
4624   ];
4625   "statvfs", [
4626     "bsize", FInt64;
4627     "frsize", FInt64;
4628     "blocks", FInt64;
4629     "bfree", FInt64;
4630     "bavail", FInt64;
4631     "files", FInt64;
4632     "ffree", FInt64;
4633     "favail", FInt64;
4634     "fsid", FInt64;
4635     "flag", FInt64;
4636     "namemax", FInt64;
4637   ];
4638
4639   (* Column names in dirent structure. *)
4640   "dirent", [
4641     "ino", FInt64;
4642     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4643     "ftyp", FChar;
4644     "name", FString;
4645   ];
4646
4647   (* Version numbers. *)
4648   "version", [
4649     "major", FInt64;
4650     "minor", FInt64;
4651     "release", FInt64;
4652     "extra", FString;
4653   ];
4654
4655   (* Extended attribute. *)
4656   "xattr", [
4657     "attrname", FString;
4658     "attrval", FBuffer;
4659   ];
4660
4661   (* Inotify events. *)
4662   "inotify_event", [
4663     "in_wd", FInt64;
4664     "in_mask", FUInt32;
4665     "in_cookie", FUInt32;
4666     "in_name", FString;
4667   ];
4668
4669   (* Partition table entry. *)
4670   "partition", [
4671     "part_num", FInt32;
4672     "part_start", FBytes;
4673     "part_end", FBytes;
4674     "part_size", FBytes;
4675   ];
4676 ] (* end of structs *)
4677
4678 (* Ugh, Java has to be different ..
4679  * These names are also used by the Haskell bindings.
4680  *)
4681 let java_structs = [
4682   "int_bool", "IntBool";
4683   "lvm_pv", "PV";
4684   "lvm_vg", "VG";
4685   "lvm_lv", "LV";
4686   "stat", "Stat";
4687   "statvfs", "StatVFS";
4688   "dirent", "Dirent";
4689   "version", "Version";
4690   "xattr", "XAttr";
4691   "inotify_event", "INotifyEvent";
4692   "partition", "Partition";
4693 ]
4694
4695 (* What structs are actually returned. *)
4696 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4697
4698 (* Returns a list of RStruct/RStructList structs that are returned
4699  * by any function.  Each element of returned list is a pair:
4700  *
4701  * (structname, RStructOnly)
4702  *    == there exists function which returns RStruct (_, structname)
4703  * (structname, RStructListOnly)
4704  *    == there exists function which returns RStructList (_, structname)
4705  * (structname, RStructAndList)
4706  *    == there are functions returning both RStruct (_, structname)
4707  *                                      and RStructList (_, structname)
4708  *)
4709 let rstructs_used_by functions =
4710   (* ||| is a "logical OR" for rstructs_used_t *)
4711   let (|||) a b =
4712     match a, b with
4713     | RStructAndList, _
4714     | _, RStructAndList -> RStructAndList
4715     | RStructOnly, RStructListOnly
4716     | RStructListOnly, RStructOnly -> RStructAndList
4717     | RStructOnly, RStructOnly -> RStructOnly
4718     | RStructListOnly, RStructListOnly -> RStructListOnly
4719   in
4720
4721   let h = Hashtbl.create 13 in
4722
4723   (* if elem->oldv exists, update entry using ||| operator,
4724    * else just add elem->newv to the hash
4725    *)
4726   let update elem newv =
4727     try  let oldv = Hashtbl.find h elem in
4728          Hashtbl.replace h elem (newv ||| oldv)
4729     with Not_found -> Hashtbl.add h elem newv
4730   in
4731
4732   List.iter (
4733     fun (_, style, _, _, _, _, _) ->
4734       match fst style with
4735       | RStruct (_, structname) -> update structname RStructOnly
4736       | RStructList (_, structname) -> update structname RStructListOnly
4737       | _ -> ()
4738   ) functions;
4739
4740   (* return key->values as a list of (key,value) *)
4741   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4742
4743 (* Used for testing language bindings. *)
4744 type callt =
4745   | CallString of string
4746   | CallOptString of string option
4747   | CallStringList of string list
4748   | CallInt of int
4749   | CallInt64 of int64
4750   | CallBool of bool
4751
4752 (* Used to memoize the result of pod2text. *)
4753 let pod2text_memo_filename = "src/.pod2text.data"
4754 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4755   try
4756     let chan = open_in pod2text_memo_filename in
4757     let v = input_value chan in
4758     close_in chan;
4759     v
4760   with
4761     _ -> Hashtbl.create 13
4762 let pod2text_memo_updated () =
4763   let chan = open_out pod2text_memo_filename in
4764   output_value chan pod2text_memo;
4765   close_out chan
4766
4767 (* Useful functions.
4768  * Note we don't want to use any external OCaml libraries which
4769  * makes this a bit harder than it should be.
4770  *)
4771 module StringMap = Map.Make (String)
4772
4773 let failwithf fs = ksprintf failwith fs
4774
4775 let unique = let i = ref 0 in fun () -> incr i; !i
4776
4777 let replace_char s c1 c2 =
4778   let s2 = String.copy s in
4779   let r = ref false in
4780   for i = 0 to String.length s2 - 1 do
4781     if String.unsafe_get s2 i = c1 then (
4782       String.unsafe_set s2 i c2;
4783       r := true
4784     )
4785   done;
4786   if not !r then s else s2
4787
4788 let isspace c =
4789   c = ' '
4790   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4791
4792 let triml ?(test = isspace) str =
4793   let i = ref 0 in
4794   let n = ref (String.length str) in
4795   while !n > 0 && test str.[!i]; do
4796     decr n;
4797     incr i
4798   done;
4799   if !i = 0 then str
4800   else String.sub str !i !n
4801
4802 let trimr ?(test = isspace) str =
4803   let n = ref (String.length str) in
4804   while !n > 0 && test str.[!n-1]; do
4805     decr n
4806   done;
4807   if !n = String.length str then str
4808   else String.sub str 0 !n
4809
4810 let trim ?(test = isspace) str =
4811   trimr ~test (triml ~test str)
4812
4813 let rec find s sub =
4814   let len = String.length s in
4815   let sublen = String.length sub in
4816   let rec loop i =
4817     if i <= len-sublen then (
4818       let rec loop2 j =
4819         if j < sublen then (
4820           if s.[i+j] = sub.[j] then loop2 (j+1)
4821           else -1
4822         ) else
4823           i (* found *)
4824       in
4825       let r = loop2 0 in
4826       if r = -1 then loop (i+1) else r
4827     ) else
4828       -1 (* not found *)
4829   in
4830   loop 0
4831
4832 let rec replace_str s s1 s2 =
4833   let len = String.length s in
4834   let sublen = String.length s1 in
4835   let i = find s s1 in
4836   if i = -1 then s
4837   else (
4838     let s' = String.sub s 0 i in
4839     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4840     s' ^ s2 ^ replace_str s'' s1 s2
4841   )
4842
4843 let rec string_split sep str =
4844   let len = String.length str in
4845   let seplen = String.length sep in
4846   let i = find str sep in
4847   if i = -1 then [str]
4848   else (
4849     let s' = String.sub str 0 i in
4850     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4851     s' :: string_split sep s''
4852   )
4853
4854 let files_equal n1 n2 =
4855   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4856   match Sys.command cmd with
4857   | 0 -> true
4858   | 1 -> false
4859   | i -> failwithf "%s: failed with error code %d" cmd i
4860
4861 let rec filter_map f = function
4862   | [] -> []
4863   | x :: xs ->
4864       match f x with
4865       | Some y -> y :: filter_map f xs
4866       | None -> filter_map f xs
4867
4868 let rec find_map f = function
4869   | [] -> raise Not_found
4870   | x :: xs ->
4871       match f x with
4872       | Some y -> y
4873       | None -> find_map f xs
4874
4875 let iteri f xs =
4876   let rec loop i = function
4877     | [] -> ()
4878     | x :: xs -> f i x; loop (i+1) xs
4879   in
4880   loop 0 xs
4881
4882 let mapi f xs =
4883   let rec loop i = function
4884     | [] -> []
4885     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4886   in
4887   loop 0 xs
4888
4889 let count_chars c str =
4890   let count = ref 0 in
4891   for i = 0 to String.length str - 1 do
4892     if c = String.unsafe_get str i then incr count
4893   done;
4894   !count
4895
4896 let name_of_argt = function
4897   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4898   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4899   | FileIn n | FileOut n -> n
4900
4901 let java_name_of_struct typ =
4902   try List.assoc typ java_structs
4903   with Not_found ->
4904     failwithf
4905       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4906
4907 let cols_of_struct typ =
4908   try List.assoc typ structs
4909   with Not_found ->
4910     failwithf "cols_of_struct: unknown struct %s" typ
4911
4912 let seq_of_test = function
4913   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4914   | TestOutputListOfDevices (s, _)
4915   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4916   | TestOutputTrue s | TestOutputFalse s
4917   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4918   | TestOutputStruct (s, _)
4919   | TestLastFail s -> s
4920
4921 (* Handling for function flags. *)
4922 let protocol_limit_warning =
4923   "Because of the message protocol, there is a transfer limit
4924 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4925
4926 let danger_will_robinson =
4927   "B<This command is dangerous.  Without careful use you
4928 can easily destroy all your data>."
4929
4930 let deprecation_notice flags =
4931   try
4932     let alt =
4933       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4934     let txt =
4935       sprintf "This function is deprecated.
4936 In new code, use the C<%s> call instead.
4937
4938 Deprecated functions will not be removed from the API, but the
4939 fact that they are deprecated indicates that there are problems
4940 with correct use of these functions." alt in
4941     Some txt
4942   with
4943     Not_found -> None
4944
4945 (* Create list of optional groups. *)
4946 let optgroups =
4947   let h = Hashtbl.create 13 in
4948   List.iter (
4949     fun (name, _, _, flags, _, _, _) ->
4950       List.iter (
4951         function
4952         | Optional group ->
4953             let names = try Hashtbl.find h group with Not_found -> [] in
4954             Hashtbl.replace h group (name :: names)
4955         | _ -> ()
4956       ) flags
4957   ) daemon_functions;
4958   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4959   let groups =
4960     List.map (
4961       fun group -> group, List.sort compare (Hashtbl.find h group)
4962     ) groups in
4963   List.sort (fun x y -> compare (fst x) (fst y)) groups
4964
4965 (* Check function names etc. for consistency. *)
4966 let check_functions () =
4967   let contains_uppercase str =
4968     let len = String.length str in
4969     let rec loop i =
4970       if i >= len then false
4971       else (
4972         let c = str.[i] in
4973         if c >= 'A' && c <= 'Z' then true
4974         else loop (i+1)
4975       )
4976     in
4977     loop 0
4978   in
4979
4980   (* Check function names. *)
4981   List.iter (
4982     fun (name, _, _, _, _, _, _) ->
4983       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4984         failwithf "function name %s does not need 'guestfs' prefix" name;
4985       if name = "" then
4986         failwithf "function name is empty";
4987       if name.[0] < 'a' || name.[0] > 'z' then
4988         failwithf "function name %s must start with lowercase a-z" name;
4989       if String.contains name '-' then
4990         failwithf "function name %s should not contain '-', use '_' instead."
4991           name
4992   ) all_functions;
4993
4994   (* Check function parameter/return names. *)
4995   List.iter (
4996     fun (name, style, _, _, _, _, _) ->
4997       let check_arg_ret_name n =
4998         if contains_uppercase n then
4999           failwithf "%s param/ret %s should not contain uppercase chars"
5000             name n;
5001         if String.contains n '-' || String.contains n '_' then
5002           failwithf "%s param/ret %s should not contain '-' or '_'"
5003             name n;
5004         if n = "value" then
5005           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;
5006         if n = "int" || n = "char" || n = "short" || n = "long" then
5007           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5008         if n = "i" || n = "n" then
5009           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5010         if n = "argv" || n = "args" then
5011           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5012
5013         (* List Haskell, OCaml and C keywords here.
5014          * http://www.haskell.org/haskellwiki/Keywords
5015          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5016          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5017          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5018          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5019          * Omitting _-containing words, since they're handled above.
5020          * Omitting the OCaml reserved word, "val", is ok,
5021          * and saves us from renaming several parameters.
5022          *)
5023         let reserved = [
5024           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5025           "char"; "class"; "const"; "constraint"; "continue"; "data";
5026           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5027           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5028           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5029           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5030           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5031           "interface";
5032           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5033           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5034           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5035           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5036           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5037           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5038           "volatile"; "when"; "where"; "while";
5039           ] in
5040         if List.mem n reserved then
5041           failwithf "%s has param/ret using reserved word %s" name n;
5042       in
5043
5044       (match fst style with
5045        | RErr -> ()
5046        | RInt n | RInt64 n | RBool n
5047        | RConstString n | RConstOptString n | RString n
5048        | RStringList n | RStruct (n, _) | RStructList (n, _)
5049        | RHashtable n | RBufferOut n ->
5050            check_arg_ret_name n
5051       );
5052       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5053   ) all_functions;
5054
5055   (* Check short descriptions. *)
5056   List.iter (
5057     fun (name, _, _, _, _, shortdesc, _) ->
5058       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5059         failwithf "short description of %s should begin with lowercase." name;
5060       let c = shortdesc.[String.length shortdesc-1] in
5061       if c = '\n' || c = '.' then
5062         failwithf "short description of %s should not end with . or \\n." name
5063   ) all_functions;
5064
5065   (* Check long descriptions. *)
5066   List.iter (
5067     fun (name, _, _, _, _, _, longdesc) ->
5068       if longdesc.[String.length longdesc-1] = '\n' then
5069         failwithf "long description of %s should not end with \\n." name
5070   ) all_functions;
5071
5072   (* Check proc_nrs. *)
5073   List.iter (
5074     fun (name, _, proc_nr, _, _, _, _) ->
5075       if proc_nr <= 0 then
5076         failwithf "daemon function %s should have proc_nr > 0" name
5077   ) daemon_functions;
5078
5079   List.iter (
5080     fun (name, _, proc_nr, _, _, _, _) ->
5081       if proc_nr <> -1 then
5082         failwithf "non-daemon function %s should have proc_nr -1" name
5083   ) non_daemon_functions;
5084
5085   let proc_nrs =
5086     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5087       daemon_functions in
5088   let proc_nrs =
5089     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5090   let rec loop = function
5091     | [] -> ()
5092     | [_] -> ()
5093     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5094         loop rest
5095     | (name1,nr1) :: (name2,nr2) :: _ ->
5096         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5097           name1 name2 nr1 nr2
5098   in
5099   loop proc_nrs;
5100
5101   (* Check tests. *)
5102   List.iter (
5103     function
5104       (* Ignore functions that have no tests.  We generate a
5105        * warning when the user does 'make check' instead.
5106        *)
5107     | name, _, _, _, [], _, _ -> ()
5108     | name, _, _, _, tests, _, _ ->
5109         let funcs =
5110           List.map (
5111             fun (_, _, test) ->
5112               match seq_of_test test with
5113               | [] ->
5114                   failwithf "%s has a test containing an empty sequence" name
5115               | cmds -> List.map List.hd cmds
5116           ) tests in
5117         let funcs = List.flatten funcs in
5118
5119         let tested = List.mem name funcs in
5120
5121         if not tested then
5122           failwithf "function %s has tests but does not test itself" name
5123   ) all_functions
5124
5125 (* 'pr' prints to the current output file. *)
5126 let chan = ref Pervasives.stdout
5127 let lines = ref 0
5128 let pr fs =
5129   ksprintf
5130     (fun str ->
5131        let i = count_chars '\n' str in
5132        lines := !lines + i;
5133        output_string !chan str
5134     ) fs
5135
5136 let copyright_years =
5137   let this_year = 1900 + (localtime (time ())).tm_year in
5138   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5139
5140 (* Generate a header block in a number of standard styles. *)
5141 type comment_style =
5142     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5143 type license = GPLv2plus | LGPLv2plus
5144
5145 let generate_header ?(extra_inputs = []) comment license =
5146   let inputs = "src/generator.ml" :: extra_inputs in
5147   let c = match comment with
5148     | CStyle ->         pr "/* "; " *"
5149     | CPlusPlusStyle -> pr "// "; "//"
5150     | HashStyle ->      pr "# ";  "#"
5151     | OCamlStyle ->     pr "(* "; " *"
5152     | HaskellStyle ->   pr "{- "; "  " in
5153   pr "libguestfs generated file\n";
5154   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5155   List.iter (pr "%s   %s\n" c) inputs;
5156   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5157   pr "%s\n" c;
5158   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5159   pr "%s\n" c;
5160   (match license with
5161    | GPLv2plus ->
5162        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5163        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5164        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5165        pr "%s (at your option) any later version.\n" c;
5166        pr "%s\n" c;
5167        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5168        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5169        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5170        pr "%s GNU General Public License for more details.\n" c;
5171        pr "%s\n" c;
5172        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5173        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5174        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5175
5176    | LGPLv2plus ->
5177        pr "%s This library is free software; you can redistribute it and/or\n" c;
5178        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5179        pr "%s License as published by the Free Software Foundation; either\n" c;
5180        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5181        pr "%s\n" c;
5182        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5183        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5184        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5185        pr "%s Lesser General Public License for more details.\n" c;
5186        pr "%s\n" c;
5187        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5188        pr "%s License along with this library; if not, write to the Free Software\n" c;
5189        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5190   );
5191   (match comment with
5192    | CStyle -> pr " */\n"
5193    | CPlusPlusStyle
5194    | HashStyle -> ()
5195    | OCamlStyle -> pr " *)\n"
5196    | HaskellStyle -> pr "-}\n"
5197   );
5198   pr "\n"
5199
5200 (* Start of main code generation functions below this line. *)
5201
5202 (* Generate the pod documentation for the C API. *)
5203 let rec generate_actions_pod () =
5204   List.iter (
5205     fun (shortname, style, _, flags, _, _, longdesc) ->
5206       if not (List.mem NotInDocs flags) then (
5207         let name = "guestfs_" ^ shortname in
5208         pr "=head2 %s\n\n" name;
5209         pr " ";
5210         generate_prototype ~extern:false ~handle:"g" name style;
5211         pr "\n\n";
5212         pr "%s\n\n" longdesc;
5213         (match fst style with
5214          | RErr ->
5215              pr "This function returns 0 on success or -1 on error.\n\n"
5216          | RInt _ ->
5217              pr "On error this function returns -1.\n\n"
5218          | RInt64 _ ->
5219              pr "On error this function returns -1.\n\n"
5220          | RBool _ ->
5221              pr "This function returns a C truth value on success or -1 on error.\n\n"
5222          | RConstString _ ->
5223              pr "This function returns a string, or NULL on error.
5224 The string is owned by the guest handle and must I<not> be freed.\n\n"
5225          | RConstOptString _ ->
5226              pr "This function returns a string which may be NULL.
5227 There is way to return an error from this function.
5228 The string is owned by the guest handle and must I<not> be freed.\n\n"
5229          | RString _ ->
5230              pr "This function returns a string, or NULL on error.
5231 I<The caller must free the returned string after use>.\n\n"
5232          | RStringList _ ->
5233              pr "This function returns a NULL-terminated array of strings
5234 (like L<environ(3)>), or NULL if there was an error.
5235 I<The caller must free the strings and the array after use>.\n\n"
5236          | RStruct (_, typ) ->
5237              pr "This function returns a C<struct guestfs_%s *>,
5238 or NULL if there was an error.
5239 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5240          | RStructList (_, typ) ->
5241              pr "This function returns a C<struct guestfs_%s_list *>
5242 (see E<lt>guestfs-structs.hE<gt>),
5243 or NULL if there was an error.
5244 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5245          | RHashtable _ ->
5246              pr "This function returns a NULL-terminated array of
5247 strings, or NULL if there was an error.
5248 The array of strings will always have length C<2n+1>, where
5249 C<n> keys and values alternate, followed by the trailing NULL entry.
5250 I<The caller must free the strings and the array after use>.\n\n"
5251          | RBufferOut _ ->
5252              pr "This function returns a buffer, or NULL on error.
5253 The size of the returned buffer is written to C<*size_r>.
5254 I<The caller must free the returned buffer after use>.\n\n"
5255         );
5256         if List.mem ProtocolLimitWarning flags then
5257           pr "%s\n\n" protocol_limit_warning;
5258         if List.mem DangerWillRobinson flags then
5259           pr "%s\n\n" danger_will_robinson;
5260         match deprecation_notice flags with
5261         | None -> ()
5262         | Some txt -> pr "%s\n\n" txt
5263       )
5264   ) all_functions_sorted
5265
5266 and generate_structs_pod () =
5267   (* Structs documentation. *)
5268   List.iter (
5269     fun (typ, cols) ->
5270       pr "=head2 guestfs_%s\n" typ;
5271       pr "\n";
5272       pr " struct guestfs_%s {\n" typ;
5273       List.iter (
5274         function
5275         | name, FChar -> pr "   char %s;\n" name
5276         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5277         | name, FInt32 -> pr "   int32_t %s;\n" name
5278         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5279         | name, FInt64 -> pr "   int64_t %s;\n" name
5280         | name, FString -> pr "   char *%s;\n" name
5281         | name, FBuffer ->
5282             pr "   /* The next two fields describe a byte array. */\n";
5283             pr "   uint32_t %s_len;\n" name;
5284             pr "   char *%s;\n" name
5285         | name, FUUID ->
5286             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5287             pr "   char %s[32];\n" name
5288         | name, FOptPercent ->
5289             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5290             pr "   float %s;\n" name
5291       ) cols;
5292       pr " };\n";
5293       pr " \n";
5294       pr " struct guestfs_%s_list {\n" typ;
5295       pr "   uint32_t len; /* Number of elements in list. */\n";
5296       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5297       pr " };\n";
5298       pr " \n";
5299       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5300       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5301         typ typ;
5302       pr "\n"
5303   ) structs
5304
5305 and generate_availability_pod () =
5306   (* Availability documentation. *)
5307   pr "=over 4\n";
5308   pr "\n";
5309   List.iter (
5310     fun (group, functions) ->
5311       pr "=item B<%s>\n" group;
5312       pr "\n";
5313       pr "The following functions:\n";
5314       List.iter (pr "L</guestfs_%s>\n") functions;
5315       pr "\n"
5316   ) optgroups;
5317   pr "=back\n";
5318   pr "\n"
5319
5320 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5321  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5322  *
5323  * We have to use an underscore instead of a dash because otherwise
5324  * rpcgen generates incorrect code.
5325  *
5326  * This header is NOT exported to clients, but see also generate_structs_h.
5327  *)
5328 and generate_xdr () =
5329   generate_header CStyle LGPLv2plus;
5330
5331   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5332   pr "typedef string str<>;\n";
5333   pr "\n";
5334
5335   (* Internal structures. *)
5336   List.iter (
5337     function
5338     | typ, cols ->
5339         pr "struct guestfs_int_%s {\n" typ;
5340         List.iter (function
5341                    | name, FChar -> pr "  char %s;\n" name
5342                    | name, FString -> pr "  string %s<>;\n" name
5343                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5344                    | name, FUUID -> pr "  opaque %s[32];\n" name
5345                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5346                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5347                    | name, FOptPercent -> pr "  float %s;\n" name
5348                   ) cols;
5349         pr "};\n";
5350         pr "\n";
5351         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5352         pr "\n";
5353   ) structs;
5354
5355   List.iter (
5356     fun (shortname, style, _, _, _, _, _) ->
5357       let name = "guestfs_" ^ shortname in
5358
5359       (match snd style with
5360        | [] -> ()
5361        | args ->
5362            pr "struct %s_args {\n" name;
5363            List.iter (
5364              function
5365              | Pathname n | Device n | Dev_or_Path n | String n ->
5366                  pr "  string %s<>;\n" n
5367              | OptString n -> pr "  str *%s;\n" n
5368              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5369              | Bool n -> pr "  bool %s;\n" n
5370              | Int n -> pr "  int %s;\n" n
5371              | Int64 n -> pr "  hyper %s;\n" n
5372              | FileIn _ | FileOut _ -> ()
5373            ) args;
5374            pr "};\n\n"
5375       );
5376       (match fst style with
5377        | RErr -> ()
5378        | RInt n ->
5379            pr "struct %s_ret {\n" name;
5380            pr "  int %s;\n" n;
5381            pr "};\n\n"
5382        | RInt64 n ->
5383            pr "struct %s_ret {\n" name;
5384            pr "  hyper %s;\n" n;
5385            pr "};\n\n"
5386        | RBool n ->
5387            pr "struct %s_ret {\n" name;
5388            pr "  bool %s;\n" n;
5389            pr "};\n\n"
5390        | RConstString _ | RConstOptString _ ->
5391            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5392        | RString n ->
5393            pr "struct %s_ret {\n" name;
5394            pr "  string %s<>;\n" n;
5395            pr "};\n\n"
5396        | RStringList n ->
5397            pr "struct %s_ret {\n" name;
5398            pr "  str %s<>;\n" n;
5399            pr "};\n\n"
5400        | RStruct (n, typ) ->
5401            pr "struct %s_ret {\n" name;
5402            pr "  guestfs_int_%s %s;\n" typ n;
5403            pr "};\n\n"
5404        | RStructList (n, typ) ->
5405            pr "struct %s_ret {\n" name;
5406            pr "  guestfs_int_%s_list %s;\n" typ n;
5407            pr "};\n\n"
5408        | RHashtable n ->
5409            pr "struct %s_ret {\n" name;
5410            pr "  str %s<>;\n" n;
5411            pr "};\n\n"
5412        | RBufferOut n ->
5413            pr "struct %s_ret {\n" name;
5414            pr "  opaque %s<>;\n" n;
5415            pr "};\n\n"
5416       );
5417   ) daemon_functions;
5418
5419   (* Table of procedure numbers. *)
5420   pr "enum guestfs_procedure {\n";
5421   List.iter (
5422     fun (shortname, _, proc_nr, _, _, _, _) ->
5423       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5424   ) daemon_functions;
5425   pr "  GUESTFS_PROC_NR_PROCS\n";
5426   pr "};\n";
5427   pr "\n";
5428
5429   (* Having to choose a maximum message size is annoying for several
5430    * reasons (it limits what we can do in the API), but it (a) makes
5431    * the protocol a lot simpler, and (b) provides a bound on the size
5432    * of the daemon which operates in limited memory space.
5433    *)
5434   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5435   pr "\n";
5436
5437   (* Message header, etc. *)
5438   pr "\
5439 /* The communication protocol is now documented in the guestfs(3)
5440  * manpage.
5441  */
5442
5443 const GUESTFS_PROGRAM = 0x2000F5F5;
5444 const GUESTFS_PROTOCOL_VERSION = 1;
5445
5446 /* These constants must be larger than any possible message length. */
5447 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5448 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5449
5450 enum guestfs_message_direction {
5451   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5452   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5453 };
5454
5455 enum guestfs_message_status {
5456   GUESTFS_STATUS_OK = 0,
5457   GUESTFS_STATUS_ERROR = 1
5458 };
5459
5460 const GUESTFS_ERROR_LEN = 256;
5461
5462 struct guestfs_message_error {
5463   string error_message<GUESTFS_ERROR_LEN>;
5464 };
5465
5466 struct guestfs_message_header {
5467   unsigned prog;                     /* GUESTFS_PROGRAM */
5468   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5469   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5470   guestfs_message_direction direction;
5471   unsigned serial;                   /* message serial number */
5472   guestfs_message_status status;
5473 };
5474
5475 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5476
5477 struct guestfs_chunk {
5478   int cancel;                        /* if non-zero, transfer is cancelled */
5479   /* data size is 0 bytes if the transfer has finished successfully */
5480   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5481 };
5482 "
5483
5484 (* Generate the guestfs-structs.h file. *)
5485 and generate_structs_h () =
5486   generate_header CStyle LGPLv2plus;
5487
5488   (* This is a public exported header file containing various
5489    * structures.  The structures are carefully written to have
5490    * exactly the same in-memory format as the XDR structures that
5491    * we use on the wire to the daemon.  The reason for creating
5492    * copies of these structures here is just so we don't have to
5493    * export the whole of guestfs_protocol.h (which includes much
5494    * unrelated and XDR-dependent stuff that we don't want to be
5495    * public, or required by clients).
5496    *
5497    * To reiterate, we will pass these structures to and from the
5498    * client with a simple assignment or memcpy, so the format
5499    * must be identical to what rpcgen / the RFC defines.
5500    *)
5501
5502   (* Public structures. *)
5503   List.iter (
5504     fun (typ, cols) ->
5505       pr "struct guestfs_%s {\n" typ;
5506       List.iter (
5507         function
5508         | name, FChar -> pr "  char %s;\n" name
5509         | name, FString -> pr "  char *%s;\n" name
5510         | name, FBuffer ->
5511             pr "  uint32_t %s_len;\n" name;
5512             pr "  char *%s;\n" name
5513         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5514         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5515         | name, FInt32 -> pr "  int32_t %s;\n" name
5516         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5517         | name, FInt64 -> pr "  int64_t %s;\n" name
5518         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5519       ) cols;
5520       pr "};\n";
5521       pr "\n";
5522       pr "struct guestfs_%s_list {\n" typ;
5523       pr "  uint32_t len;\n";
5524       pr "  struct guestfs_%s *val;\n" typ;
5525       pr "};\n";
5526       pr "\n";
5527       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5528       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5529       pr "\n"
5530   ) structs
5531
5532 (* Generate the guestfs-actions.h file. *)
5533 and generate_actions_h () =
5534   generate_header CStyle LGPLv2plus;
5535   List.iter (
5536     fun (shortname, style, _, _, _, _, _) ->
5537       let name = "guestfs_" ^ shortname in
5538       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5539         name style
5540   ) all_functions
5541
5542 (* Generate the guestfs-internal-actions.h file. *)
5543 and generate_internal_actions_h () =
5544   generate_header CStyle LGPLv2plus;
5545   List.iter (
5546     fun (shortname, style, _, _, _, _, _) ->
5547       let name = "guestfs__" ^ shortname in
5548       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5549         name style
5550   ) non_daemon_functions
5551
5552 (* Generate the client-side dispatch stubs. *)
5553 and generate_client_actions () =
5554   generate_header CStyle LGPLv2plus;
5555
5556   pr "\
5557 #include <stdio.h>
5558 #include <stdlib.h>
5559 #include <stdint.h>
5560 #include <string.h>
5561 #include <inttypes.h>
5562
5563 #include \"guestfs.h\"
5564 #include \"guestfs-internal.h\"
5565 #include \"guestfs-internal-actions.h\"
5566 #include \"guestfs_protocol.h\"
5567
5568 #define error guestfs_error
5569 //#define perrorf guestfs_perrorf
5570 #define safe_malloc guestfs_safe_malloc
5571 #define safe_realloc guestfs_safe_realloc
5572 //#define safe_strdup guestfs_safe_strdup
5573 #define safe_memdup guestfs_safe_memdup
5574
5575 /* Check the return message from a call for validity. */
5576 static int
5577 check_reply_header (guestfs_h *g,
5578                     const struct guestfs_message_header *hdr,
5579                     unsigned int proc_nr, unsigned int serial)
5580 {
5581   if (hdr->prog != GUESTFS_PROGRAM) {
5582     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5583     return -1;
5584   }
5585   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5586     error (g, \"wrong protocol version (%%d/%%d)\",
5587            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5588     return -1;
5589   }
5590   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5591     error (g, \"unexpected message direction (%%d/%%d)\",
5592            hdr->direction, GUESTFS_DIRECTION_REPLY);
5593     return -1;
5594   }
5595   if (hdr->proc != proc_nr) {
5596     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5597     return -1;
5598   }
5599   if (hdr->serial != serial) {
5600     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5601     return -1;
5602   }
5603
5604   return 0;
5605 }
5606
5607 /* Check we are in the right state to run a high-level action. */
5608 static int
5609 check_state (guestfs_h *g, const char *caller)
5610 {
5611   if (!guestfs__is_ready (g)) {
5612     if (guestfs__is_config (g) || guestfs__is_launching (g))
5613       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5614         caller);
5615     else
5616       error (g, \"%%s called from the wrong state, %%d != READY\",
5617         caller, guestfs__get_state (g));
5618     return -1;
5619   }
5620   return 0;
5621 }
5622
5623 ";
5624
5625   (* Generate code to generate guestfish call traces. *)
5626   let trace_call shortname style =
5627     pr "  if (guestfs__get_trace (g)) {\n";
5628
5629     let needs_i =
5630       List.exists (function
5631                    | StringList _ | DeviceList _ -> true
5632                    | _ -> false) (snd style) in
5633     if needs_i then (
5634       pr "    int i;\n";
5635       pr "\n"
5636     );
5637
5638     pr "    printf (\"%s\");\n" shortname;
5639     List.iter (
5640       function
5641       | String n                        (* strings *)
5642       | Device n
5643       | Pathname n
5644       | Dev_or_Path n
5645       | FileIn n
5646       | FileOut n ->
5647           (* guestfish doesn't support string escaping, so neither do we *)
5648           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5649       | OptString n ->                  (* string option *)
5650           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5651           pr "    else printf (\" null\");\n"
5652       | StringList n
5653       | DeviceList n ->                 (* string list *)
5654           pr "    putchar (' ');\n";
5655           pr "    putchar ('\"');\n";
5656           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5657           pr "      if (i > 0) putchar (' ');\n";
5658           pr "      fputs (%s[i], stdout);\n" n;
5659           pr "    }\n";
5660           pr "    putchar ('\"');\n";
5661       | Bool n ->                       (* boolean *)
5662           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5663       | Int n ->                        (* int *)
5664           pr "    printf (\" %%d\", %s);\n" n
5665       | Int64 n ->
5666           pr "    printf (\" %%\" PRIi64, %s);\n" n
5667     ) (snd style);
5668     pr "    putchar ('\\n');\n";
5669     pr "  }\n";
5670     pr "\n";
5671   in
5672
5673   (* For non-daemon functions, generate a wrapper around each function. *)
5674   List.iter (
5675     fun (shortname, style, _, _, _, _, _) ->
5676       let name = "guestfs_" ^ shortname in
5677
5678       generate_prototype ~extern:false ~semicolon:false ~newline:true
5679         ~handle:"g" name style;
5680       pr "{\n";
5681       trace_call shortname style;
5682       pr "  return guestfs__%s " shortname;
5683       generate_c_call_args ~handle:"g" style;
5684       pr ";\n";
5685       pr "}\n";
5686       pr "\n"
5687   ) non_daemon_functions;
5688
5689   (* Client-side stubs for each function. *)
5690   List.iter (
5691     fun (shortname, style, _, _, _, _, _) ->
5692       let name = "guestfs_" ^ shortname in
5693
5694       (* Generate the action stub. *)
5695       generate_prototype ~extern:false ~semicolon:false ~newline:true
5696         ~handle:"g" name style;
5697
5698       let error_code =
5699         match fst style with
5700         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5701         | RConstString _ | RConstOptString _ ->
5702             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5703         | RString _ | RStringList _
5704         | RStruct _ | RStructList _
5705         | RHashtable _ | RBufferOut _ ->
5706             "NULL" in
5707
5708       pr "{\n";
5709
5710       (match snd style with
5711        | [] -> ()
5712        | _ -> pr "  struct %s_args args;\n" name
5713       );
5714
5715       pr "  guestfs_message_header hdr;\n";
5716       pr "  guestfs_message_error err;\n";
5717       let has_ret =
5718         match fst style with
5719         | RErr -> false
5720         | RConstString _ | RConstOptString _ ->
5721             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5722         | RInt _ | RInt64 _
5723         | RBool _ | RString _ | RStringList _
5724         | RStruct _ | RStructList _
5725         | RHashtable _ | RBufferOut _ ->
5726             pr "  struct %s_ret ret;\n" name;
5727             true in
5728
5729       pr "  int serial;\n";
5730       pr "  int r;\n";
5731       pr "\n";
5732       trace_call shortname style;
5733       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5734       pr "  guestfs___set_busy (g);\n";
5735       pr "\n";
5736
5737       (* Send the main header and arguments. *)
5738       (match snd style with
5739        | [] ->
5740            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5741              (String.uppercase shortname)
5742        | args ->
5743            List.iter (
5744              function
5745              | Pathname n | Device n | Dev_or_Path n | String n ->
5746                  pr "  args.%s = (char *) %s;\n" n n
5747              | OptString n ->
5748                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5749              | StringList n | DeviceList n ->
5750                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5751                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5752              | Bool n ->
5753                  pr "  args.%s = %s;\n" n n
5754              | Int n ->
5755                  pr "  args.%s = %s;\n" n n
5756              | Int64 n ->
5757                  pr "  args.%s = %s;\n" n n
5758              | FileIn _ | FileOut _ -> ()
5759            ) args;
5760            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5761              (String.uppercase shortname);
5762            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5763              name;
5764       );
5765       pr "  if (serial == -1) {\n";
5766       pr "    guestfs___end_busy (g);\n";
5767       pr "    return %s;\n" error_code;
5768       pr "  }\n";
5769       pr "\n";
5770
5771       (* Send any additional files (FileIn) requested. *)
5772       let need_read_reply_label = ref false in
5773       List.iter (
5774         function
5775         | FileIn n ->
5776             pr "  r = guestfs___send_file (g, %s);\n" n;
5777             pr "  if (r == -1) {\n";
5778             pr "    guestfs___end_busy (g);\n";
5779             pr "    return %s;\n" error_code;
5780             pr "  }\n";
5781             pr "  if (r == -2) /* daemon cancelled */\n";
5782             pr "    goto read_reply;\n";
5783             need_read_reply_label := true;
5784             pr "\n";
5785         | _ -> ()
5786       ) (snd style);
5787
5788       (* Wait for the reply from the remote end. *)
5789       if !need_read_reply_label then pr " read_reply:\n";
5790       pr "  memset (&hdr, 0, sizeof hdr);\n";
5791       pr "  memset (&err, 0, sizeof err);\n";
5792       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5793       pr "\n";
5794       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5795       if not has_ret then
5796         pr "NULL, NULL"
5797       else
5798         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5799       pr ");\n";
5800
5801       pr "  if (r == -1) {\n";
5802       pr "    guestfs___end_busy (g);\n";
5803       pr "    return %s;\n" error_code;
5804       pr "  }\n";
5805       pr "\n";
5806
5807       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5808         (String.uppercase shortname);
5809       pr "    guestfs___end_busy (g);\n";
5810       pr "    return %s;\n" error_code;
5811       pr "  }\n";
5812       pr "\n";
5813
5814       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5815       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5816       pr "    free (err.error_message);\n";
5817       pr "    guestfs___end_busy (g);\n";
5818       pr "    return %s;\n" error_code;
5819       pr "  }\n";
5820       pr "\n";
5821
5822       (* Expecting to receive further files (FileOut)? *)
5823       List.iter (
5824         function
5825         | FileOut n ->
5826             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5827             pr "    guestfs___end_busy (g);\n";
5828             pr "    return %s;\n" error_code;
5829             pr "  }\n";
5830             pr "\n";
5831         | _ -> ()
5832       ) (snd style);
5833
5834       pr "  guestfs___end_busy (g);\n";
5835
5836       (match fst style with
5837        | RErr -> pr "  return 0;\n"
5838        | RInt n | RInt64 n | RBool n ->
5839            pr "  return ret.%s;\n" n
5840        | RConstString _ | RConstOptString _ ->
5841            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5842        | RString n ->
5843            pr "  return ret.%s; /* caller will free */\n" n
5844        | RStringList n | RHashtable n ->
5845            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5846            pr "  ret.%s.%s_val =\n" n n;
5847            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5848            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5849              n n;
5850            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5851            pr "  return ret.%s.%s_val;\n" n n
5852        | RStruct (n, _) ->
5853            pr "  /* caller will free this */\n";
5854            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5855        | RStructList (n, _) ->
5856            pr "  /* caller will free this */\n";
5857            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5858        | RBufferOut n ->
5859            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5860            pr "   * _val might be NULL here.  To make the API saner for\n";
5861            pr "   * callers, we turn this case into a unique pointer (using\n";
5862            pr "   * malloc(1)).\n";
5863            pr "   */\n";
5864            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5865            pr "    *size_r = ret.%s.%s_len;\n" n n;
5866            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5867            pr "  } else {\n";
5868            pr "    free (ret.%s.%s_val);\n" n n;
5869            pr "    char *p = safe_malloc (g, 1);\n";
5870            pr "    *size_r = ret.%s.%s_len;\n" n n;
5871            pr "    return p;\n";
5872            pr "  }\n";
5873       );
5874
5875       pr "}\n\n"
5876   ) daemon_functions;
5877
5878   (* Functions to free structures. *)
5879   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5880   pr " * structure format is identical to the XDR format.  See note in\n";
5881   pr " * generator.ml.\n";
5882   pr " */\n";
5883   pr "\n";
5884
5885   List.iter (
5886     fun (typ, _) ->
5887       pr "void\n";
5888       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5889       pr "{\n";
5890       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5891       pr "  free (x);\n";
5892       pr "}\n";
5893       pr "\n";
5894
5895       pr "void\n";
5896       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5897       pr "{\n";
5898       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5899       pr "  free (x);\n";
5900       pr "}\n";
5901       pr "\n";
5902
5903   ) structs;
5904
5905 (* Generate daemon/actions.h. *)
5906 and generate_daemon_actions_h () =
5907   generate_header CStyle GPLv2plus;
5908
5909   pr "#include \"../src/guestfs_protocol.h\"\n";
5910   pr "\n";
5911
5912   List.iter (
5913     fun (name, style, _, _, _, _, _) ->
5914       generate_prototype
5915         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5916         name style;
5917   ) daemon_functions
5918
5919 (* Generate the linker script which controls the visibility of
5920  * symbols in the public ABI and ensures no other symbols get
5921  * exported accidentally.
5922  *)
5923 and generate_linker_script () =
5924   generate_header HashStyle GPLv2plus;
5925
5926   let globals = [
5927     "guestfs_create";
5928     "guestfs_close";
5929     "guestfs_get_error_handler";
5930     "guestfs_get_out_of_memory_handler";
5931     "guestfs_last_error";
5932     "guestfs_set_error_handler";
5933     "guestfs_set_launch_done_callback";
5934     "guestfs_set_log_message_callback";
5935     "guestfs_set_out_of_memory_handler";
5936     "guestfs_set_subprocess_quit_callback";
5937
5938     (* Unofficial parts of the API: the bindings code use these
5939      * functions, so it is useful to export them.
5940      *)
5941     "guestfs_safe_calloc";
5942     "guestfs_safe_malloc";
5943   ] in
5944   let functions =
5945     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5946       all_functions in
5947   let structs =
5948     List.concat (
5949       List.map (fun (typ, _) ->
5950                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5951         structs
5952     ) in
5953   let globals = List.sort compare (globals @ functions @ structs) in
5954
5955   pr "{\n";
5956   pr "    global:\n";
5957   List.iter (pr "        %s;\n") globals;
5958   pr "\n";
5959
5960   pr "    local:\n";
5961   pr "        *;\n";
5962   pr "};\n"
5963
5964 (* Generate the server-side stubs. *)
5965 and generate_daemon_actions () =
5966   generate_header CStyle GPLv2plus;
5967
5968   pr "#include <config.h>\n";
5969   pr "\n";
5970   pr "#include <stdio.h>\n";
5971   pr "#include <stdlib.h>\n";
5972   pr "#include <string.h>\n";
5973   pr "#include <inttypes.h>\n";
5974   pr "#include <rpc/types.h>\n";
5975   pr "#include <rpc/xdr.h>\n";
5976   pr "\n";
5977   pr "#include \"daemon.h\"\n";
5978   pr "#include \"c-ctype.h\"\n";
5979   pr "#include \"../src/guestfs_protocol.h\"\n";
5980   pr "#include \"actions.h\"\n";
5981   pr "\n";
5982
5983   List.iter (
5984     fun (name, style, _, _, _, _, _) ->
5985       (* Generate server-side stubs. *)
5986       pr "static void %s_stub (XDR *xdr_in)\n" name;
5987       pr "{\n";
5988       let error_code =
5989         match fst style with
5990         | RErr | RInt _ -> pr "  int r;\n"; "-1"
5991         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
5992         | RBool _ -> pr "  int r;\n"; "-1"
5993         | RConstString _ | RConstOptString _ ->
5994             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5995         | RString _ -> pr "  char *r;\n"; "NULL"
5996         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
5997         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
5998         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
5999         | RBufferOut _ ->
6000             pr "  size_t size = 1;\n";
6001             pr "  char *r;\n";
6002             "NULL" in
6003
6004       (match snd style with
6005        | [] -> ()
6006        | args ->
6007            pr "  struct guestfs_%s_args args;\n" name;
6008            List.iter (
6009              function
6010              | Device n | Dev_or_Path n
6011              | Pathname n
6012              | String n -> ()
6013              | OptString n -> pr "  char *%s;\n" n
6014              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6015              | Bool n -> pr "  int %s;\n" n
6016              | Int n -> pr "  int %s;\n" n
6017              | Int64 n -> pr "  int64_t %s;\n" n
6018              | FileIn _ | FileOut _ -> ()
6019            ) args
6020       );
6021       pr "\n";
6022
6023       (match snd style with
6024        | [] -> ()
6025        | args ->
6026            pr "  memset (&args, 0, sizeof args);\n";
6027            pr "\n";
6028            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6029            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6030            pr "    return;\n";
6031            pr "  }\n";
6032            let pr_args n =
6033              pr "  char *%s = args.%s;\n" n n
6034            in
6035            let pr_list_handling_code n =
6036              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6037              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6038              pr "  if (%s == NULL) {\n" n;
6039              pr "    reply_with_perror (\"realloc\");\n";
6040              pr "    goto done;\n";
6041              pr "  }\n";
6042              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6043              pr "  args.%s.%s_val = %s;\n" n n n;
6044            in
6045            List.iter (
6046              function
6047              | Pathname n ->
6048                  pr_args n;
6049                  pr "  ABS_PATH (%s, goto done);\n" n;
6050              | Device n ->
6051                  pr_args n;
6052                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6053              | Dev_or_Path n ->
6054                  pr_args n;
6055                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6056              | String n -> pr_args n
6057              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6058              | StringList n ->
6059                  pr_list_handling_code n;
6060              | DeviceList n ->
6061                  pr_list_handling_code n;
6062                  pr "  /* Ensure that each is a device,\n";
6063                  pr "   * and perform device name translation. */\n";
6064                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
6065                  pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
6066                  pr "  }\n";
6067              | Bool n -> pr "  %s = args.%s;\n" n n
6068              | Int n -> pr "  %s = args.%s;\n" n n
6069              | Int64 n -> pr "  %s = args.%s;\n" n n
6070              | FileIn _ | FileOut _ -> ()
6071            ) args;
6072            pr "\n"
6073       );
6074
6075
6076       (* this is used at least for do_equal *)
6077       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6078         (* Emit NEED_ROOT just once, even when there are two or
6079            more Pathname args *)
6080         pr "  NEED_ROOT (goto done);\n";
6081       );
6082
6083       (* Don't want to call the impl with any FileIn or FileOut
6084        * parameters, since these go "outside" the RPC protocol.
6085        *)
6086       let args' =
6087         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6088           (snd style) in
6089       pr "  r = do_%s " name;
6090       generate_c_call_args (fst style, args');
6091       pr ";\n";
6092
6093       (match fst style with
6094        | RErr | RInt _ | RInt64 _ | RBool _
6095        | RConstString _ | RConstOptString _
6096        | RString _ | RStringList _ | RHashtable _
6097        | RStruct (_, _) | RStructList (_, _) ->
6098            pr "  if (r == %s)\n" error_code;
6099            pr "    /* do_%s has already called reply_with_error */\n" name;
6100            pr "    goto done;\n";
6101            pr "\n"
6102        | RBufferOut _ ->
6103            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6104            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6105            pr "   */\n";
6106            pr "  if (size == 1 && r == %s)\n" error_code;
6107            pr "    /* do_%s has already called reply_with_error */\n" name;
6108            pr "    goto done;\n";
6109            pr "\n"
6110       );
6111
6112       (* If there are any FileOut parameters, then the impl must
6113        * send its own reply.
6114        *)
6115       let no_reply =
6116         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6117       if no_reply then
6118         pr "  /* do_%s has already sent a reply */\n" name
6119       else (
6120         match fst style with
6121         | RErr -> pr "  reply (NULL, NULL);\n"
6122         | RInt n | RInt64 n | RBool n ->
6123             pr "  struct guestfs_%s_ret ret;\n" name;
6124             pr "  ret.%s = r;\n" n;
6125             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6126               name
6127         | RConstString _ | RConstOptString _ ->
6128             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6129         | RString n ->
6130             pr "  struct guestfs_%s_ret ret;\n" name;
6131             pr "  ret.%s = r;\n" n;
6132             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6133               name;
6134             pr "  free (r);\n"
6135         | RStringList n | RHashtable n ->
6136             pr "  struct guestfs_%s_ret ret;\n" name;
6137             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6138             pr "  ret.%s.%s_val = r;\n" n n;
6139             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6140               name;
6141             pr "  free_strings (r);\n"
6142         | RStruct (n, _) ->
6143             pr "  struct guestfs_%s_ret ret;\n" name;
6144             pr "  ret.%s = *r;\n" n;
6145             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6146               name;
6147             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6148               name
6149         | RStructList (n, _) ->
6150             pr "  struct guestfs_%s_ret ret;\n" name;
6151             pr "  ret.%s = *r;\n" n;
6152             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6153               name;
6154             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6155               name
6156         | RBufferOut n ->
6157             pr "  struct guestfs_%s_ret ret;\n" name;
6158             pr "  ret.%s.%s_val = r;\n" n n;
6159             pr "  ret.%s.%s_len = size;\n" n n;
6160             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6161               name;
6162             pr "  free (r);\n"
6163       );
6164
6165       (* Free the args. *)
6166       (match snd style with
6167        | [] ->
6168            pr "done: ;\n";
6169        | _ ->
6170            pr "done:\n";
6171            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6172              name
6173       );
6174
6175       pr "}\n\n";
6176   ) daemon_functions;
6177
6178   (* Dispatch function. *)
6179   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6180   pr "{\n";
6181   pr "  switch (proc_nr) {\n";
6182
6183   List.iter (
6184     fun (name, style, _, _, _, _, _) ->
6185       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6186       pr "      %s_stub (xdr_in);\n" name;
6187       pr "      break;\n"
6188   ) daemon_functions;
6189
6190   pr "    default:\n";
6191   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";
6192   pr "  }\n";
6193   pr "}\n";
6194   pr "\n";
6195
6196   (* LVM columns and tokenization functions. *)
6197   (* XXX This generates crap code.  We should rethink how we
6198    * do this parsing.
6199    *)
6200   List.iter (
6201     function
6202     | typ, cols ->
6203         pr "static const char *lvm_%s_cols = \"%s\";\n"
6204           typ (String.concat "," (List.map fst cols));
6205         pr "\n";
6206
6207         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6208         pr "{\n";
6209         pr "  char *tok, *p, *next;\n";
6210         pr "  int i, j;\n";
6211         pr "\n";
6212         (*
6213           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6214           pr "\n";
6215         *)
6216         pr "  if (!str) {\n";
6217         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6218         pr "    return -1;\n";
6219         pr "  }\n";
6220         pr "  if (!*str || c_isspace (*str)) {\n";
6221         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6222         pr "    return -1;\n";
6223         pr "  }\n";
6224         pr "  tok = str;\n";
6225         List.iter (
6226           fun (name, coltype) ->
6227             pr "  if (!tok) {\n";
6228             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6229             pr "    return -1;\n";
6230             pr "  }\n";
6231             pr "  p = strchrnul (tok, ',');\n";
6232             pr "  if (*p) next = p+1; else next = NULL;\n";
6233             pr "  *p = '\\0';\n";
6234             (match coltype with
6235              | FString ->
6236                  pr "  r->%s = strdup (tok);\n" name;
6237                  pr "  if (r->%s == NULL) {\n" name;
6238                  pr "    perror (\"strdup\");\n";
6239                  pr "    return -1;\n";
6240                  pr "  }\n"
6241              | FUUID ->
6242                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6243                  pr "    if (tok[j] == '\\0') {\n";
6244                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6245                  pr "      return -1;\n";
6246                  pr "    } else if (tok[j] != '-')\n";
6247                  pr "      r->%s[i++] = tok[j];\n" name;
6248                  pr "  }\n";
6249              | FBytes ->
6250                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6251                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6252                  pr "    return -1;\n";
6253                  pr "  }\n";
6254              | FInt64 ->
6255                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6256                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6257                  pr "    return -1;\n";
6258                  pr "  }\n";
6259              | FOptPercent ->
6260                  pr "  if (tok[0] == '\\0')\n";
6261                  pr "    r->%s = -1;\n" name;
6262                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6263                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6264                  pr "    return -1;\n";
6265                  pr "  }\n";
6266              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6267                  assert false (* can never be an LVM column *)
6268             );
6269             pr "  tok = next;\n";
6270         ) cols;
6271
6272         pr "  if (tok != NULL) {\n";
6273         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6274         pr "    return -1;\n";
6275         pr "  }\n";
6276         pr "  return 0;\n";
6277         pr "}\n";
6278         pr "\n";
6279
6280         pr "guestfs_int_lvm_%s_list *\n" typ;
6281         pr "parse_command_line_%ss (void)\n" typ;
6282         pr "{\n";
6283         pr "  char *out, *err;\n";
6284         pr "  char *p, *pend;\n";
6285         pr "  int r, i;\n";
6286         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6287         pr "  void *newp;\n";
6288         pr "\n";
6289         pr "  ret = malloc (sizeof *ret);\n";
6290         pr "  if (!ret) {\n";
6291         pr "    reply_with_perror (\"malloc\");\n";
6292         pr "    return NULL;\n";
6293         pr "  }\n";
6294         pr "\n";
6295         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6296         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6297         pr "\n";
6298         pr "  r = command (&out, &err,\n";
6299         pr "           \"lvm\", \"%ss\",\n" typ;
6300         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6301         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6302         pr "  if (r == -1) {\n";
6303         pr "    reply_with_error (\"%%s\", err);\n";
6304         pr "    free (out);\n";
6305         pr "    free (err);\n";
6306         pr "    free (ret);\n";
6307         pr "    return NULL;\n";
6308         pr "  }\n";
6309         pr "\n";
6310         pr "  free (err);\n";
6311         pr "\n";
6312         pr "  /* Tokenize each line of the output. */\n";
6313         pr "  p = out;\n";
6314         pr "  i = 0;\n";
6315         pr "  while (p) {\n";
6316         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6317         pr "    if (pend) {\n";
6318         pr "      *pend = '\\0';\n";
6319         pr "      pend++;\n";
6320         pr "    }\n";
6321         pr "\n";
6322         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6323         pr "      p++;\n";
6324         pr "\n";
6325         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6326         pr "      p = pend;\n";
6327         pr "      continue;\n";
6328         pr "    }\n";
6329         pr "\n";
6330         pr "    /* Allocate some space to store this next entry. */\n";
6331         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6332         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6333         pr "    if (newp == NULL) {\n";
6334         pr "      reply_with_perror (\"realloc\");\n";
6335         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6336         pr "      free (ret);\n";
6337         pr "      free (out);\n";
6338         pr "      return NULL;\n";
6339         pr "    }\n";
6340         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6341         pr "\n";
6342         pr "    /* Tokenize the next entry. */\n";
6343         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6344         pr "    if (r == -1) {\n";
6345         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6346         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6347         pr "      free (ret);\n";
6348         pr "      free (out);\n";
6349         pr "      return NULL;\n";
6350         pr "    }\n";
6351         pr "\n";
6352         pr "    ++i;\n";
6353         pr "    p = pend;\n";
6354         pr "  }\n";
6355         pr "\n";
6356         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6357         pr "\n";
6358         pr "  free (out);\n";
6359         pr "  return ret;\n";
6360         pr "}\n"
6361
6362   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6363
6364 (* Generate a list of function names, for debugging in the daemon.. *)
6365 and generate_daemon_names () =
6366   generate_header CStyle GPLv2plus;
6367
6368   pr "#include <config.h>\n";
6369   pr "\n";
6370   pr "#include \"daemon.h\"\n";
6371   pr "\n";
6372
6373   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6374   pr "const char *function_names[] = {\n";
6375   List.iter (
6376     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6377   ) daemon_functions;
6378   pr "};\n";
6379
6380 (* Generate the optional groups for the daemon to implement
6381  * guestfs_available.
6382  *)
6383 and generate_daemon_optgroups_c () =
6384   generate_header CStyle GPLv2plus;
6385
6386   pr "#include <config.h>\n";
6387   pr "\n";
6388   pr "#include \"daemon.h\"\n";
6389   pr "#include \"optgroups.h\"\n";
6390   pr "\n";
6391
6392   pr "struct optgroup optgroups[] = {\n";
6393   List.iter (
6394     fun (group, _) ->
6395       pr "  { \"%s\", optgroup_%s_available },\n" group group
6396   ) optgroups;
6397   pr "  { NULL, NULL }\n";
6398   pr "};\n"
6399
6400 and generate_daemon_optgroups_h () =
6401   generate_header CStyle GPLv2plus;
6402
6403   List.iter (
6404     fun (group, _) ->
6405       pr "extern int optgroup_%s_available (void);\n" group
6406   ) optgroups
6407
6408 (* Generate the tests. *)
6409 and generate_tests () =
6410   generate_header CStyle GPLv2plus;
6411
6412   pr "\
6413 #include <stdio.h>
6414 #include <stdlib.h>
6415 #include <string.h>
6416 #include <unistd.h>
6417 #include <sys/types.h>
6418 #include <fcntl.h>
6419
6420 #include \"guestfs.h\"
6421 #include \"guestfs-internal.h\"
6422
6423 static guestfs_h *g;
6424 static int suppress_error = 0;
6425
6426 static void print_error (guestfs_h *g, void *data, const char *msg)
6427 {
6428   if (!suppress_error)
6429     fprintf (stderr, \"%%s\\n\", msg);
6430 }
6431
6432 /* FIXME: nearly identical code appears in fish.c */
6433 static void print_strings (char *const *argv)
6434 {
6435   int argc;
6436
6437   for (argc = 0; argv[argc] != NULL; ++argc)
6438     printf (\"\\t%%s\\n\", argv[argc]);
6439 }
6440
6441 /*
6442 static void print_table (char const *const *argv)
6443 {
6444   int i;
6445
6446   for (i = 0; argv[i] != NULL; i += 2)
6447     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6448 }
6449 */
6450
6451 ";
6452
6453   (* Generate a list of commands which are not tested anywhere. *)
6454   pr "static void no_test_warnings (void)\n";
6455   pr "{\n";
6456
6457   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6458   List.iter (
6459     fun (_, _, _, _, tests, _, _) ->
6460       let tests = filter_map (
6461         function
6462         | (_, (Always|If _|Unless _), test) -> Some test
6463         | (_, Disabled, _) -> None
6464       ) tests in
6465       let seq = List.concat (List.map seq_of_test tests) in
6466       let cmds_tested = List.map List.hd seq in
6467       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6468   ) all_functions;
6469
6470   List.iter (
6471     fun (name, _, _, _, _, _, _) ->
6472       if not (Hashtbl.mem hash name) then
6473         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6474   ) all_functions;
6475
6476   pr "}\n";
6477   pr "\n";
6478
6479   (* Generate the actual tests.  Note that we generate the tests
6480    * in reverse order, deliberately, so that (in general) the
6481    * newest tests run first.  This makes it quicker and easier to
6482    * debug them.
6483    *)
6484   let test_names =
6485     List.map (
6486       fun (name, _, _, flags, tests, _, _) ->
6487         mapi (generate_one_test name flags) tests
6488     ) (List.rev all_functions) in
6489   let test_names = List.concat test_names in
6490   let nr_tests = List.length test_names in
6491
6492   pr "\
6493 int main (int argc, char *argv[])
6494 {
6495   char c = 0;
6496   unsigned long int n_failed = 0;
6497   const char *filename;
6498   int fd;
6499   int nr_tests, test_num = 0;
6500
6501   setbuf (stdout, NULL);
6502
6503   no_test_warnings ();
6504
6505   g = guestfs_create ();
6506   if (g == NULL) {
6507     printf (\"guestfs_create FAILED\\n\");
6508     exit (EXIT_FAILURE);
6509   }
6510
6511   guestfs_set_error_handler (g, print_error, NULL);
6512
6513   guestfs_set_path (g, \"../appliance\");
6514
6515   filename = \"test1.img\";
6516   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6517   if (fd == -1) {
6518     perror (filename);
6519     exit (EXIT_FAILURE);
6520   }
6521   if (lseek (fd, %d, SEEK_SET) == -1) {
6522     perror (\"lseek\");
6523     close (fd);
6524     unlink (filename);
6525     exit (EXIT_FAILURE);
6526   }
6527   if (write (fd, &c, 1) == -1) {
6528     perror (\"write\");
6529     close (fd);
6530     unlink (filename);
6531     exit (EXIT_FAILURE);
6532   }
6533   if (close (fd) == -1) {
6534     perror (filename);
6535     unlink (filename);
6536     exit (EXIT_FAILURE);
6537   }
6538   if (guestfs_add_drive (g, filename) == -1) {
6539     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6540     exit (EXIT_FAILURE);
6541   }
6542
6543   filename = \"test2.img\";
6544   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6545   if (fd == -1) {
6546     perror (filename);
6547     exit (EXIT_FAILURE);
6548   }
6549   if (lseek (fd, %d, SEEK_SET) == -1) {
6550     perror (\"lseek\");
6551     close (fd);
6552     unlink (filename);
6553     exit (EXIT_FAILURE);
6554   }
6555   if (write (fd, &c, 1) == -1) {
6556     perror (\"write\");
6557     close (fd);
6558     unlink (filename);
6559     exit (EXIT_FAILURE);
6560   }
6561   if (close (fd) == -1) {
6562     perror (filename);
6563     unlink (filename);
6564     exit (EXIT_FAILURE);
6565   }
6566   if (guestfs_add_drive (g, filename) == -1) {
6567     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6568     exit (EXIT_FAILURE);
6569   }
6570
6571   filename = \"test3.img\";
6572   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6573   if (fd == -1) {
6574     perror (filename);
6575     exit (EXIT_FAILURE);
6576   }
6577   if (lseek (fd, %d, SEEK_SET) == -1) {
6578     perror (\"lseek\");
6579     close (fd);
6580     unlink (filename);
6581     exit (EXIT_FAILURE);
6582   }
6583   if (write (fd, &c, 1) == -1) {
6584     perror (\"write\");
6585     close (fd);
6586     unlink (filename);
6587     exit (EXIT_FAILURE);
6588   }
6589   if (close (fd) == -1) {
6590     perror (filename);
6591     unlink (filename);
6592     exit (EXIT_FAILURE);
6593   }
6594   if (guestfs_add_drive (g, filename) == -1) {
6595     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6596     exit (EXIT_FAILURE);
6597   }
6598
6599   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6600     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6601     exit (EXIT_FAILURE);
6602   }
6603
6604   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6605   alarm (600);
6606
6607   if (guestfs_launch (g) == -1) {
6608     printf (\"guestfs_launch FAILED\\n\");
6609     exit (EXIT_FAILURE);
6610   }
6611
6612   /* Cancel previous alarm. */
6613   alarm (0);
6614
6615   nr_tests = %d;
6616
6617 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6618
6619   iteri (
6620     fun i test_name ->
6621       pr "  test_num++;\n";
6622       pr "  if (guestfs_get_verbose (g))\n";
6623       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6624       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6625       pr "  if (%s () == -1) {\n" test_name;
6626       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6627       pr "    n_failed++;\n";
6628       pr "  }\n";
6629   ) test_names;
6630   pr "\n";
6631
6632   pr "  guestfs_close (g);\n";
6633   pr "  unlink (\"test1.img\");\n";
6634   pr "  unlink (\"test2.img\");\n";
6635   pr "  unlink (\"test3.img\");\n";
6636   pr "\n";
6637
6638   pr "  if (n_failed > 0) {\n";
6639   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6640   pr "    exit (EXIT_FAILURE);\n";
6641   pr "  }\n";
6642   pr "\n";
6643
6644   pr "  exit (EXIT_SUCCESS);\n";
6645   pr "}\n"
6646
6647 and generate_one_test name flags i (init, prereq, test) =
6648   let test_name = sprintf "test_%s_%d" name i in
6649
6650   pr "\
6651 static int %s_skip (void)
6652 {
6653   const char *str;
6654
6655   str = getenv (\"TEST_ONLY\");
6656   if (str)
6657     return strstr (str, \"%s\") == NULL;
6658   str = getenv (\"SKIP_%s\");
6659   if (str && STREQ (str, \"1\")) return 1;
6660   str = getenv (\"SKIP_TEST_%s\");
6661   if (str && STREQ (str, \"1\")) return 1;
6662   return 0;
6663 }
6664
6665 " test_name name (String.uppercase test_name) (String.uppercase name);
6666
6667   (match prereq with
6668    | Disabled | Always -> ()
6669    | If code | Unless code ->
6670        pr "static int %s_prereq (void)\n" test_name;
6671        pr "{\n";
6672        pr "  %s\n" code;
6673        pr "}\n";
6674        pr "\n";
6675   );
6676
6677   pr "\
6678 static int %s (void)
6679 {
6680   if (%s_skip ()) {
6681     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6682     return 0;
6683   }
6684
6685 " test_name test_name test_name;
6686
6687   (* Optional functions should only be tested if the relevant
6688    * support is available in the daemon.
6689    *)
6690   List.iter (
6691     function
6692     | Optional group ->
6693         pr "  {\n";
6694         pr "    const char *groups[] = { \"%s\", NULL };\n" group;
6695         pr "    int r;\n";
6696         pr "    suppress_error = 1;\n";
6697         pr "    r = guestfs_available (g, (char **) groups);\n";
6698         pr "    suppress_error = 0;\n";
6699         pr "    if (r == -1) {\n";
6700         pr "      printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
6701         pr "      return 0;\n";
6702         pr "    }\n";
6703         pr "  }\n";
6704     | _ -> ()
6705   ) flags;
6706
6707   (match prereq with
6708    | Disabled ->
6709        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6710    | If _ ->
6711        pr "  if (! %s_prereq ()) {\n" test_name;
6712        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6713        pr "    return 0;\n";
6714        pr "  }\n";
6715        pr "\n";
6716        generate_one_test_body name i test_name init test;
6717    | Unless _ ->
6718        pr "  if (%s_prereq ()) {\n" test_name;
6719        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6720        pr "    return 0;\n";
6721        pr "  }\n";
6722        pr "\n";
6723        generate_one_test_body name i test_name init test;
6724    | Always ->
6725        generate_one_test_body name i test_name init test
6726   );
6727
6728   pr "  return 0;\n";
6729   pr "}\n";
6730   pr "\n";
6731   test_name
6732
6733 and generate_one_test_body name i test_name init test =
6734   (match init with
6735    | InitNone (* XXX at some point, InitNone and InitEmpty became
6736                * folded together as the same thing.  Really we should
6737                * make InitNone do nothing at all, but the tests may
6738                * need to be checked to make sure this is OK.
6739                *)
6740    | InitEmpty ->
6741        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6742        List.iter (generate_test_command_call test_name)
6743          [["blockdev_setrw"; "/dev/sda"];
6744           ["umount_all"];
6745           ["lvm_remove_all"]]
6746    | InitPartition ->
6747        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6748        List.iter (generate_test_command_call test_name)
6749          [["blockdev_setrw"; "/dev/sda"];
6750           ["umount_all"];
6751           ["lvm_remove_all"];
6752           ["part_disk"; "/dev/sda"; "mbr"]]
6753    | InitBasicFS ->
6754        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6755        List.iter (generate_test_command_call test_name)
6756          [["blockdev_setrw"; "/dev/sda"];
6757           ["umount_all"];
6758           ["lvm_remove_all"];
6759           ["part_disk"; "/dev/sda"; "mbr"];
6760           ["mkfs"; "ext2"; "/dev/sda1"];
6761           ["mount_options"; ""; "/dev/sda1"; "/"]]
6762    | InitBasicFSonLVM ->
6763        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6764          test_name;
6765        List.iter (generate_test_command_call test_name)
6766          [["blockdev_setrw"; "/dev/sda"];
6767           ["umount_all"];
6768           ["lvm_remove_all"];
6769           ["part_disk"; "/dev/sda"; "mbr"];
6770           ["pvcreate"; "/dev/sda1"];
6771           ["vgcreate"; "VG"; "/dev/sda1"];
6772           ["lvcreate"; "LV"; "VG"; "8"];
6773           ["mkfs"; "ext2"; "/dev/VG/LV"];
6774           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6775    | InitISOFS ->
6776        pr "  /* InitISOFS for %s */\n" test_name;
6777        List.iter (generate_test_command_call test_name)
6778          [["blockdev_setrw"; "/dev/sda"];
6779           ["umount_all"];
6780           ["lvm_remove_all"];
6781           ["mount_ro"; "/dev/sdd"; "/"]]
6782   );
6783
6784   let get_seq_last = function
6785     | [] ->
6786         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6787           test_name
6788     | seq ->
6789         let seq = List.rev seq in
6790         List.rev (List.tl seq), List.hd seq
6791   in
6792
6793   match test with
6794   | TestRun seq ->
6795       pr "  /* TestRun for %s (%d) */\n" name i;
6796       List.iter (generate_test_command_call test_name) seq
6797   | TestOutput (seq, expected) ->
6798       pr "  /* TestOutput for %s (%d) */\n" name i;
6799       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6800       let seq, last = get_seq_last seq in
6801       let test () =
6802         pr "    if (STRNEQ (r, expected)) {\n";
6803         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6804         pr "      return -1;\n";
6805         pr "    }\n"
6806       in
6807       List.iter (generate_test_command_call test_name) seq;
6808       generate_test_command_call ~test test_name last
6809   | TestOutputList (seq, expected) ->
6810       pr "  /* TestOutputList for %s (%d) */\n" name i;
6811       let seq, last = get_seq_last seq in
6812       let test () =
6813         iteri (
6814           fun i str ->
6815             pr "    if (!r[%d]) {\n" i;
6816             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6817             pr "      print_strings (r);\n";
6818             pr "      return -1;\n";
6819             pr "    }\n";
6820             pr "    {\n";
6821             pr "      const char *expected = \"%s\";\n" (c_quote str);
6822             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6823             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6824             pr "        return -1;\n";
6825             pr "      }\n";
6826             pr "    }\n"
6827         ) expected;
6828         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6829         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6830           test_name;
6831         pr "      print_strings (r);\n";
6832         pr "      return -1;\n";
6833         pr "    }\n"
6834       in
6835       List.iter (generate_test_command_call test_name) seq;
6836       generate_test_command_call ~test test_name last
6837   | TestOutputListOfDevices (seq, expected) ->
6838       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6839       let seq, last = get_seq_last seq in
6840       let test () =
6841         iteri (
6842           fun i str ->
6843             pr "    if (!r[%d]) {\n" i;
6844             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6845             pr "      print_strings (r);\n";
6846             pr "      return -1;\n";
6847             pr "    }\n";
6848             pr "    {\n";
6849             pr "      const char *expected = \"%s\";\n" (c_quote str);
6850             pr "      r[%d][5] = 's';\n" i;
6851             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6852             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6853             pr "        return -1;\n";
6854             pr "      }\n";
6855             pr "    }\n"
6856         ) expected;
6857         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6858         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6859           test_name;
6860         pr "      print_strings (r);\n";
6861         pr "      return -1;\n";
6862         pr "    }\n"
6863       in
6864       List.iter (generate_test_command_call test_name) seq;
6865       generate_test_command_call ~test test_name last
6866   | TestOutputInt (seq, expected) ->
6867       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6868       let seq, last = get_seq_last seq in
6869       let test () =
6870         pr "    if (r != %d) {\n" expected;
6871         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6872           test_name expected;
6873         pr "               (int) r);\n";
6874         pr "      return -1;\n";
6875         pr "    }\n"
6876       in
6877       List.iter (generate_test_command_call test_name) seq;
6878       generate_test_command_call ~test test_name last
6879   | TestOutputIntOp (seq, op, expected) ->
6880       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6881       let seq, last = get_seq_last seq in
6882       let test () =
6883         pr "    if (! (r %s %d)) {\n" op expected;
6884         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6885           test_name op expected;
6886         pr "               (int) r);\n";
6887         pr "      return -1;\n";
6888         pr "    }\n"
6889       in
6890       List.iter (generate_test_command_call test_name) seq;
6891       generate_test_command_call ~test test_name last
6892   | TestOutputTrue seq ->
6893       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6894       let seq, last = get_seq_last seq in
6895       let test () =
6896         pr "    if (!r) {\n";
6897         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6898           test_name;
6899         pr "      return -1;\n";
6900         pr "    }\n"
6901       in
6902       List.iter (generate_test_command_call test_name) seq;
6903       generate_test_command_call ~test test_name last
6904   | TestOutputFalse seq ->
6905       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6906       let seq, last = get_seq_last seq in
6907       let test () =
6908         pr "    if (r) {\n";
6909         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6910           test_name;
6911         pr "      return -1;\n";
6912         pr "    }\n"
6913       in
6914       List.iter (generate_test_command_call test_name) seq;
6915       generate_test_command_call ~test test_name last
6916   | TestOutputLength (seq, expected) ->
6917       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6918       let seq, last = get_seq_last seq in
6919       let test () =
6920         pr "    int j;\n";
6921         pr "    for (j = 0; j < %d; ++j)\n" expected;
6922         pr "      if (r[j] == NULL) {\n";
6923         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6924           test_name;
6925         pr "        print_strings (r);\n";
6926         pr "        return -1;\n";
6927         pr "      }\n";
6928         pr "    if (r[j] != NULL) {\n";
6929         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6930           test_name;
6931         pr "      print_strings (r);\n";
6932         pr "      return -1;\n";
6933         pr "    }\n"
6934       in
6935       List.iter (generate_test_command_call test_name) seq;
6936       generate_test_command_call ~test test_name last
6937   | TestOutputBuffer (seq, expected) ->
6938       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6939       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6940       let seq, last = get_seq_last seq in
6941       let len = String.length expected in
6942       let test () =
6943         pr "    if (size != %d) {\n" len;
6944         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6945         pr "      return -1;\n";
6946         pr "    }\n";
6947         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6948         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6949         pr "      return -1;\n";
6950         pr "    }\n"
6951       in
6952       List.iter (generate_test_command_call test_name) seq;
6953       generate_test_command_call ~test test_name last
6954   | TestOutputStruct (seq, checks) ->
6955       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6956       let seq, last = get_seq_last seq in
6957       let test () =
6958         List.iter (
6959           function
6960           | CompareWithInt (field, expected) ->
6961               pr "    if (r->%s != %d) {\n" field expected;
6962               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6963                 test_name field expected;
6964               pr "               (int) r->%s);\n" field;
6965               pr "      return -1;\n";
6966               pr "    }\n"
6967           | CompareWithIntOp (field, op, expected) ->
6968               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6969               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
6970                 test_name field op expected;
6971               pr "               (int) r->%s);\n" field;
6972               pr "      return -1;\n";
6973               pr "    }\n"
6974           | CompareWithString (field, expected) ->
6975               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
6976               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
6977                 test_name field expected;
6978               pr "               r->%s);\n" field;
6979               pr "      return -1;\n";
6980               pr "    }\n"
6981           | CompareFieldsIntEq (field1, field2) ->
6982               pr "    if (r->%s != r->%s) {\n" field1 field2;
6983               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
6984                 test_name field1 field2;
6985               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
6986               pr "      return -1;\n";
6987               pr "    }\n"
6988           | CompareFieldsStrEq (field1, field2) ->
6989               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
6990               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
6991                 test_name field1 field2;
6992               pr "               r->%s, r->%s);\n" field1 field2;
6993               pr "      return -1;\n";
6994               pr "    }\n"
6995         ) checks
6996       in
6997       List.iter (generate_test_command_call test_name) seq;
6998       generate_test_command_call ~test test_name last
6999   | TestLastFail seq ->
7000       pr "  /* TestLastFail for %s (%d) */\n" name i;
7001       let seq, last = get_seq_last seq in
7002       List.iter (generate_test_command_call test_name) seq;
7003       generate_test_command_call test_name ~expect_error:true last
7004
7005 (* Generate the code to run a command, leaving the result in 'r'.
7006  * If you expect to get an error then you should set expect_error:true.
7007  *)
7008 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7009   match cmd with
7010   | [] -> assert false
7011   | name :: args ->
7012       (* Look up the command to find out what args/ret it has. *)
7013       let style =
7014         try
7015           let _, style, _, _, _, _, _ =
7016             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7017           style
7018         with Not_found ->
7019           failwithf "%s: in test, command %s was not found" test_name name in
7020
7021       if List.length (snd style) <> List.length args then
7022         failwithf "%s: in test, wrong number of args given to %s"
7023           test_name name;
7024
7025       pr "  {\n";
7026
7027       List.iter (
7028         function
7029         | OptString n, "NULL" -> ()
7030         | Pathname n, arg
7031         | Device n, arg
7032         | Dev_or_Path n, arg
7033         | String n, arg
7034         | OptString n, arg ->
7035             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7036         | Int _, _
7037         | Int64 _, _
7038         | Bool _, _
7039         | FileIn _, _ | FileOut _, _ -> ()
7040         | StringList n, "" | DeviceList n, "" ->
7041             pr "    const char *const %s[1] = { NULL };\n" n
7042         | StringList n, arg | DeviceList n, arg ->
7043             let strs = string_split " " arg in
7044             iteri (
7045               fun i str ->
7046                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7047             ) strs;
7048             pr "    const char *const %s[] = {\n" n;
7049             iteri (
7050               fun i _ -> pr "      %s_%d,\n" n i
7051             ) strs;
7052             pr "      NULL\n";
7053             pr "    };\n";
7054       ) (List.combine (snd style) args);
7055
7056       let error_code =
7057         match fst style with
7058         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7059         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7060         | RConstString _ | RConstOptString _ ->
7061             pr "    const char *r;\n"; "NULL"
7062         | RString _ -> pr "    char *r;\n"; "NULL"
7063         | RStringList _ | RHashtable _ ->
7064             pr "    char **r;\n";
7065             pr "    int i;\n";
7066             "NULL"
7067         | RStruct (_, typ) ->
7068             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7069         | RStructList (_, typ) ->
7070             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7071         | RBufferOut _ ->
7072             pr "    char *r;\n";
7073             pr "    size_t size;\n";
7074             "NULL" in
7075
7076       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7077       pr "    r = guestfs_%s (g" name;
7078
7079       (* Generate the parameters. *)
7080       List.iter (
7081         function
7082         | OptString _, "NULL" -> pr ", NULL"
7083         | Pathname n, _
7084         | Device n, _ | Dev_or_Path n, _
7085         | String n, _
7086         | OptString n, _ ->
7087             pr ", %s" n
7088         | FileIn _, arg | FileOut _, arg ->
7089             pr ", \"%s\"" (c_quote arg)
7090         | StringList n, _ | DeviceList n, _ ->
7091             pr ", (char **) %s" n
7092         | Int _, arg ->
7093             let i =
7094               try int_of_string arg
7095               with Failure "int_of_string" ->
7096                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7097             pr ", %d" i
7098         | Int64 _, arg ->
7099             let i =
7100               try Int64.of_string arg
7101               with Failure "int_of_string" ->
7102                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7103             pr ", %Ld" i
7104         | Bool _, arg ->
7105             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7106       ) (List.combine (snd style) args);
7107
7108       (match fst style with
7109        | RBufferOut _ -> pr ", &size"
7110        | _ -> ()
7111       );
7112
7113       pr ");\n";
7114
7115       if not expect_error then
7116         pr "    if (r == %s)\n" error_code
7117       else
7118         pr "    if (r != %s)\n" error_code;
7119       pr "      return -1;\n";
7120
7121       (* Insert the test code. *)
7122       (match test with
7123        | None -> ()
7124        | Some f -> f ()
7125       );
7126
7127       (match fst style with
7128        | RErr | RInt _ | RInt64 _ | RBool _
7129        | RConstString _ | RConstOptString _ -> ()
7130        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7131        | RStringList _ | RHashtable _ ->
7132            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7133            pr "      free (r[i]);\n";
7134            pr "    free (r);\n"
7135        | RStruct (_, typ) ->
7136            pr "    guestfs_free_%s (r);\n" typ
7137        | RStructList (_, typ) ->
7138            pr "    guestfs_free_%s_list (r);\n" typ
7139       );
7140
7141       pr "  }\n"
7142
7143 and c_quote str =
7144   let str = replace_str str "\r" "\\r" in
7145   let str = replace_str str "\n" "\\n" in
7146   let str = replace_str str "\t" "\\t" in
7147   let str = replace_str str "\000" "\\0" in
7148   str
7149
7150 (* Generate a lot of different functions for guestfish. *)
7151 and generate_fish_cmds () =
7152   generate_header CStyle GPLv2plus;
7153
7154   let all_functions =
7155     List.filter (
7156       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7157     ) all_functions in
7158   let all_functions_sorted =
7159     List.filter (
7160       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7161     ) all_functions_sorted in
7162
7163   pr "#include <config.h>\n";
7164   pr "\n";
7165   pr "#include <stdio.h>\n";
7166   pr "#include <stdlib.h>\n";
7167   pr "#include <string.h>\n";
7168   pr "#include <inttypes.h>\n";
7169   pr "\n";
7170   pr "#include <guestfs.h>\n";
7171   pr "#include \"c-ctype.h\"\n";
7172   pr "#include \"full-write.h\"\n";
7173   pr "#include \"xstrtol.h\"\n";
7174   pr "#include \"fish.h\"\n";
7175   pr "\n";
7176
7177   (* list_commands function, which implements guestfish -h *)
7178   pr "void list_commands (void)\n";
7179   pr "{\n";
7180   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7181   pr "  list_builtin_commands ();\n";
7182   List.iter (
7183     fun (name, _, _, flags, _, shortdesc, _) ->
7184       let name = replace_char name '_' '-' in
7185       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7186         name shortdesc
7187   ) all_functions_sorted;
7188   pr "  printf (\"    %%s\\n\",";
7189   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7190   pr "}\n";
7191   pr "\n";
7192
7193   (* display_command function, which implements guestfish -h cmd *)
7194   pr "void display_command (const char *cmd)\n";
7195   pr "{\n";
7196   List.iter (
7197     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7198       let name2 = replace_char name '_' '-' in
7199       let alias =
7200         try find_map (function FishAlias n -> Some n | _ -> None) flags
7201         with Not_found -> name in
7202       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7203       let synopsis =
7204         match snd style with
7205         | [] -> name2
7206         | args ->
7207             sprintf "%s %s"
7208               name2 (String.concat " " (List.map name_of_argt args)) in
7209
7210       let warnings =
7211         if List.mem ProtocolLimitWarning flags then
7212           ("\n\n" ^ protocol_limit_warning)
7213         else "" in
7214
7215       (* For DangerWillRobinson commands, we should probably have
7216        * guestfish prompt before allowing you to use them (especially
7217        * in interactive mode). XXX
7218        *)
7219       let warnings =
7220         warnings ^
7221           if List.mem DangerWillRobinson flags then
7222             ("\n\n" ^ danger_will_robinson)
7223           else "" in
7224
7225       let warnings =
7226         warnings ^
7227           match deprecation_notice flags with
7228           | None -> ""
7229           | Some txt -> "\n\n" ^ txt in
7230
7231       let describe_alias =
7232         if name <> alias then
7233           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7234         else "" in
7235
7236       pr "  if (";
7237       pr "STRCASEEQ (cmd, \"%s\")" name;
7238       if name <> name2 then
7239         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7240       if name <> alias then
7241         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7242       pr ")\n";
7243       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7244         name2 shortdesc
7245         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7246          "=head1 DESCRIPTION\n\n" ^
7247          longdesc ^ warnings ^ describe_alias);
7248       pr "  else\n"
7249   ) all_functions;
7250   pr "    display_builtin_command (cmd);\n";
7251   pr "}\n";
7252   pr "\n";
7253
7254   let emit_print_list_function typ =
7255     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7256       typ typ typ;
7257     pr "{\n";
7258     pr "  unsigned int i;\n";
7259     pr "\n";
7260     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7261     pr "    printf (\"[%%d] = {\\n\", i);\n";
7262     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7263     pr "    printf (\"}\\n\");\n";
7264     pr "  }\n";
7265     pr "}\n";
7266     pr "\n";
7267   in
7268
7269   (* print_* functions *)
7270   List.iter (
7271     fun (typ, cols) ->
7272       let needs_i =
7273         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7274
7275       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7276       pr "{\n";
7277       if needs_i then (
7278         pr "  unsigned int i;\n";
7279         pr "\n"
7280       );
7281       List.iter (
7282         function
7283         | name, FString ->
7284             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7285         | name, FUUID ->
7286             pr "  printf (\"%%s%s: \", indent);\n" name;
7287             pr "  for (i = 0; i < 32; ++i)\n";
7288             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7289             pr "  printf (\"\\n\");\n"
7290         | name, FBuffer ->
7291             pr "  printf (\"%%s%s: \", indent);\n" name;
7292             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7293             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7294             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7295             pr "    else\n";
7296             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7297             pr "  printf (\"\\n\");\n"
7298         | name, (FUInt64|FBytes) ->
7299             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7300               name typ name
7301         | name, FInt64 ->
7302             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7303               name typ name
7304         | name, FUInt32 ->
7305             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7306               name typ name
7307         | name, FInt32 ->
7308             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7309               name typ name
7310         | name, FChar ->
7311             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7312               name typ name
7313         | name, FOptPercent ->
7314             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7315               typ name name typ name;
7316             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7317       ) cols;
7318       pr "}\n";
7319       pr "\n";
7320   ) structs;
7321
7322   (* Emit a print_TYPE_list function definition only if that function is used. *)
7323   List.iter (
7324     function
7325     | typ, (RStructListOnly | RStructAndList) ->
7326         (* generate the function for typ *)
7327         emit_print_list_function typ
7328     | typ, _ -> () (* empty *)
7329   ) (rstructs_used_by all_functions);
7330
7331   (* Emit a print_TYPE function definition only if that function is used. *)
7332   List.iter (
7333     function
7334     | typ, (RStructOnly | RStructAndList) ->
7335         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7336         pr "{\n";
7337         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7338         pr "}\n";
7339         pr "\n";
7340     | typ, _ -> () (* empty *)
7341   ) (rstructs_used_by all_functions);
7342
7343   (* run_<action> actions *)
7344   List.iter (
7345     fun (name, style, _, flags, _, _, _) ->
7346       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7347       pr "{\n";
7348       (match fst style with
7349        | RErr
7350        | RInt _
7351        | RBool _ -> pr "  int r;\n"
7352        | RInt64 _ -> pr "  int64_t r;\n"
7353        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7354        | RString _ -> pr "  char *r;\n"
7355        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7356        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7357        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7358        | RBufferOut _ ->
7359            pr "  char *r;\n";
7360            pr "  size_t size;\n";
7361       );
7362       List.iter (
7363         function
7364         | Device n
7365         | String n
7366         | OptString n
7367         | FileIn n
7368         | FileOut n -> pr "  const char *%s;\n" n
7369         | Pathname n
7370         | Dev_or_Path n -> pr "  char *%s;\n" n
7371         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7372         | Bool n -> pr "  int %s;\n" n
7373         | Int n -> pr "  int %s;\n" n
7374         | Int64 n -> pr "  int64_t %s;\n" n
7375       ) (snd style);
7376
7377       (* Check and convert parameters. *)
7378       let argc_expected = List.length (snd style) in
7379       pr "  if (argc != %d) {\n" argc_expected;
7380       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7381         argc_expected;
7382       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7383       pr "    return -1;\n";
7384       pr "  }\n";
7385
7386       let parse_integer fn fntyp rtyp range name i =
7387         pr "  {\n";
7388         pr "    strtol_error xerr;\n";
7389         pr "    %s r;\n" fntyp;
7390         pr "\n";
7391         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7392         pr "    if (xerr != LONGINT_OK) {\n";
7393         pr "      fprintf (stderr,\n";
7394         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7395         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7396         pr "      return -1;\n";
7397         pr "    }\n";
7398         (match range with
7399          | None -> ()
7400          | Some (min, max, comment) ->
7401              pr "    /* %s */\n" comment;
7402              pr "    if (r < %s || r > %s) {\n" min max;
7403              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7404                name;
7405              pr "      return -1;\n";
7406              pr "    }\n";
7407              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7408         );
7409         pr "    %s = r;\n" name;
7410         pr "  }\n";
7411       in
7412
7413       iteri (
7414         fun i ->
7415           function
7416           | Device name
7417           | String name ->
7418               pr "  %s = argv[%d];\n" name i
7419           | Pathname name
7420           | Dev_or_Path name ->
7421               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7422               pr "  if (%s == NULL) return -1;\n" name
7423           | OptString name ->
7424               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7425                 name i i
7426           | FileIn name ->
7427               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7428                 name i i
7429           | FileOut name ->
7430               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7431                 name i i
7432           | StringList name | DeviceList name ->
7433               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7434               pr "  if (%s == NULL) return -1;\n" name;
7435           | Bool name ->
7436               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7437           | Int name ->
7438               let range =
7439                 let min = "(-(2LL<<30))"
7440                 and max = "((2LL<<30)-1)"
7441                 and comment =
7442                   "The Int type in the generator is a signed 31 bit int." in
7443                 Some (min, max, comment) in
7444               parse_integer "xstrtoll" "long long" "int" range name i
7445           | Int64 name ->
7446               parse_integer "xstrtoll" "long long" "int64_t" None name i
7447       ) (snd style);
7448
7449       (* Call C API function. *)
7450       let fn =
7451         try find_map (function FishAction n -> Some n | _ -> None) flags
7452         with Not_found -> sprintf "guestfs_%s" name in
7453       pr "  r = %s " fn;
7454       generate_c_call_args ~handle:"g" style;
7455       pr ";\n";
7456
7457       List.iter (
7458         function
7459         | Device name | String name
7460         | OptString name | FileIn name | FileOut name | Bool name
7461         | Int name | Int64 name -> ()
7462         | Pathname name | Dev_or_Path name ->
7463             pr "  free (%s);\n" name
7464         | StringList name | DeviceList name ->
7465             pr "  free_strings (%s);\n" name
7466       ) (snd style);
7467
7468       (* Check return value for errors and display command results. *)
7469       (match fst style with
7470        | RErr -> pr "  return r;\n"
7471        | RInt _ ->
7472            pr "  if (r == -1) return -1;\n";
7473            pr "  printf (\"%%d\\n\", r);\n";
7474            pr "  return 0;\n"
7475        | RInt64 _ ->
7476            pr "  if (r == -1) return -1;\n";
7477            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7478            pr "  return 0;\n"
7479        | RBool _ ->
7480            pr "  if (r == -1) return -1;\n";
7481            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7482            pr "  return 0;\n"
7483        | RConstString _ ->
7484            pr "  if (r == NULL) return -1;\n";
7485            pr "  printf (\"%%s\\n\", r);\n";
7486            pr "  return 0;\n"
7487        | RConstOptString _ ->
7488            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7489            pr "  return 0;\n"
7490        | RString _ ->
7491            pr "  if (r == NULL) return -1;\n";
7492            pr "  printf (\"%%s\\n\", r);\n";
7493            pr "  free (r);\n";
7494            pr "  return 0;\n"
7495        | RStringList _ ->
7496            pr "  if (r == NULL) return -1;\n";
7497            pr "  print_strings (r);\n";
7498            pr "  free_strings (r);\n";
7499            pr "  return 0;\n"
7500        | RStruct (_, typ) ->
7501            pr "  if (r == NULL) return -1;\n";
7502            pr "  print_%s (r);\n" typ;
7503            pr "  guestfs_free_%s (r);\n" typ;
7504            pr "  return 0;\n"
7505        | RStructList (_, typ) ->
7506            pr "  if (r == NULL) return -1;\n";
7507            pr "  print_%s_list (r);\n" typ;
7508            pr "  guestfs_free_%s_list (r);\n" typ;
7509            pr "  return 0;\n"
7510        | RHashtable _ ->
7511            pr "  if (r == NULL) return -1;\n";
7512            pr "  print_table (r);\n";
7513            pr "  free_strings (r);\n";
7514            pr "  return 0;\n"
7515        | RBufferOut _ ->
7516            pr "  if (r == NULL) return -1;\n";
7517            pr "  if (full_write (1, r, size) != size) {\n";
7518            pr "    perror (\"write\");\n";
7519            pr "    free (r);\n";
7520            pr "    return -1;\n";
7521            pr "  }\n";
7522            pr "  free (r);\n";
7523            pr "  return 0;\n"
7524       );
7525       pr "}\n";
7526       pr "\n"
7527   ) all_functions;
7528
7529   (* run_action function *)
7530   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7531   pr "{\n";
7532   List.iter (
7533     fun (name, _, _, flags, _, _, _) ->
7534       let name2 = replace_char name '_' '-' in
7535       let alias =
7536         try find_map (function FishAlias n -> Some n | _ -> None) flags
7537         with Not_found -> name in
7538       pr "  if (";
7539       pr "STRCASEEQ (cmd, \"%s\")" name;
7540       if name <> name2 then
7541         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7542       if name <> alias then
7543         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7544       pr ")\n";
7545       pr "    return run_%s (cmd, argc, argv);\n" name;
7546       pr "  else\n";
7547   ) all_functions;
7548   pr "    {\n";
7549   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7550   pr "      if (command_num == 1)\n";
7551   pr "        extended_help_message ();\n";
7552   pr "      return -1;\n";
7553   pr "    }\n";
7554   pr "  return 0;\n";
7555   pr "}\n";
7556   pr "\n"
7557
7558 (* Readline completion for guestfish. *)
7559 and generate_fish_completion () =
7560   generate_header CStyle GPLv2plus;
7561
7562   let all_functions =
7563     List.filter (
7564       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7565     ) all_functions in
7566
7567   pr "\
7568 #include <config.h>
7569
7570 #include <stdio.h>
7571 #include <stdlib.h>
7572 #include <string.h>
7573
7574 #ifdef HAVE_LIBREADLINE
7575 #include <readline/readline.h>
7576 #endif
7577
7578 #include \"fish.h\"
7579
7580 #ifdef HAVE_LIBREADLINE
7581
7582 static const char *const commands[] = {
7583   BUILTIN_COMMANDS_FOR_COMPLETION,
7584 ";
7585
7586   (* Get the commands, including the aliases.  They don't need to be
7587    * sorted - the generator() function just does a dumb linear search.
7588    *)
7589   let commands =
7590     List.map (
7591       fun (name, _, _, flags, _, _, _) ->
7592         let name2 = replace_char name '_' '-' in
7593         let alias =
7594           try find_map (function FishAlias n -> Some n | _ -> None) flags
7595           with Not_found -> name in
7596
7597         if name <> alias then [name2; alias] else [name2]
7598     ) all_functions in
7599   let commands = List.flatten commands in
7600
7601   List.iter (pr "  \"%s\",\n") commands;
7602
7603   pr "  NULL
7604 };
7605
7606 static char *
7607 generator (const char *text, int state)
7608 {
7609   static int index, len;
7610   const char *name;
7611
7612   if (!state) {
7613     index = 0;
7614     len = strlen (text);
7615   }
7616
7617   rl_attempted_completion_over = 1;
7618
7619   while ((name = commands[index]) != NULL) {
7620     index++;
7621     if (STRCASEEQLEN (name, text, len))
7622       return strdup (name);
7623   }
7624
7625   return NULL;
7626 }
7627
7628 #endif /* HAVE_LIBREADLINE */
7629
7630 #ifdef HAVE_RL_COMPLETION_MATCHES
7631 #define RL_COMPLETION_MATCHES rl_completion_matches
7632 #else
7633 #ifdef HAVE_COMPLETION_MATCHES
7634 #define RL_COMPLETION_MATCHES completion_matches
7635 #endif
7636 #endif /* else just fail if we don't have either symbol */
7637
7638 char **
7639 do_completion (const char *text, int start, int end)
7640 {
7641   char **matches = NULL;
7642
7643 #ifdef HAVE_LIBREADLINE
7644   rl_completion_append_character = ' ';
7645
7646   if (start == 0)
7647     matches = RL_COMPLETION_MATCHES (text, generator);
7648   else if (complete_dest_paths)
7649     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7650 #endif
7651
7652   return matches;
7653 }
7654 ";
7655
7656 (* Generate the POD documentation for guestfish. *)
7657 and generate_fish_actions_pod () =
7658   let all_functions_sorted =
7659     List.filter (
7660       fun (_, _, _, flags, _, _, _) ->
7661         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7662     ) all_functions_sorted in
7663
7664   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7665
7666   List.iter (
7667     fun (name, style, _, flags, _, _, longdesc) ->
7668       let longdesc =
7669         Str.global_substitute rex (
7670           fun s ->
7671             let sub =
7672               try Str.matched_group 1 s
7673               with Not_found ->
7674                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7675             "C<" ^ replace_char sub '_' '-' ^ ">"
7676         ) longdesc in
7677       let name = replace_char name '_' '-' in
7678       let alias =
7679         try find_map (function FishAlias n -> Some n | _ -> None) flags
7680         with Not_found -> name in
7681
7682       pr "=head2 %s" name;
7683       if name <> alias then
7684         pr " | %s" alias;
7685       pr "\n";
7686       pr "\n";
7687       pr " %s" name;
7688       List.iter (
7689         function
7690         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7691         | OptString n -> pr " %s" n
7692         | StringList n | DeviceList n -> pr " '%s ...'" n
7693         | Bool _ -> pr " true|false"
7694         | Int n -> pr " %s" n
7695         | Int64 n -> pr " %s" n
7696         | FileIn n | FileOut n -> pr " (%s|-)" n
7697       ) (snd style);
7698       pr "\n";
7699       pr "\n";
7700       pr "%s\n\n" longdesc;
7701
7702       if List.exists (function FileIn _ | FileOut _ -> true
7703                       | _ -> false) (snd style) then
7704         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7705
7706       if List.mem ProtocolLimitWarning flags then
7707         pr "%s\n\n" protocol_limit_warning;
7708
7709       if List.mem DangerWillRobinson flags then
7710         pr "%s\n\n" danger_will_robinson;
7711
7712       match deprecation_notice flags with
7713       | None -> ()
7714       | Some txt -> pr "%s\n\n" txt
7715   ) all_functions_sorted
7716
7717 (* Generate a C function prototype. *)
7718 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7719     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7720     ?(prefix = "")
7721     ?handle name style =
7722   if extern then pr "extern ";
7723   if static then pr "static ";
7724   (match fst style with
7725    | RErr -> pr "int "
7726    | RInt _ -> pr "int "
7727    | RInt64 _ -> pr "int64_t "
7728    | RBool _ -> pr "int "
7729    | RConstString _ | RConstOptString _ -> pr "const char *"
7730    | RString _ | RBufferOut _ -> pr "char *"
7731    | RStringList _ | RHashtable _ -> pr "char **"
7732    | RStruct (_, typ) ->
7733        if not in_daemon then pr "struct guestfs_%s *" typ
7734        else pr "guestfs_int_%s *" typ
7735    | RStructList (_, typ) ->
7736        if not in_daemon then pr "struct guestfs_%s_list *" typ
7737        else pr "guestfs_int_%s_list *" typ
7738   );
7739   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7740   pr "%s%s (" prefix name;
7741   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7742     pr "void"
7743   else (
7744     let comma = ref false in
7745     (match handle with
7746      | None -> ()
7747      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7748     );
7749     let next () =
7750       if !comma then (
7751         if single_line then pr ", " else pr ",\n\t\t"
7752       );
7753       comma := true
7754     in
7755     List.iter (
7756       function
7757       | Pathname n
7758       | Device n | Dev_or_Path n
7759       | String n
7760       | OptString n ->
7761           next ();
7762           pr "const char *%s" n
7763       | StringList n | DeviceList n ->
7764           next ();
7765           pr "char *const *%s" n
7766       | Bool n -> next (); pr "int %s" n
7767       | Int n -> next (); pr "int %s" n
7768       | Int64 n -> next (); pr "int64_t %s" n
7769       | FileIn n
7770       | FileOut n ->
7771           if not in_daemon then (next (); pr "const char *%s" n)
7772     ) (snd style);
7773     if is_RBufferOut then (next (); pr "size_t *size_r");
7774   );
7775   pr ")";
7776   if semicolon then pr ";";
7777   if newline then pr "\n"
7778
7779 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7780 and generate_c_call_args ?handle ?(decl = false) style =
7781   pr "(";
7782   let comma = ref false in
7783   let next () =
7784     if !comma then pr ", ";
7785     comma := true
7786   in
7787   (match handle with
7788    | None -> ()
7789    | Some handle -> pr "%s" handle; comma := true
7790   );
7791   List.iter (
7792     fun arg ->
7793       next ();
7794       pr "%s" (name_of_argt arg)
7795   ) (snd style);
7796   (* For RBufferOut calls, add implicit &size parameter. *)
7797   if not decl then (
7798     match fst style with
7799     | RBufferOut _ ->
7800         next ();
7801         pr "&size"
7802     | _ -> ()
7803   );
7804   pr ")"
7805
7806 (* Generate the OCaml bindings interface. *)
7807 and generate_ocaml_mli () =
7808   generate_header OCamlStyle LGPLv2plus;
7809
7810   pr "\
7811 (** For API documentation you should refer to the C API
7812     in the guestfs(3) manual page.  The OCaml API uses almost
7813     exactly the same calls. *)
7814
7815 type t
7816 (** A [guestfs_h] handle. *)
7817
7818 exception Error of string
7819 (** This exception is raised when there is an error. *)
7820
7821 exception Handle_closed of string
7822 (** This exception is raised if you use a {!Guestfs.t} handle
7823     after calling {!close} on it.  The string is the name of
7824     the function. *)
7825
7826 val create : unit -> t
7827 (** Create a {!Guestfs.t} handle. *)
7828
7829 val close : t -> unit
7830 (** Close the {!Guestfs.t} handle and free up all resources used
7831     by it immediately.
7832
7833     Handles are closed by the garbage collector when they become
7834     unreferenced, but callers can call this in order to provide
7835     predictable cleanup. *)
7836
7837 ";
7838   generate_ocaml_structure_decls ();
7839
7840   (* The actions. *)
7841   List.iter (
7842     fun (name, style, _, _, _, shortdesc, _) ->
7843       generate_ocaml_prototype name style;
7844       pr "(** %s *)\n" shortdesc;
7845       pr "\n"
7846   ) all_functions_sorted
7847
7848 (* Generate the OCaml bindings implementation. *)
7849 and generate_ocaml_ml () =
7850   generate_header OCamlStyle LGPLv2plus;
7851
7852   pr "\
7853 type t
7854
7855 exception Error of string
7856 exception Handle_closed of string
7857
7858 external create : unit -> t = \"ocaml_guestfs_create\"
7859 external close : t -> unit = \"ocaml_guestfs_close\"
7860
7861 (* Give the exceptions names, so they can be raised from the C code. *)
7862 let () =
7863   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7864   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7865
7866 ";
7867
7868   generate_ocaml_structure_decls ();
7869
7870   (* The actions. *)
7871   List.iter (
7872     fun (name, style, _, _, _, shortdesc, _) ->
7873       generate_ocaml_prototype ~is_external:true name style;
7874   ) all_functions_sorted
7875
7876 (* Generate the OCaml bindings C implementation. *)
7877 and generate_ocaml_c () =
7878   generate_header CStyle LGPLv2plus;
7879
7880   pr "\
7881 #include <stdio.h>
7882 #include <stdlib.h>
7883 #include <string.h>
7884
7885 #include <caml/config.h>
7886 #include <caml/alloc.h>
7887 #include <caml/callback.h>
7888 #include <caml/fail.h>
7889 #include <caml/memory.h>
7890 #include <caml/mlvalues.h>
7891 #include <caml/signals.h>
7892
7893 #include <guestfs.h>
7894
7895 #include \"guestfs_c.h\"
7896
7897 /* Copy a hashtable of string pairs into an assoc-list.  We return
7898  * the list in reverse order, but hashtables aren't supposed to be
7899  * ordered anyway.
7900  */
7901 static CAMLprim value
7902 copy_table (char * const * argv)
7903 {
7904   CAMLparam0 ();
7905   CAMLlocal5 (rv, pairv, kv, vv, cons);
7906   int i;
7907
7908   rv = Val_int (0);
7909   for (i = 0; argv[i] != NULL; i += 2) {
7910     kv = caml_copy_string (argv[i]);
7911     vv = caml_copy_string (argv[i+1]);
7912     pairv = caml_alloc (2, 0);
7913     Store_field (pairv, 0, kv);
7914     Store_field (pairv, 1, vv);
7915     cons = caml_alloc (2, 0);
7916     Store_field (cons, 1, rv);
7917     rv = cons;
7918     Store_field (cons, 0, pairv);
7919   }
7920
7921   CAMLreturn (rv);
7922 }
7923
7924 ";
7925
7926   (* Struct copy functions. *)
7927
7928   let emit_ocaml_copy_list_function typ =
7929     pr "static CAMLprim value\n";
7930     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7931     pr "{\n";
7932     pr "  CAMLparam0 ();\n";
7933     pr "  CAMLlocal2 (rv, v);\n";
7934     pr "  unsigned int i;\n";
7935     pr "\n";
7936     pr "  if (%ss->len == 0)\n" typ;
7937     pr "    CAMLreturn (Atom (0));\n";
7938     pr "  else {\n";
7939     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7940     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7941     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7942     pr "      caml_modify (&Field (rv, i), v);\n";
7943     pr "    }\n";
7944     pr "    CAMLreturn (rv);\n";
7945     pr "  }\n";
7946     pr "}\n";
7947     pr "\n";
7948   in
7949
7950   List.iter (
7951     fun (typ, cols) ->
7952       let has_optpercent_col =
7953         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7954
7955       pr "static CAMLprim value\n";
7956       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7957       pr "{\n";
7958       pr "  CAMLparam0 ();\n";
7959       if has_optpercent_col then
7960         pr "  CAMLlocal3 (rv, v, v2);\n"
7961       else
7962         pr "  CAMLlocal2 (rv, v);\n";
7963       pr "\n";
7964       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7965       iteri (
7966         fun i col ->
7967           (match col with
7968            | name, FString ->
7969                pr "  v = caml_copy_string (%s->%s);\n" typ name
7970            | name, FBuffer ->
7971                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
7972                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
7973                  typ name typ name
7974            | name, FUUID ->
7975                pr "  v = caml_alloc_string (32);\n";
7976                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
7977            | name, (FBytes|FInt64|FUInt64) ->
7978                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
7979            | name, (FInt32|FUInt32) ->
7980                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
7981            | name, FOptPercent ->
7982                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
7983                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
7984                pr "    v = caml_alloc (1, 0);\n";
7985                pr "    Store_field (v, 0, v2);\n";
7986                pr "  } else /* None */\n";
7987                pr "    v = Val_int (0);\n";
7988            | name, FChar ->
7989                pr "  v = Val_int (%s->%s);\n" typ name
7990           );
7991           pr "  Store_field (rv, %d, v);\n" i
7992       ) cols;
7993       pr "  CAMLreturn (rv);\n";
7994       pr "}\n";
7995       pr "\n";
7996   ) structs;
7997
7998   (* Emit a copy_TYPE_list function definition only if that function is used. *)
7999   List.iter (
8000     function
8001     | typ, (RStructListOnly | RStructAndList) ->
8002         (* generate the function for typ *)
8003         emit_ocaml_copy_list_function typ
8004     | typ, _ -> () (* empty *)
8005   ) (rstructs_used_by all_functions);
8006
8007   (* The wrappers. *)
8008   List.iter (
8009     fun (name, style, _, _, _, _, _) ->
8010       pr "/* Automatically generated wrapper for function\n";
8011       pr " * ";
8012       generate_ocaml_prototype name style;
8013       pr " */\n";
8014       pr "\n";
8015
8016       let params =
8017         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8018
8019       let needs_extra_vs =
8020         match fst style with RConstOptString _ -> true | _ -> false in
8021
8022       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8023       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8024       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8025       pr "\n";
8026
8027       pr "CAMLprim value\n";
8028       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8029       List.iter (pr ", value %s") (List.tl params);
8030       pr ")\n";
8031       pr "{\n";
8032
8033       (match params with
8034        | [p1; p2; p3; p4; p5] ->
8035            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8036        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8037            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8038            pr "  CAMLxparam%d (%s);\n"
8039              (List.length rest) (String.concat ", " rest)
8040        | ps ->
8041            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8042       );
8043       if not needs_extra_vs then
8044         pr "  CAMLlocal1 (rv);\n"
8045       else
8046         pr "  CAMLlocal3 (rv, v, v2);\n";
8047       pr "\n";
8048
8049       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8050       pr "  if (g == NULL)\n";
8051       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8052       pr "\n";
8053
8054       List.iter (
8055         function
8056         | Pathname n
8057         | Device n | Dev_or_Path n
8058         | String n
8059         | FileIn n
8060         | FileOut n ->
8061             pr "  const char *%s = String_val (%sv);\n" n n
8062         | OptString n ->
8063             pr "  const char *%s =\n" n;
8064             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
8065               n n
8066         | StringList n | DeviceList n ->
8067             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8068         | Bool n ->
8069             pr "  int %s = Bool_val (%sv);\n" n n
8070         | Int n ->
8071             pr "  int %s = Int_val (%sv);\n" n n
8072         | Int64 n ->
8073             pr "  int64_t %s = Int64_val (%sv);\n" n n
8074       ) (snd style);
8075       let error_code =
8076         match fst style with
8077         | RErr -> pr "  int r;\n"; "-1"
8078         | RInt _ -> pr "  int r;\n"; "-1"
8079         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8080         | RBool _ -> pr "  int r;\n"; "-1"
8081         | RConstString _ | RConstOptString _ ->
8082             pr "  const char *r;\n"; "NULL"
8083         | RString _ -> pr "  char *r;\n"; "NULL"
8084         | RStringList _ ->
8085             pr "  int i;\n";
8086             pr "  char **r;\n";
8087             "NULL"
8088         | RStruct (_, typ) ->
8089             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8090         | RStructList (_, typ) ->
8091             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8092         | RHashtable _ ->
8093             pr "  int i;\n";
8094             pr "  char **r;\n";
8095             "NULL"
8096         | RBufferOut _ ->
8097             pr "  char *r;\n";
8098             pr "  size_t size;\n";
8099             "NULL" in
8100       pr "\n";
8101
8102       pr "  caml_enter_blocking_section ();\n";
8103       pr "  r = guestfs_%s " name;
8104       generate_c_call_args ~handle:"g" style;
8105       pr ";\n";
8106       pr "  caml_leave_blocking_section ();\n";
8107
8108       List.iter (
8109         function
8110         | StringList n | DeviceList n ->
8111             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8112         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8113         | Bool _ | Int _ | Int64 _
8114         | FileIn _ | FileOut _ -> ()
8115       ) (snd style);
8116
8117       pr "  if (r == %s)\n" error_code;
8118       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8119       pr "\n";
8120
8121       (match fst style with
8122        | RErr -> pr "  rv = Val_unit;\n"
8123        | RInt _ -> pr "  rv = Val_int (r);\n"
8124        | RInt64 _ ->
8125            pr "  rv = caml_copy_int64 (r);\n"
8126        | RBool _ -> pr "  rv = Val_bool (r);\n"
8127        | RConstString _ ->
8128            pr "  rv = caml_copy_string (r);\n"
8129        | RConstOptString _ ->
8130            pr "  if (r) { /* Some string */\n";
8131            pr "    v = caml_alloc (1, 0);\n";
8132            pr "    v2 = caml_copy_string (r);\n";
8133            pr "    Store_field (v, 0, v2);\n";
8134            pr "  } else /* None */\n";
8135            pr "    v = Val_int (0);\n";
8136        | RString _ ->
8137            pr "  rv = caml_copy_string (r);\n";
8138            pr "  free (r);\n"
8139        | RStringList _ ->
8140            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8141            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8142            pr "  free (r);\n"
8143        | RStruct (_, typ) ->
8144            pr "  rv = copy_%s (r);\n" typ;
8145            pr "  guestfs_free_%s (r);\n" typ;
8146        | RStructList (_, typ) ->
8147            pr "  rv = copy_%s_list (r);\n" typ;
8148            pr "  guestfs_free_%s_list (r);\n" typ;
8149        | RHashtable _ ->
8150            pr "  rv = copy_table (r);\n";
8151            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8152            pr "  free (r);\n";
8153        | RBufferOut _ ->
8154            pr "  rv = caml_alloc_string (size);\n";
8155            pr "  memcpy (String_val (rv), r, size);\n";
8156       );
8157
8158       pr "  CAMLreturn (rv);\n";
8159       pr "}\n";
8160       pr "\n";
8161
8162       if List.length params > 5 then (
8163         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8164         pr "CAMLprim value ";
8165         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8166         pr "CAMLprim value\n";
8167         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8168         pr "{\n";
8169         pr "  return ocaml_guestfs_%s (argv[0]" name;
8170         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8171         pr ");\n";
8172         pr "}\n";
8173         pr "\n"
8174       )
8175   ) all_functions_sorted
8176
8177 and generate_ocaml_structure_decls () =
8178   List.iter (
8179     fun (typ, cols) ->
8180       pr "type %s = {\n" typ;
8181       List.iter (
8182         function
8183         | name, FString -> pr "  %s : string;\n" name
8184         | name, FBuffer -> pr "  %s : string;\n" name
8185         | name, FUUID -> pr "  %s : string;\n" name
8186         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8187         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8188         | name, FChar -> pr "  %s : char;\n" name
8189         | name, FOptPercent -> pr "  %s : float option;\n" name
8190       ) cols;
8191       pr "}\n";
8192       pr "\n"
8193   ) structs
8194
8195 and generate_ocaml_prototype ?(is_external = false) name style =
8196   if is_external then pr "external " else pr "val ";
8197   pr "%s : t -> " name;
8198   List.iter (
8199     function
8200     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8201     | OptString _ -> pr "string option -> "
8202     | StringList _ | DeviceList _ -> pr "string array -> "
8203     | Bool _ -> pr "bool -> "
8204     | Int _ -> pr "int -> "
8205     | Int64 _ -> pr "int64 -> "
8206   ) (snd style);
8207   (match fst style with
8208    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8209    | RInt _ -> pr "int"
8210    | RInt64 _ -> pr "int64"
8211    | RBool _ -> pr "bool"
8212    | RConstString _ -> pr "string"
8213    | RConstOptString _ -> pr "string option"
8214    | RString _ | RBufferOut _ -> pr "string"
8215    | RStringList _ -> pr "string array"
8216    | RStruct (_, typ) -> pr "%s" typ
8217    | RStructList (_, typ) -> pr "%s array" typ
8218    | RHashtable _ -> pr "(string * string) list"
8219   );
8220   if is_external then (
8221     pr " = ";
8222     if List.length (snd style) + 1 > 5 then
8223       pr "\"ocaml_guestfs_%s_byte\" " name;
8224     pr "\"ocaml_guestfs_%s\"" name
8225   );
8226   pr "\n"
8227
8228 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8229 and generate_perl_xs () =
8230   generate_header CStyle LGPLv2plus;
8231
8232   pr "\
8233 #include \"EXTERN.h\"
8234 #include \"perl.h\"
8235 #include \"XSUB.h\"
8236
8237 #include <guestfs.h>
8238
8239 #ifndef PRId64
8240 #define PRId64 \"lld\"
8241 #endif
8242
8243 static SV *
8244 my_newSVll(long long val) {
8245 #ifdef USE_64_BIT_ALL
8246   return newSViv(val);
8247 #else
8248   char buf[100];
8249   int len;
8250   len = snprintf(buf, 100, \"%%\" PRId64, val);
8251   return newSVpv(buf, len);
8252 #endif
8253 }
8254
8255 #ifndef PRIu64
8256 #define PRIu64 \"llu\"
8257 #endif
8258
8259 static SV *
8260 my_newSVull(unsigned long long val) {
8261 #ifdef USE_64_BIT_ALL
8262   return newSVuv(val);
8263 #else
8264   char buf[100];
8265   int len;
8266   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8267   return newSVpv(buf, len);
8268 #endif
8269 }
8270
8271 /* http://www.perlmonks.org/?node_id=680842 */
8272 static char **
8273 XS_unpack_charPtrPtr (SV *arg) {
8274   char **ret;
8275   AV *av;
8276   I32 i;
8277
8278   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8279     croak (\"array reference expected\");
8280
8281   av = (AV *)SvRV (arg);
8282   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8283   if (!ret)
8284     croak (\"malloc failed\");
8285
8286   for (i = 0; i <= av_len (av); i++) {
8287     SV **elem = av_fetch (av, i, 0);
8288
8289     if (!elem || !*elem)
8290       croak (\"missing element in list\");
8291
8292     ret[i] = SvPV_nolen (*elem);
8293   }
8294
8295   ret[i] = NULL;
8296
8297   return ret;
8298 }
8299
8300 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8301
8302 PROTOTYPES: ENABLE
8303
8304 guestfs_h *
8305 _create ()
8306    CODE:
8307       RETVAL = guestfs_create ();
8308       if (!RETVAL)
8309         croak (\"could not create guestfs handle\");
8310       guestfs_set_error_handler (RETVAL, NULL, NULL);
8311  OUTPUT:
8312       RETVAL
8313
8314 void
8315 DESTROY (g)
8316       guestfs_h *g;
8317  PPCODE:
8318       guestfs_close (g);
8319
8320 ";
8321
8322   List.iter (
8323     fun (name, style, _, _, _, _, _) ->
8324       (match fst style with
8325        | RErr -> pr "void\n"
8326        | RInt _ -> pr "SV *\n"
8327        | RInt64 _ -> pr "SV *\n"
8328        | RBool _ -> pr "SV *\n"
8329        | RConstString _ -> pr "SV *\n"
8330        | RConstOptString _ -> pr "SV *\n"
8331        | RString _ -> pr "SV *\n"
8332        | RBufferOut _ -> pr "SV *\n"
8333        | RStringList _
8334        | RStruct _ | RStructList _
8335        | RHashtable _ ->
8336            pr "void\n" (* all lists returned implictly on the stack *)
8337       );
8338       (* Call and arguments. *)
8339       pr "%s " name;
8340       generate_c_call_args ~handle:"g" ~decl:true style;
8341       pr "\n";
8342       pr "      guestfs_h *g;\n";
8343       iteri (
8344         fun i ->
8345           function
8346           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8347               pr "      char *%s;\n" n
8348           | OptString n ->
8349               (* http://www.perlmonks.org/?node_id=554277
8350                * Note that the implicit handle argument means we have
8351                * to add 1 to the ST(x) operator.
8352                *)
8353               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8354           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8355           | Bool n -> pr "      int %s;\n" n
8356           | Int n -> pr "      int %s;\n" n
8357           | Int64 n -> pr "      int64_t %s;\n" n
8358       ) (snd style);
8359
8360       let do_cleanups () =
8361         List.iter (
8362           function
8363           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8364           | Bool _ | Int _ | Int64 _
8365           | FileIn _ | FileOut _ -> ()
8366           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8367         ) (snd style)
8368       in
8369
8370       (* Code. *)
8371       (match fst style with
8372        | RErr ->
8373            pr "PREINIT:\n";
8374            pr "      int r;\n";
8375            pr " PPCODE:\n";
8376            pr "      r = guestfs_%s " name;
8377            generate_c_call_args ~handle:"g" style;
8378            pr ";\n";
8379            do_cleanups ();
8380            pr "      if (r == -1)\n";
8381            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8382        | RInt n
8383        | RBool n ->
8384            pr "PREINIT:\n";
8385            pr "      int %s;\n" n;
8386            pr "   CODE:\n";
8387            pr "      %s = guestfs_%s " n name;
8388            generate_c_call_args ~handle:"g" style;
8389            pr ";\n";
8390            do_cleanups ();
8391            pr "      if (%s == -1)\n" n;
8392            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8393            pr "      RETVAL = newSViv (%s);\n" n;
8394            pr " OUTPUT:\n";
8395            pr "      RETVAL\n"
8396        | RInt64 n ->
8397            pr "PREINIT:\n";
8398            pr "      int64_t %s;\n" n;
8399            pr "   CODE:\n";
8400            pr "      %s = guestfs_%s " n name;
8401            generate_c_call_args ~handle:"g" style;
8402            pr ";\n";
8403            do_cleanups ();
8404            pr "      if (%s == -1)\n" n;
8405            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8406            pr "      RETVAL = my_newSVll (%s);\n" n;
8407            pr " OUTPUT:\n";
8408            pr "      RETVAL\n"
8409        | RConstString n ->
8410            pr "PREINIT:\n";
8411            pr "      const char *%s;\n" n;
8412            pr "   CODE:\n";
8413            pr "      %s = guestfs_%s " n name;
8414            generate_c_call_args ~handle:"g" style;
8415            pr ";\n";
8416            do_cleanups ();
8417            pr "      if (%s == NULL)\n" n;
8418            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8419            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8420            pr " OUTPUT:\n";
8421            pr "      RETVAL\n"
8422        | RConstOptString n ->
8423            pr "PREINIT:\n";
8424            pr "      const char *%s;\n" n;
8425            pr "   CODE:\n";
8426            pr "      %s = guestfs_%s " n name;
8427            generate_c_call_args ~handle:"g" style;
8428            pr ";\n";
8429            do_cleanups ();
8430            pr "      if (%s == NULL)\n" n;
8431            pr "        RETVAL = &PL_sv_undef;\n";
8432            pr "      else\n";
8433            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8434            pr " OUTPUT:\n";
8435            pr "      RETVAL\n"
8436        | RString n ->
8437            pr "PREINIT:\n";
8438            pr "      char *%s;\n" n;
8439            pr "   CODE:\n";
8440            pr "      %s = guestfs_%s " n name;
8441            generate_c_call_args ~handle:"g" style;
8442            pr ";\n";
8443            do_cleanups ();
8444            pr "      if (%s == NULL)\n" n;
8445            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8446            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8447            pr "      free (%s);\n" n;
8448            pr " OUTPUT:\n";
8449            pr "      RETVAL\n"
8450        | RStringList n | RHashtable n ->
8451            pr "PREINIT:\n";
8452            pr "      char **%s;\n" n;
8453            pr "      int i, n;\n";
8454            pr " PPCODE:\n";
8455            pr "      %s = guestfs_%s " n name;
8456            generate_c_call_args ~handle:"g" style;
8457            pr ";\n";
8458            do_cleanups ();
8459            pr "      if (%s == NULL)\n" n;
8460            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8461            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8462            pr "      EXTEND (SP, n);\n";
8463            pr "      for (i = 0; i < n; ++i) {\n";
8464            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8465            pr "        free (%s[i]);\n" n;
8466            pr "      }\n";
8467            pr "      free (%s);\n" n;
8468        | RStruct (n, typ) ->
8469            let cols = cols_of_struct typ in
8470            generate_perl_struct_code typ cols name style n do_cleanups
8471        | RStructList (n, typ) ->
8472            let cols = cols_of_struct typ in
8473            generate_perl_struct_list_code typ cols name style n do_cleanups
8474        | RBufferOut n ->
8475            pr "PREINIT:\n";
8476            pr "      char *%s;\n" n;
8477            pr "      size_t size;\n";
8478            pr "   CODE:\n";
8479            pr "      %s = guestfs_%s " n name;
8480            generate_c_call_args ~handle:"g" style;
8481            pr ";\n";
8482            do_cleanups ();
8483            pr "      if (%s == NULL)\n" n;
8484            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8485            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8486            pr "      free (%s);\n" n;
8487            pr " OUTPUT:\n";
8488            pr "      RETVAL\n"
8489       );
8490
8491       pr "\n"
8492   ) all_functions
8493
8494 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8495   pr "PREINIT:\n";
8496   pr "      struct guestfs_%s_list *%s;\n" typ n;
8497   pr "      int i;\n";
8498   pr "      HV *hv;\n";
8499   pr " PPCODE:\n";
8500   pr "      %s = guestfs_%s " n name;
8501   generate_c_call_args ~handle:"g" style;
8502   pr ";\n";
8503   do_cleanups ();
8504   pr "      if (%s == NULL)\n" n;
8505   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8506   pr "      EXTEND (SP, %s->len);\n" n;
8507   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8508   pr "        hv = newHV ();\n";
8509   List.iter (
8510     function
8511     | name, FString ->
8512         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8513           name (String.length name) n name
8514     | name, FUUID ->
8515         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8516           name (String.length name) n name
8517     | name, FBuffer ->
8518         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8519           name (String.length name) n name n name
8520     | name, (FBytes|FUInt64) ->
8521         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8522           name (String.length name) n name
8523     | name, FInt64 ->
8524         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8525           name (String.length name) n name
8526     | name, (FInt32|FUInt32) ->
8527         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8528           name (String.length name) n name
8529     | name, FChar ->
8530         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8531           name (String.length name) n name
8532     | name, FOptPercent ->
8533         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8534           name (String.length name) n name
8535   ) cols;
8536   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8537   pr "      }\n";
8538   pr "      guestfs_free_%s_list (%s);\n" typ n
8539
8540 and generate_perl_struct_code typ cols name style n do_cleanups =
8541   pr "PREINIT:\n";
8542   pr "      struct guestfs_%s *%s;\n" typ n;
8543   pr " PPCODE:\n";
8544   pr "      %s = guestfs_%s " n name;
8545   generate_c_call_args ~handle:"g" style;
8546   pr ";\n";
8547   do_cleanups ();
8548   pr "      if (%s == NULL)\n" n;
8549   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8550   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8551   List.iter (
8552     fun ((name, _) as col) ->
8553       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8554
8555       match col with
8556       | name, FString ->
8557           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8558             n name
8559       | name, FBuffer ->
8560           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8561             n name n name
8562       | name, FUUID ->
8563           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8564             n name
8565       | name, (FBytes|FUInt64) ->
8566           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8567             n name
8568       | name, FInt64 ->
8569           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8570             n name
8571       | name, (FInt32|FUInt32) ->
8572           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8573             n name
8574       | name, FChar ->
8575           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8576             n name
8577       | name, FOptPercent ->
8578           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8579             n name
8580   ) cols;
8581   pr "      free (%s);\n" n
8582
8583 (* Generate Sys/Guestfs.pm. *)
8584 and generate_perl_pm () =
8585   generate_header HashStyle LGPLv2plus;
8586
8587   pr "\
8588 =pod
8589
8590 =head1 NAME
8591
8592 Sys::Guestfs - Perl bindings for libguestfs
8593
8594 =head1 SYNOPSIS
8595
8596  use Sys::Guestfs;
8597
8598  my $h = Sys::Guestfs->new ();
8599  $h->add_drive ('guest.img');
8600  $h->launch ();
8601  $h->mount ('/dev/sda1', '/');
8602  $h->touch ('/hello');
8603  $h->sync ();
8604
8605 =head1 DESCRIPTION
8606
8607 The C<Sys::Guestfs> module provides a Perl XS binding to the
8608 libguestfs API for examining and modifying virtual machine
8609 disk images.
8610
8611 Amongst the things this is good for: making batch configuration
8612 changes to guests, getting disk used/free statistics (see also:
8613 virt-df), migrating between virtualization systems (see also:
8614 virt-p2v), performing partial backups, performing partial guest
8615 clones, cloning guests and changing registry/UUID/hostname info, and
8616 much else besides.
8617
8618 Libguestfs uses Linux kernel and qemu code, and can access any type of
8619 guest filesystem that Linux and qemu can, including but not limited
8620 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8621 schemes, qcow, qcow2, vmdk.
8622
8623 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8624 LVs, what filesystem is in each LV, etc.).  It can also run commands
8625 in the context of the guest.  Also you can access filesystems over
8626 FUSE.
8627
8628 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8629 functions for using libguestfs from Perl, including integration
8630 with libvirt.
8631
8632 =head1 ERRORS
8633
8634 All errors turn into calls to C<croak> (see L<Carp(3)>).
8635
8636 =head1 METHODS
8637
8638 =over 4
8639
8640 =cut
8641
8642 package Sys::Guestfs;
8643
8644 use strict;
8645 use warnings;
8646
8647 require XSLoader;
8648 XSLoader::load ('Sys::Guestfs');
8649
8650 =item $h = Sys::Guestfs->new ();
8651
8652 Create a new guestfs handle.
8653
8654 =cut
8655
8656 sub new {
8657   my $proto = shift;
8658   my $class = ref ($proto) || $proto;
8659
8660   my $self = Sys::Guestfs::_create ();
8661   bless $self, $class;
8662   return $self;
8663 }
8664
8665 ";
8666
8667   (* Actions.  We only need to print documentation for these as
8668    * they are pulled in from the XS code automatically.
8669    *)
8670   List.iter (
8671     fun (name, style, _, flags, _, _, longdesc) ->
8672       if not (List.mem NotInDocs flags) then (
8673         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8674         pr "=item ";
8675         generate_perl_prototype name style;
8676         pr "\n\n";
8677         pr "%s\n\n" longdesc;
8678         if List.mem ProtocolLimitWarning flags then
8679           pr "%s\n\n" protocol_limit_warning;
8680         if List.mem DangerWillRobinson flags then
8681           pr "%s\n\n" danger_will_robinson;
8682         match deprecation_notice flags with
8683         | None -> ()
8684         | Some txt -> pr "%s\n\n" txt
8685       )
8686   ) all_functions_sorted;
8687
8688   (* End of file. *)
8689   pr "\
8690 =cut
8691
8692 1;
8693
8694 =back
8695
8696 =head1 COPYRIGHT
8697
8698 Copyright (C) %s Red Hat Inc.
8699
8700 =head1 LICENSE
8701
8702 Please see the file COPYING.LIB for the full license.
8703
8704 =head1 SEE ALSO
8705
8706 L<guestfs(3)>,
8707 L<guestfish(1)>,
8708 L<http://libguestfs.org>,
8709 L<Sys::Guestfs::Lib(3)>.
8710
8711 =cut
8712 " copyright_years
8713
8714 and generate_perl_prototype name style =
8715   (match fst style with
8716    | RErr -> ()
8717    | RBool n
8718    | RInt n
8719    | RInt64 n
8720    | RConstString n
8721    | RConstOptString n
8722    | RString n
8723    | RBufferOut n -> pr "$%s = " n
8724    | RStruct (n,_)
8725    | RHashtable n -> pr "%%%s = " n
8726    | RStringList n
8727    | RStructList (n,_) -> pr "@%s = " n
8728   );
8729   pr "$h->%s (" name;
8730   let comma = ref false in
8731   List.iter (
8732     fun arg ->
8733       if !comma then pr ", ";
8734       comma := true;
8735       match arg with
8736       | Pathname n | Device n | Dev_or_Path n | String n
8737       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8738           pr "$%s" n
8739       | StringList n | DeviceList n ->
8740           pr "\\@%s" n
8741   ) (snd style);
8742   pr ");"
8743
8744 (* Generate Python C module. *)
8745 and generate_python_c () =
8746   generate_header CStyle LGPLv2plus;
8747
8748   pr "\
8749 #include <Python.h>
8750
8751 #include <stdio.h>
8752 #include <stdlib.h>
8753 #include <assert.h>
8754
8755 #include \"guestfs.h\"
8756
8757 typedef struct {
8758   PyObject_HEAD
8759   guestfs_h *g;
8760 } Pyguestfs_Object;
8761
8762 static guestfs_h *
8763 get_handle (PyObject *obj)
8764 {
8765   assert (obj);
8766   assert (obj != Py_None);
8767   return ((Pyguestfs_Object *) obj)->g;
8768 }
8769
8770 static PyObject *
8771 put_handle (guestfs_h *g)
8772 {
8773   assert (g);
8774   return
8775     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8776 }
8777
8778 /* This list should be freed (but not the strings) after use. */
8779 static char **
8780 get_string_list (PyObject *obj)
8781 {
8782   int i, len;
8783   char **r;
8784
8785   assert (obj);
8786
8787   if (!PyList_Check (obj)) {
8788     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8789     return NULL;
8790   }
8791
8792   len = PyList_Size (obj);
8793   r = malloc (sizeof (char *) * (len+1));
8794   if (r == NULL) {
8795     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8796     return NULL;
8797   }
8798
8799   for (i = 0; i < len; ++i)
8800     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8801   r[len] = NULL;
8802
8803   return r;
8804 }
8805
8806 static PyObject *
8807 put_string_list (char * const * const argv)
8808 {
8809   PyObject *list;
8810   int argc, i;
8811
8812   for (argc = 0; argv[argc] != NULL; ++argc)
8813     ;
8814
8815   list = PyList_New (argc);
8816   for (i = 0; i < argc; ++i)
8817     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8818
8819   return list;
8820 }
8821
8822 static PyObject *
8823 put_table (char * const * const argv)
8824 {
8825   PyObject *list, *item;
8826   int argc, i;
8827
8828   for (argc = 0; argv[argc] != NULL; ++argc)
8829     ;
8830
8831   list = PyList_New (argc >> 1);
8832   for (i = 0; i < argc; i += 2) {
8833     item = PyTuple_New (2);
8834     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8835     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8836     PyList_SetItem (list, i >> 1, item);
8837   }
8838
8839   return list;
8840 }
8841
8842 static void
8843 free_strings (char **argv)
8844 {
8845   int argc;
8846
8847   for (argc = 0; argv[argc] != NULL; ++argc)
8848     free (argv[argc]);
8849   free (argv);
8850 }
8851
8852 static PyObject *
8853 py_guestfs_create (PyObject *self, PyObject *args)
8854 {
8855   guestfs_h *g;
8856
8857   g = guestfs_create ();
8858   if (g == NULL) {
8859     PyErr_SetString (PyExc_RuntimeError,
8860                      \"guestfs.create: failed to allocate handle\");
8861     return NULL;
8862   }
8863   guestfs_set_error_handler (g, NULL, NULL);
8864   return put_handle (g);
8865 }
8866
8867 static PyObject *
8868 py_guestfs_close (PyObject *self, PyObject *args)
8869 {
8870   PyObject *py_g;
8871   guestfs_h *g;
8872
8873   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8874     return NULL;
8875   g = get_handle (py_g);
8876
8877   guestfs_close (g);
8878
8879   Py_INCREF (Py_None);
8880   return Py_None;
8881 }
8882
8883 ";
8884
8885   let emit_put_list_function typ =
8886     pr "static PyObject *\n";
8887     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8888     pr "{\n";
8889     pr "  PyObject *list;\n";
8890     pr "  int i;\n";
8891     pr "\n";
8892     pr "  list = PyList_New (%ss->len);\n" typ;
8893     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8894     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8895     pr "  return list;\n";
8896     pr "};\n";
8897     pr "\n"
8898   in
8899
8900   (* Structures, turned into Python dictionaries. *)
8901   List.iter (
8902     fun (typ, cols) ->
8903       pr "static PyObject *\n";
8904       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8905       pr "{\n";
8906       pr "  PyObject *dict;\n";
8907       pr "\n";
8908       pr "  dict = PyDict_New ();\n";
8909       List.iter (
8910         function
8911         | name, FString ->
8912             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8913             pr "                        PyString_FromString (%s->%s));\n"
8914               typ name
8915         | name, FBuffer ->
8916             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8917             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8918               typ name typ name
8919         | name, FUUID ->
8920             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8921             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8922               typ name
8923         | name, (FBytes|FUInt64) ->
8924             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8925             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8926               typ name
8927         | name, FInt64 ->
8928             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8929             pr "                        PyLong_FromLongLong (%s->%s));\n"
8930               typ name
8931         | name, FUInt32 ->
8932             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8933             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8934               typ name
8935         | name, FInt32 ->
8936             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8937             pr "                        PyLong_FromLong (%s->%s));\n"
8938               typ name
8939         | name, FOptPercent ->
8940             pr "  if (%s->%s >= 0)\n" typ name;
8941             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8942             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8943               typ name;
8944             pr "  else {\n";
8945             pr "    Py_INCREF (Py_None);\n";
8946             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8947             pr "  }\n"
8948         | name, FChar ->
8949             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8950             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8951       ) cols;
8952       pr "  return dict;\n";
8953       pr "};\n";
8954       pr "\n";
8955
8956   ) structs;
8957
8958   (* Emit a put_TYPE_list function definition only if that function is used. *)
8959   List.iter (
8960     function
8961     | typ, (RStructListOnly | RStructAndList) ->
8962         (* generate the function for typ *)
8963         emit_put_list_function typ
8964     | typ, _ -> () (* empty *)
8965   ) (rstructs_used_by all_functions);
8966
8967   (* Python wrapper functions. *)
8968   List.iter (
8969     fun (name, style, _, _, _, _, _) ->
8970       pr "static PyObject *\n";
8971       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
8972       pr "{\n";
8973
8974       pr "  PyObject *py_g;\n";
8975       pr "  guestfs_h *g;\n";
8976       pr "  PyObject *py_r;\n";
8977
8978       let error_code =
8979         match fst style with
8980         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
8981         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8982         | RConstString _ | RConstOptString _ ->
8983             pr "  const char *r;\n"; "NULL"
8984         | RString _ -> pr "  char *r;\n"; "NULL"
8985         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
8986         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
8987         | RStructList (_, typ) ->
8988             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8989         | RBufferOut _ ->
8990             pr "  char *r;\n";
8991             pr "  size_t size;\n";
8992             "NULL" in
8993
8994       List.iter (
8995         function
8996         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8997             pr "  const char *%s;\n" n
8998         | OptString n -> pr "  const char *%s;\n" n
8999         | StringList n | DeviceList n ->
9000             pr "  PyObject *py_%s;\n" n;
9001             pr "  char **%s;\n" n
9002         | Bool n -> pr "  int %s;\n" n
9003         | Int n -> pr "  int %s;\n" n
9004         | Int64 n -> pr "  long long %s;\n" n
9005       ) (snd style);
9006
9007       pr "\n";
9008
9009       (* Convert the parameters. *)
9010       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9011       List.iter (
9012         function
9013         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9014         | OptString _ -> pr "z"
9015         | StringList _ | DeviceList _ -> pr "O"
9016         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9017         | Int _ -> pr "i"
9018         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9019                              * emulate C's int/long/long long in Python?
9020                              *)
9021       ) (snd style);
9022       pr ":guestfs_%s\",\n" name;
9023       pr "                         &py_g";
9024       List.iter (
9025         function
9026         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9027         | OptString n -> pr ", &%s" n
9028         | StringList n | DeviceList n -> pr ", &py_%s" n
9029         | Bool n -> pr ", &%s" n
9030         | Int n -> pr ", &%s" n
9031         | Int64 n -> pr ", &%s" n
9032       ) (snd style);
9033
9034       pr "))\n";
9035       pr "    return NULL;\n";
9036
9037       pr "  g = get_handle (py_g);\n";
9038       List.iter (
9039         function
9040         | Pathname _ | Device _ | Dev_or_Path _ | String _
9041         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9042         | StringList n | DeviceList n ->
9043             pr "  %s = get_string_list (py_%s);\n" n n;
9044             pr "  if (!%s) return NULL;\n" n
9045       ) (snd style);
9046
9047       pr "\n";
9048
9049       pr "  r = guestfs_%s " name;
9050       generate_c_call_args ~handle:"g" style;
9051       pr ";\n";
9052
9053       List.iter (
9054         function
9055         | Pathname _ | Device _ | Dev_or_Path _ | String _
9056         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9057         | StringList n | DeviceList n ->
9058             pr "  free (%s);\n" n
9059       ) (snd style);
9060
9061       pr "  if (r == %s) {\n" error_code;
9062       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9063       pr "    return NULL;\n";
9064       pr "  }\n";
9065       pr "\n";
9066
9067       (match fst style with
9068        | RErr ->
9069            pr "  Py_INCREF (Py_None);\n";
9070            pr "  py_r = Py_None;\n"
9071        | RInt _
9072        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9073        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9074        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9075        | RConstOptString _ ->
9076            pr "  if (r)\n";
9077            pr "    py_r = PyString_FromString (r);\n";
9078            pr "  else {\n";
9079            pr "    Py_INCREF (Py_None);\n";
9080            pr "    py_r = Py_None;\n";
9081            pr "  }\n"
9082        | RString _ ->
9083            pr "  py_r = PyString_FromString (r);\n";
9084            pr "  free (r);\n"
9085        | RStringList _ ->
9086            pr "  py_r = put_string_list (r);\n";
9087            pr "  free_strings (r);\n"
9088        | RStruct (_, typ) ->
9089            pr "  py_r = put_%s (r);\n" typ;
9090            pr "  guestfs_free_%s (r);\n" typ
9091        | RStructList (_, typ) ->
9092            pr "  py_r = put_%s_list (r);\n" typ;
9093            pr "  guestfs_free_%s_list (r);\n" typ
9094        | RHashtable n ->
9095            pr "  py_r = put_table (r);\n";
9096            pr "  free_strings (r);\n"
9097        | RBufferOut _ ->
9098            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9099            pr "  free (r);\n"
9100       );
9101
9102       pr "  return py_r;\n";
9103       pr "}\n";
9104       pr "\n"
9105   ) all_functions;
9106
9107   (* Table of functions. *)
9108   pr "static PyMethodDef methods[] = {\n";
9109   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9110   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9111   List.iter (
9112     fun (name, _, _, _, _, _, _) ->
9113       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9114         name name
9115   ) all_functions;
9116   pr "  { NULL, NULL, 0, NULL }\n";
9117   pr "};\n";
9118   pr "\n";
9119
9120   (* Init function. *)
9121   pr "\
9122 void
9123 initlibguestfsmod (void)
9124 {
9125   static int initialized = 0;
9126
9127   if (initialized) return;
9128   Py_InitModule ((char *) \"libguestfsmod\", methods);
9129   initialized = 1;
9130 }
9131 "
9132
9133 (* Generate Python module. *)
9134 and generate_python_py () =
9135   generate_header HashStyle LGPLv2plus;
9136
9137   pr "\
9138 u\"\"\"Python bindings for libguestfs
9139
9140 import guestfs
9141 g = guestfs.GuestFS ()
9142 g.add_drive (\"guest.img\")
9143 g.launch ()
9144 parts = g.list_partitions ()
9145
9146 The guestfs module provides a Python binding to the libguestfs API
9147 for examining and modifying virtual machine disk images.
9148
9149 Amongst the things this is good for: making batch configuration
9150 changes to guests, getting disk used/free statistics (see also:
9151 virt-df), migrating between virtualization systems (see also:
9152 virt-p2v), performing partial backups, performing partial guest
9153 clones, cloning guests and changing registry/UUID/hostname info, and
9154 much else besides.
9155
9156 Libguestfs uses Linux kernel and qemu code, and can access any type of
9157 guest filesystem that Linux and qemu can, including but not limited
9158 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9159 schemes, qcow, qcow2, vmdk.
9160
9161 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9162 LVs, what filesystem is in each LV, etc.).  It can also run commands
9163 in the context of the guest.  Also you can access filesystems over
9164 FUSE.
9165
9166 Errors which happen while using the API are turned into Python
9167 RuntimeError exceptions.
9168
9169 To create a guestfs handle you usually have to perform the following
9170 sequence of calls:
9171
9172 # Create the handle, call add_drive at least once, and possibly
9173 # several times if the guest has multiple block devices:
9174 g = guestfs.GuestFS ()
9175 g.add_drive (\"guest.img\")
9176
9177 # Launch the qemu subprocess and wait for it to become ready:
9178 g.launch ()
9179
9180 # Now you can issue commands, for example:
9181 logvols = g.lvs ()
9182
9183 \"\"\"
9184
9185 import libguestfsmod
9186
9187 class GuestFS:
9188     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9189
9190     def __init__ (self):
9191         \"\"\"Create a new libguestfs handle.\"\"\"
9192         self._o = libguestfsmod.create ()
9193
9194     def __del__ (self):
9195         libguestfsmod.close (self._o)
9196
9197 ";
9198
9199   List.iter (
9200     fun (name, style, _, flags, _, _, longdesc) ->
9201       pr "    def %s " name;
9202       generate_py_call_args ~handle:"self" (snd style);
9203       pr ":\n";
9204
9205       if not (List.mem NotInDocs flags) then (
9206         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9207         let doc =
9208           match fst style with
9209           | RErr | RInt _ | RInt64 _ | RBool _
9210           | RConstOptString _ | RConstString _
9211           | RString _ | RBufferOut _ -> doc
9212           | RStringList _ ->
9213               doc ^ "\n\nThis function returns a list of strings."
9214           | RStruct (_, typ) ->
9215               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9216           | RStructList (_, typ) ->
9217               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9218           | RHashtable _ ->
9219               doc ^ "\n\nThis function returns a dictionary." in
9220         let doc =
9221           if List.mem ProtocolLimitWarning flags then
9222             doc ^ "\n\n" ^ protocol_limit_warning
9223           else doc in
9224         let doc =
9225           if List.mem DangerWillRobinson flags then
9226             doc ^ "\n\n" ^ danger_will_robinson
9227           else doc in
9228         let doc =
9229           match deprecation_notice flags with
9230           | None -> doc
9231           | Some txt -> doc ^ "\n\n" ^ txt in
9232         let doc = pod2text ~width:60 name doc in
9233         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9234         let doc = String.concat "\n        " doc in
9235         pr "        u\"\"\"%s\"\"\"\n" doc;
9236       );
9237       pr "        return libguestfsmod.%s " name;
9238       generate_py_call_args ~handle:"self._o" (snd style);
9239       pr "\n";
9240       pr "\n";
9241   ) all_functions
9242
9243 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9244 and generate_py_call_args ~handle args =
9245   pr "(%s" handle;
9246   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9247   pr ")"
9248
9249 (* Useful if you need the longdesc POD text as plain text.  Returns a
9250  * list of lines.
9251  *
9252  * Because this is very slow (the slowest part of autogeneration),
9253  * we memoize the results.
9254  *)
9255 and pod2text ~width name longdesc =
9256   let key = width, name, longdesc in
9257   try Hashtbl.find pod2text_memo key
9258   with Not_found ->
9259     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9260     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9261     close_out chan;
9262     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9263     let chan = open_process_in cmd in
9264     let lines = ref [] in
9265     let rec loop i =
9266       let line = input_line chan in
9267       if i = 1 then             (* discard the first line of output *)
9268         loop (i+1)
9269       else (
9270         let line = triml line in
9271         lines := line :: !lines;
9272         loop (i+1)
9273       ) in
9274     let lines = try loop 1 with End_of_file -> List.rev !lines in
9275     unlink filename;
9276     (match close_process_in chan with
9277      | WEXITED 0 -> ()
9278      | WEXITED i ->
9279          failwithf "pod2text: process exited with non-zero status (%d)" i
9280      | WSIGNALED i | WSTOPPED i ->
9281          failwithf "pod2text: process signalled or stopped by signal %d" i
9282     );
9283     Hashtbl.add pod2text_memo key lines;
9284     pod2text_memo_updated ();
9285     lines
9286
9287 (* Generate ruby bindings. *)
9288 and generate_ruby_c () =
9289   generate_header CStyle LGPLv2plus;
9290
9291   pr "\
9292 #include <stdio.h>
9293 #include <stdlib.h>
9294
9295 #include <ruby.h>
9296
9297 #include \"guestfs.h\"
9298
9299 #include \"extconf.h\"
9300
9301 /* For Ruby < 1.9 */
9302 #ifndef RARRAY_LEN
9303 #define RARRAY_LEN(r) (RARRAY((r))->len)
9304 #endif
9305
9306 static VALUE m_guestfs;                 /* guestfs module */
9307 static VALUE c_guestfs;                 /* guestfs_h handle */
9308 static VALUE e_Error;                   /* used for all errors */
9309
9310 static void ruby_guestfs_free (void *p)
9311 {
9312   if (!p) return;
9313   guestfs_close ((guestfs_h *) p);
9314 }
9315
9316 static VALUE ruby_guestfs_create (VALUE m)
9317 {
9318   guestfs_h *g;
9319
9320   g = guestfs_create ();
9321   if (!g)
9322     rb_raise (e_Error, \"failed to create guestfs handle\");
9323
9324   /* Don't print error messages to stderr by default. */
9325   guestfs_set_error_handler (g, NULL, NULL);
9326
9327   /* Wrap it, and make sure the close function is called when the
9328    * handle goes away.
9329    */
9330   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9331 }
9332
9333 static VALUE ruby_guestfs_close (VALUE gv)
9334 {
9335   guestfs_h *g;
9336   Data_Get_Struct (gv, guestfs_h, g);
9337
9338   ruby_guestfs_free (g);
9339   DATA_PTR (gv) = NULL;
9340
9341   return Qnil;
9342 }
9343
9344 ";
9345
9346   List.iter (
9347     fun (name, style, _, _, _, _, _) ->
9348       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9349       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9350       pr ")\n";
9351       pr "{\n";
9352       pr "  guestfs_h *g;\n";
9353       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9354       pr "  if (!g)\n";
9355       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9356         name;
9357       pr "\n";
9358
9359       List.iter (
9360         function
9361         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9362             pr "  Check_Type (%sv, T_STRING);\n" n;
9363             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9364             pr "  if (!%s)\n" n;
9365             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9366             pr "              \"%s\", \"%s\");\n" n name
9367         | OptString n ->
9368             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9369         | StringList n | DeviceList n ->
9370             pr "  char **%s;\n" n;
9371             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9372             pr "  {\n";
9373             pr "    int i, len;\n";
9374             pr "    len = RARRAY_LEN (%sv);\n" n;
9375             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9376               n;
9377             pr "    for (i = 0; i < len; ++i) {\n";
9378             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9379             pr "      %s[i] = StringValueCStr (v);\n" n;
9380             pr "    }\n";
9381             pr "    %s[len] = NULL;\n" n;
9382             pr "  }\n";
9383         | Bool n ->
9384             pr "  int %s = RTEST (%sv);\n" n n
9385         | Int n ->
9386             pr "  int %s = NUM2INT (%sv);\n" n n
9387         | Int64 n ->
9388             pr "  long long %s = NUM2LL (%sv);\n" n n
9389       ) (snd style);
9390       pr "\n";
9391
9392       let error_code =
9393         match fst style with
9394         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9395         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9396         | RConstString _ | RConstOptString _ ->
9397             pr "  const char *r;\n"; "NULL"
9398         | RString _ -> pr "  char *r;\n"; "NULL"
9399         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9400         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9401         | RStructList (_, typ) ->
9402             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9403         | RBufferOut _ ->
9404             pr "  char *r;\n";
9405             pr "  size_t size;\n";
9406             "NULL" in
9407       pr "\n";
9408
9409       pr "  r = guestfs_%s " name;
9410       generate_c_call_args ~handle:"g" style;
9411       pr ";\n";
9412
9413       List.iter (
9414         function
9415         | Pathname _ | Device _ | Dev_or_Path _ | String _
9416         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9417         | StringList n | DeviceList n ->
9418             pr "  free (%s);\n" n
9419       ) (snd style);
9420
9421       pr "  if (r == %s)\n" error_code;
9422       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9423       pr "\n";
9424
9425       (match fst style with
9426        | RErr ->
9427            pr "  return Qnil;\n"
9428        | RInt _ | RBool _ ->
9429            pr "  return INT2NUM (r);\n"
9430        | RInt64 _ ->
9431            pr "  return ULL2NUM (r);\n"
9432        | RConstString _ ->
9433            pr "  return rb_str_new2 (r);\n";
9434        | RConstOptString _ ->
9435            pr "  if (r)\n";
9436            pr "    return rb_str_new2 (r);\n";
9437            pr "  else\n";
9438            pr "    return Qnil;\n";
9439        | RString _ ->
9440            pr "  VALUE rv = rb_str_new2 (r);\n";
9441            pr "  free (r);\n";
9442            pr "  return rv;\n";
9443        | RStringList _ ->
9444            pr "  int i, len = 0;\n";
9445            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9446            pr "  VALUE rv = rb_ary_new2 (len);\n";
9447            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9448            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9449            pr "    free (r[i]);\n";
9450            pr "  }\n";
9451            pr "  free (r);\n";
9452            pr "  return rv;\n"
9453        | RStruct (_, typ) ->
9454            let cols = cols_of_struct typ in
9455            generate_ruby_struct_code typ cols
9456        | RStructList (_, typ) ->
9457            let cols = cols_of_struct typ in
9458            generate_ruby_struct_list_code typ cols
9459        | RHashtable _ ->
9460            pr "  VALUE rv = rb_hash_new ();\n";
9461            pr "  int i;\n";
9462            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9463            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9464            pr "    free (r[i]);\n";
9465            pr "    free (r[i+1]);\n";
9466            pr "  }\n";
9467            pr "  free (r);\n";
9468            pr "  return rv;\n"
9469        | RBufferOut _ ->
9470            pr "  VALUE rv = rb_str_new (r, size);\n";
9471            pr "  free (r);\n";
9472            pr "  return rv;\n";
9473       );
9474
9475       pr "}\n";
9476       pr "\n"
9477   ) all_functions;
9478
9479   pr "\
9480 /* Initialize the module. */
9481 void Init__guestfs ()
9482 {
9483   m_guestfs = rb_define_module (\"Guestfs\");
9484   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9485   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9486
9487   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9488   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9489
9490 ";
9491   (* Define the rest of the methods. *)
9492   List.iter (
9493     fun (name, style, _, _, _, _, _) ->
9494       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9495       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9496   ) all_functions;
9497
9498   pr "}\n"
9499
9500 (* Ruby code to return a struct. *)
9501 and generate_ruby_struct_code typ cols =
9502   pr "  VALUE rv = rb_hash_new ();\n";
9503   List.iter (
9504     function
9505     | name, FString ->
9506         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9507     | name, FBuffer ->
9508         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9509     | name, FUUID ->
9510         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9511     | name, (FBytes|FUInt64) ->
9512         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9513     | name, FInt64 ->
9514         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9515     | name, FUInt32 ->
9516         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9517     | name, FInt32 ->
9518         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9519     | name, FOptPercent ->
9520         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9521     | name, FChar -> (* XXX wrong? *)
9522         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9523   ) cols;
9524   pr "  guestfs_free_%s (r);\n" typ;
9525   pr "  return rv;\n"
9526
9527 (* Ruby code to return a struct list. *)
9528 and generate_ruby_struct_list_code typ cols =
9529   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9530   pr "  int i;\n";
9531   pr "  for (i = 0; i < r->len; ++i) {\n";
9532   pr "    VALUE hv = rb_hash_new ();\n";
9533   List.iter (
9534     function
9535     | name, FString ->
9536         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9537     | name, FBuffer ->
9538         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
9539     | name, FUUID ->
9540         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9541     | name, (FBytes|FUInt64) ->
9542         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9543     | name, FInt64 ->
9544         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9545     | name, FUInt32 ->
9546         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9547     | name, FInt32 ->
9548         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9549     | name, FOptPercent ->
9550         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9551     | name, FChar -> (* XXX wrong? *)
9552         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9553   ) cols;
9554   pr "    rb_ary_push (rv, hv);\n";
9555   pr "  }\n";
9556   pr "  guestfs_free_%s_list (r);\n" typ;
9557   pr "  return rv;\n"
9558
9559 (* Generate Java bindings GuestFS.java file. *)
9560 and generate_java_java () =
9561   generate_header CStyle LGPLv2plus;
9562
9563   pr "\
9564 package com.redhat.et.libguestfs;
9565
9566 import java.util.HashMap;
9567 import com.redhat.et.libguestfs.LibGuestFSException;
9568 import com.redhat.et.libguestfs.PV;
9569 import com.redhat.et.libguestfs.VG;
9570 import com.redhat.et.libguestfs.LV;
9571 import com.redhat.et.libguestfs.Stat;
9572 import com.redhat.et.libguestfs.StatVFS;
9573 import com.redhat.et.libguestfs.IntBool;
9574 import com.redhat.et.libguestfs.Dirent;
9575
9576 /**
9577  * The GuestFS object is a libguestfs handle.
9578  *
9579  * @author rjones
9580  */
9581 public class GuestFS {
9582   // Load the native code.
9583   static {
9584     System.loadLibrary (\"guestfs_jni\");
9585   }
9586
9587   /**
9588    * The native guestfs_h pointer.
9589    */
9590   long g;
9591
9592   /**
9593    * Create a libguestfs handle.
9594    *
9595    * @throws LibGuestFSException
9596    */
9597   public GuestFS () throws LibGuestFSException
9598   {
9599     g = _create ();
9600   }
9601   private native long _create () throws LibGuestFSException;
9602
9603   /**
9604    * Close a libguestfs handle.
9605    *
9606    * You can also leave handles to be collected by the garbage
9607    * collector, but this method ensures that the resources used
9608    * by the handle are freed up immediately.  If you call any
9609    * other methods after closing the handle, you will get an
9610    * exception.
9611    *
9612    * @throws LibGuestFSException
9613    */
9614   public void close () throws LibGuestFSException
9615   {
9616     if (g != 0)
9617       _close (g);
9618     g = 0;
9619   }
9620   private native void _close (long g) throws LibGuestFSException;
9621
9622   public void finalize () throws LibGuestFSException
9623   {
9624     close ();
9625   }
9626
9627 ";
9628
9629   List.iter (
9630     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9631       if not (List.mem NotInDocs flags); then (
9632         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9633         let doc =
9634           if List.mem ProtocolLimitWarning flags then
9635             doc ^ "\n\n" ^ protocol_limit_warning
9636           else doc in
9637         let doc =
9638           if List.mem DangerWillRobinson flags then
9639             doc ^ "\n\n" ^ danger_will_robinson
9640           else doc in
9641         let doc =
9642           match deprecation_notice flags with
9643           | None -> doc
9644           | Some txt -> doc ^ "\n\n" ^ txt in
9645         let doc = pod2text ~width:60 name doc in
9646         let doc = List.map (            (* RHBZ#501883 *)
9647           function
9648           | "" -> "<p>"
9649           | nonempty -> nonempty
9650         ) doc in
9651         let doc = String.concat "\n   * " doc in
9652
9653         pr "  /**\n";
9654         pr "   * %s\n" shortdesc;
9655         pr "   * <p>\n";
9656         pr "   * %s\n" doc;
9657         pr "   * @throws LibGuestFSException\n";
9658         pr "   */\n";
9659         pr "  ";
9660       );
9661       generate_java_prototype ~public:true ~semicolon:false name style;
9662       pr "\n";
9663       pr "  {\n";
9664       pr "    if (g == 0)\n";
9665       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9666         name;
9667       pr "    ";
9668       if fst style <> RErr then pr "return ";
9669       pr "_%s " name;
9670       generate_java_call_args ~handle:"g" (snd style);
9671       pr ";\n";
9672       pr "  }\n";
9673       pr "  ";
9674       generate_java_prototype ~privat:true ~native:true name style;
9675       pr "\n";
9676       pr "\n";
9677   ) all_functions;
9678
9679   pr "}\n"
9680
9681 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9682 and generate_java_call_args ~handle args =
9683   pr "(%s" handle;
9684   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9685   pr ")"
9686
9687 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9688     ?(semicolon=true) name style =
9689   if privat then pr "private ";
9690   if public then pr "public ";
9691   if native then pr "native ";
9692
9693   (* return type *)
9694   (match fst style with
9695    | RErr -> pr "void ";
9696    | RInt _ -> pr "int ";
9697    | RInt64 _ -> pr "long ";
9698    | RBool _ -> pr "boolean ";
9699    | RConstString _ | RConstOptString _ | RString _
9700    | RBufferOut _ -> pr "String ";
9701    | RStringList _ -> pr "String[] ";
9702    | RStruct (_, typ) ->
9703        let name = java_name_of_struct typ in
9704        pr "%s " name;
9705    | RStructList (_, typ) ->
9706        let name = java_name_of_struct typ in
9707        pr "%s[] " name;
9708    | RHashtable _ -> pr "HashMap<String,String> ";
9709   );
9710
9711   if native then pr "_%s " name else pr "%s " name;
9712   pr "(";
9713   let needs_comma = ref false in
9714   if native then (
9715     pr "long g";
9716     needs_comma := true
9717   );
9718
9719   (* args *)
9720   List.iter (
9721     fun arg ->
9722       if !needs_comma then pr ", ";
9723       needs_comma := true;
9724
9725       match arg with
9726       | Pathname n
9727       | Device n | Dev_or_Path n
9728       | String n
9729       | OptString n
9730       | FileIn n
9731       | FileOut n ->
9732           pr "String %s" n
9733       | StringList n | DeviceList n ->
9734           pr "String[] %s" n
9735       | Bool n ->
9736           pr "boolean %s" n
9737       | Int n ->
9738           pr "int %s" n
9739       | Int64 n ->
9740           pr "long %s" n
9741   ) (snd style);
9742
9743   pr ")\n";
9744   pr "    throws LibGuestFSException";
9745   if semicolon then pr ";"
9746
9747 and generate_java_struct jtyp cols () =
9748   generate_header CStyle LGPLv2plus;
9749
9750   pr "\
9751 package com.redhat.et.libguestfs;
9752
9753 /**
9754  * Libguestfs %s structure.
9755  *
9756  * @author rjones
9757  * @see GuestFS
9758  */
9759 public class %s {
9760 " jtyp jtyp;
9761
9762   List.iter (
9763     function
9764     | name, FString
9765     | name, FUUID
9766     | name, FBuffer -> pr "  public String %s;\n" name
9767     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9768     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9769     | name, FChar -> pr "  public char %s;\n" name
9770     | name, FOptPercent ->
9771         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9772         pr "  public float %s;\n" name
9773   ) cols;
9774
9775   pr "}\n"
9776
9777 and generate_java_c () =
9778   generate_header CStyle LGPLv2plus;
9779
9780   pr "\
9781 #include <stdio.h>
9782 #include <stdlib.h>
9783 #include <string.h>
9784
9785 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9786 #include \"guestfs.h\"
9787
9788 /* Note that this function returns.  The exception is not thrown
9789  * until after the wrapper function returns.
9790  */
9791 static void
9792 throw_exception (JNIEnv *env, const char *msg)
9793 {
9794   jclass cl;
9795   cl = (*env)->FindClass (env,
9796                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9797   (*env)->ThrowNew (env, cl, msg);
9798 }
9799
9800 JNIEXPORT jlong JNICALL
9801 Java_com_redhat_et_libguestfs_GuestFS__1create
9802   (JNIEnv *env, jobject obj)
9803 {
9804   guestfs_h *g;
9805
9806   g = guestfs_create ();
9807   if (g == NULL) {
9808     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9809     return 0;
9810   }
9811   guestfs_set_error_handler (g, NULL, NULL);
9812   return (jlong) (long) g;
9813 }
9814
9815 JNIEXPORT void JNICALL
9816 Java_com_redhat_et_libguestfs_GuestFS__1close
9817   (JNIEnv *env, jobject obj, jlong jg)
9818 {
9819   guestfs_h *g = (guestfs_h *) (long) jg;
9820   guestfs_close (g);
9821 }
9822
9823 ";
9824
9825   List.iter (
9826     fun (name, style, _, _, _, _, _) ->
9827       pr "JNIEXPORT ";
9828       (match fst style with
9829        | RErr -> pr "void ";
9830        | RInt _ -> pr "jint ";
9831        | RInt64 _ -> pr "jlong ";
9832        | RBool _ -> pr "jboolean ";
9833        | RConstString _ | RConstOptString _ | RString _
9834        | RBufferOut _ -> pr "jstring ";
9835        | RStruct _ | RHashtable _ ->
9836            pr "jobject ";
9837        | RStringList _ | RStructList _ ->
9838            pr "jobjectArray ";
9839       );
9840       pr "JNICALL\n";
9841       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9842       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9843       pr "\n";
9844       pr "  (JNIEnv *env, jobject obj, jlong jg";
9845       List.iter (
9846         function
9847         | Pathname n
9848         | Device n | Dev_or_Path n
9849         | String n
9850         | OptString n
9851         | FileIn n
9852         | FileOut n ->
9853             pr ", jstring j%s" n
9854         | StringList n | DeviceList n ->
9855             pr ", jobjectArray j%s" n
9856         | Bool n ->
9857             pr ", jboolean j%s" n
9858         | Int n ->
9859             pr ", jint j%s" n
9860         | Int64 n ->
9861             pr ", jlong j%s" n
9862       ) (snd style);
9863       pr ")\n";
9864       pr "{\n";
9865       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9866       let error_code, no_ret =
9867         match fst style with
9868         | RErr -> pr "  int r;\n"; "-1", ""
9869         | RBool _
9870         | RInt _ -> pr "  int r;\n"; "-1", "0"
9871         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9872         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9873         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9874         | RString _ ->
9875             pr "  jstring jr;\n";
9876             pr "  char *r;\n"; "NULL", "NULL"
9877         | RStringList _ ->
9878             pr "  jobjectArray jr;\n";
9879             pr "  int r_len;\n";
9880             pr "  jclass cl;\n";
9881             pr "  jstring jstr;\n";
9882             pr "  char **r;\n"; "NULL", "NULL"
9883         | RStruct (_, typ) ->
9884             pr "  jobject jr;\n";
9885             pr "  jclass cl;\n";
9886             pr "  jfieldID fl;\n";
9887             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9888         | RStructList (_, typ) ->
9889             pr "  jobjectArray jr;\n";
9890             pr "  jclass cl;\n";
9891             pr "  jfieldID fl;\n";
9892             pr "  jobject jfl;\n";
9893             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9894         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9895         | RBufferOut _ ->
9896             pr "  jstring jr;\n";
9897             pr "  char *r;\n";
9898             pr "  size_t size;\n";
9899             "NULL", "NULL" in
9900       List.iter (
9901         function
9902         | Pathname n
9903         | Device n | Dev_or_Path n
9904         | String n
9905         | OptString n
9906         | FileIn n
9907         | FileOut n ->
9908             pr "  const char *%s;\n" n
9909         | StringList n | DeviceList n ->
9910             pr "  int %s_len;\n" n;
9911             pr "  const char **%s;\n" n
9912         | Bool n
9913         | Int n ->
9914             pr "  int %s;\n" n
9915         | Int64 n ->
9916             pr "  int64_t %s;\n" n
9917       ) (snd style);
9918
9919       let needs_i =
9920         (match fst style with
9921          | RStringList _ | RStructList _ -> true
9922          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9923          | RConstOptString _
9924          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9925           List.exists (function
9926                        | StringList _ -> true
9927                        | DeviceList _ -> true
9928                        | _ -> false) (snd style) in
9929       if needs_i then
9930         pr "  int i;\n";
9931
9932       pr "\n";
9933
9934       (* Get the parameters. *)
9935       List.iter (
9936         function
9937         | Pathname n
9938         | Device n | Dev_or_Path n
9939         | String n
9940         | FileIn n
9941         | FileOut n ->
9942             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9943         | OptString n ->
9944             (* This is completely undocumented, but Java null becomes
9945              * a NULL parameter.
9946              *)
9947             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9948         | StringList n | DeviceList n ->
9949             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9950             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9951             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9952             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9953               n;
9954             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9955             pr "  }\n";
9956             pr "  %s[%s_len] = NULL;\n" n n;
9957         | Bool n
9958         | Int n
9959         | Int64 n ->
9960             pr "  %s = j%s;\n" n n
9961       ) (snd style);
9962
9963       (* Make the call. *)
9964       pr "  r = guestfs_%s " name;
9965       generate_c_call_args ~handle:"g" style;
9966       pr ";\n";
9967
9968       (* Release the parameters. *)
9969       List.iter (
9970         function
9971         | Pathname n
9972         | Device n | Dev_or_Path n
9973         | String n
9974         | FileIn n
9975         | FileOut n ->
9976             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9977         | OptString n ->
9978             pr "  if (j%s)\n" n;
9979             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9980         | StringList n | DeviceList n ->
9981             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9982             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9983               n;
9984             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
9985             pr "  }\n";
9986             pr "  free (%s);\n" n
9987         | Bool n
9988         | Int n
9989         | Int64 n -> ()
9990       ) (snd style);
9991
9992       (* Check for errors. *)
9993       pr "  if (r == %s) {\n" error_code;
9994       pr "    throw_exception (env, guestfs_last_error (g));\n";
9995       pr "    return %s;\n" no_ret;
9996       pr "  }\n";
9997
9998       (* Return value. *)
9999       (match fst style with
10000        | RErr -> ()
10001        | RInt _ -> pr "  return (jint) r;\n"
10002        | RBool _ -> pr "  return (jboolean) r;\n"
10003        | RInt64 _ -> pr "  return (jlong) r;\n"
10004        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10005        | RConstOptString _ ->
10006            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10007        | RString _ ->
10008            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10009            pr "  free (r);\n";
10010            pr "  return jr;\n"
10011        | RStringList _ ->
10012            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10013            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10014            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10015            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10016            pr "  for (i = 0; i < r_len; ++i) {\n";
10017            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10018            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10019            pr "    free (r[i]);\n";
10020            pr "  }\n";
10021            pr "  free (r);\n";
10022            pr "  return jr;\n"
10023        | RStruct (_, typ) ->
10024            let jtyp = java_name_of_struct typ in
10025            let cols = cols_of_struct typ in
10026            generate_java_struct_return typ jtyp cols
10027        | RStructList (_, typ) ->
10028            let jtyp = java_name_of_struct typ in
10029            let cols = cols_of_struct typ in
10030            generate_java_struct_list_return typ jtyp cols
10031        | RHashtable _ ->
10032            (* XXX *)
10033            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10034            pr "  return NULL;\n"
10035        | RBufferOut _ ->
10036            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10037            pr "  free (r);\n";
10038            pr "  return jr;\n"
10039       );
10040
10041       pr "}\n";
10042       pr "\n"
10043   ) all_functions
10044
10045 and generate_java_struct_return typ jtyp cols =
10046   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10047   pr "  jr = (*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, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10053     | name, FUUID ->
10054         pr "  {\n";
10055         pr "    char s[33];\n";
10056         pr "    memcpy (s, r->%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, jr, fl, (*env)->NewStringUTF (env, s));\n";
10060         pr "  }\n";
10061     | name, FBuffer ->
10062         pr "  {\n";
10063         pr "    int len = r->%s_len;\n" name;
10064         pr "    char s[len+1];\n";
10065         pr "    memcpy (s, r->%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, jr, 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, jr, fl, r->%s);\n" name;
10073     | name, (FUInt32|FInt32) ->
10074         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10075         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10076     | name, FOptPercent ->
10077         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10078         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10079     | name, FChar ->
10080         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10081         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10082   ) cols;
10083   pr "  free (r);\n";
10084   pr "  return jr;\n"
10085
10086 and generate_java_struct_list_return typ jtyp cols =
10087   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10088   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10089   pr "  for (i = 0; i < r->len; ++i) {\n";
10090   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10091   List.iter (
10092     function
10093     | name, FString ->
10094         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10095         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10096     | name, FUUID ->
10097         pr "    {\n";
10098         pr "      char s[33];\n";
10099         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10100         pr "      s[32] = 0;\n";
10101         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10102         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10103         pr "    }\n";
10104     | name, FBuffer ->
10105         pr "    {\n";
10106         pr "      int len = r->val[i].%s_len;\n" name;
10107         pr "      char s[len+1];\n";
10108         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10109         pr "      s[len] = 0;\n";
10110         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10111         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10112         pr "    }\n";
10113     | name, (FBytes|FUInt64|FInt64) ->
10114         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10115         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10116     | name, (FUInt32|FInt32) ->
10117         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10118         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10119     | name, FOptPercent ->
10120         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10121         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10122     | name, FChar ->
10123         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10124         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10125   ) cols;
10126   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10127   pr "  }\n";
10128   pr "  guestfs_free_%s_list (r);\n" typ;
10129   pr "  return jr;\n"
10130
10131 and generate_java_makefile_inc () =
10132   generate_header HashStyle GPLv2plus;
10133
10134   pr "java_built_sources = \\\n";
10135   List.iter (
10136     fun (typ, jtyp) ->
10137         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10138   ) java_structs;
10139   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10140
10141 and generate_haskell_hs () =
10142   generate_header HaskellStyle LGPLv2plus;
10143
10144   (* XXX We only know how to generate partial FFI for Haskell
10145    * at the moment.  Please help out!
10146    *)
10147   let can_generate style =
10148     match style with
10149     | RErr, _
10150     | RInt _, _
10151     | RInt64 _, _ -> true
10152     | RBool _, _
10153     | RConstString _, _
10154     | RConstOptString _, _
10155     | RString _, _
10156     | RStringList _, _
10157     | RStruct _, _
10158     | RStructList _, _
10159     | RHashtable _, _
10160     | RBufferOut _, _ -> false in
10161
10162   pr "\
10163 {-# INCLUDE <guestfs.h> #-}
10164 {-# LANGUAGE ForeignFunctionInterface #-}
10165
10166 module Guestfs (
10167   create";
10168
10169   (* List out the names of the actions we want to export. *)
10170   List.iter (
10171     fun (name, style, _, _, _, _, _) ->
10172       if can_generate style then pr ",\n  %s" name
10173   ) all_functions;
10174
10175   pr "
10176   ) where
10177
10178 -- Unfortunately some symbols duplicate ones already present
10179 -- in Prelude.  We don't know which, so we hard-code a list
10180 -- here.
10181 import Prelude hiding (truncate)
10182
10183 import Foreign
10184 import Foreign.C
10185 import Foreign.C.Types
10186 import IO
10187 import Control.Exception
10188 import Data.Typeable
10189
10190 data GuestfsS = GuestfsS            -- represents the opaque C struct
10191 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10192 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10193
10194 -- XXX define properly later XXX
10195 data PV = PV
10196 data VG = VG
10197 data LV = LV
10198 data IntBool = IntBool
10199 data Stat = Stat
10200 data StatVFS = StatVFS
10201 data Hashtable = Hashtable
10202
10203 foreign import ccall unsafe \"guestfs_create\" c_create
10204   :: IO GuestfsP
10205 foreign import ccall unsafe \"&guestfs_close\" c_close
10206   :: FunPtr (GuestfsP -> IO ())
10207 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10208   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10209
10210 create :: IO GuestfsH
10211 create = do
10212   p <- c_create
10213   c_set_error_handler p nullPtr nullPtr
10214   h <- newForeignPtr c_close p
10215   return h
10216
10217 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10218   :: GuestfsP -> IO CString
10219
10220 -- last_error :: GuestfsH -> IO (Maybe String)
10221 -- last_error h = do
10222 --   str <- withForeignPtr h (\\p -> c_last_error p)
10223 --   maybePeek peekCString str
10224
10225 last_error :: GuestfsH -> IO (String)
10226 last_error h = do
10227   str <- withForeignPtr h (\\p -> c_last_error p)
10228   if (str == nullPtr)
10229     then return \"no error\"
10230     else peekCString str
10231
10232 ";
10233
10234   (* Generate wrappers for each foreign function. *)
10235   List.iter (
10236     fun (name, style, _, _, _, _, _) ->
10237       if can_generate style then (
10238         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10239         pr "  :: ";
10240         generate_haskell_prototype ~handle:"GuestfsP" style;
10241         pr "\n";
10242         pr "\n";
10243         pr "%s :: " name;
10244         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10245         pr "\n";
10246         pr "%s %s = do\n" name
10247           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10248         pr "  r <- ";
10249         (* Convert pointer arguments using with* functions. *)
10250         List.iter (
10251           function
10252           | FileIn n
10253           | FileOut n
10254           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10255           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10256           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10257           | Bool _ | Int _ | Int64 _ -> ()
10258         ) (snd style);
10259         (* Convert integer arguments. *)
10260         let args =
10261           List.map (
10262             function
10263             | Bool n -> sprintf "(fromBool %s)" n
10264             | Int n -> sprintf "(fromIntegral %s)" n
10265             | Int64 n -> sprintf "(fromIntegral %s)" n
10266             | FileIn n | FileOut n
10267             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10268           ) (snd style) in
10269         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10270           (String.concat " " ("p" :: args));
10271         (match fst style with
10272          | RErr | RInt _ | RInt64 _ | RBool _ ->
10273              pr "  if (r == -1)\n";
10274              pr "    then do\n";
10275              pr "      err <- last_error h\n";
10276              pr "      fail err\n";
10277          | RConstString _ | RConstOptString _ | RString _
10278          | RStringList _ | RStruct _
10279          | RStructList _ | RHashtable _ | RBufferOut _ ->
10280              pr "  if (r == nullPtr)\n";
10281              pr "    then do\n";
10282              pr "      err <- last_error h\n";
10283              pr "      fail err\n";
10284         );
10285         (match fst style with
10286          | RErr ->
10287              pr "    else return ()\n"
10288          | RInt _ ->
10289              pr "    else return (fromIntegral r)\n"
10290          | RInt64 _ ->
10291              pr "    else return (fromIntegral r)\n"
10292          | RBool _ ->
10293              pr "    else return (toBool r)\n"
10294          | RConstString _
10295          | RConstOptString _
10296          | RString _
10297          | RStringList _
10298          | RStruct _
10299          | RStructList _
10300          | RHashtable _
10301          | RBufferOut _ ->
10302              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10303         );
10304         pr "\n";
10305       )
10306   ) all_functions
10307
10308 and generate_haskell_prototype ~handle ?(hs = false) style =
10309   pr "%s -> " handle;
10310   let string = if hs then "String" else "CString" in
10311   let int = if hs then "Int" else "CInt" in
10312   let bool = if hs then "Bool" else "CInt" in
10313   let int64 = if hs then "Integer" else "Int64" in
10314   List.iter (
10315     fun arg ->
10316       (match arg with
10317        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10318        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10319        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10320        | Bool _ -> pr "%s" bool
10321        | Int _ -> pr "%s" int
10322        | Int64 _ -> pr "%s" int
10323        | FileIn _ -> pr "%s" string
10324        | FileOut _ -> pr "%s" string
10325       );
10326       pr " -> ";
10327   ) (snd style);
10328   pr "IO (";
10329   (match fst style with
10330    | RErr -> if not hs then pr "CInt"
10331    | RInt _ -> pr "%s" int
10332    | RInt64 _ -> pr "%s" int64
10333    | RBool _ -> pr "%s" bool
10334    | RConstString _ -> pr "%s" string
10335    | RConstOptString _ -> pr "Maybe %s" string
10336    | RString _ -> pr "%s" string
10337    | RStringList _ -> pr "[%s]" string
10338    | RStruct (_, typ) ->
10339        let name = java_name_of_struct typ in
10340        pr "%s" name
10341    | RStructList (_, typ) ->
10342        let name = java_name_of_struct typ in
10343        pr "[%s]" name
10344    | RHashtable _ -> pr "Hashtable"
10345    | RBufferOut _ -> pr "%s" string
10346   );
10347   pr ")"
10348
10349 and generate_csharp () =
10350   generate_header CPlusPlusStyle LGPLv2plus;
10351
10352   (* XXX Make this configurable by the C# assembly users. *)
10353   let library = "libguestfs.so.0" in
10354
10355   pr "\
10356 // These C# bindings are highly experimental at present.
10357 //
10358 // Firstly they only work on Linux (ie. Mono).  In order to get them
10359 // to work on Windows (ie. .Net) you would need to port the library
10360 // itself to Windows first.
10361 //
10362 // The second issue is that some calls are known to be incorrect and
10363 // can cause Mono to segfault.  Particularly: calls which pass or
10364 // return string[], or return any structure value.  This is because
10365 // we haven't worked out the correct way to do this from C#.
10366 //
10367 // The third issue is that when compiling you get a lot of warnings.
10368 // We are not sure whether the warnings are important or not.
10369 //
10370 // Fourthly we do not routinely build or test these bindings as part
10371 // of the make && make check cycle, which means that regressions might
10372 // go unnoticed.
10373 //
10374 // Suggestions and patches are welcome.
10375
10376 // To compile:
10377 //
10378 // gmcs Libguestfs.cs
10379 // mono Libguestfs.exe
10380 //
10381 // (You'll probably want to add a Test class / static main function
10382 // otherwise this won't do anything useful).
10383
10384 using System;
10385 using System.IO;
10386 using System.Runtime.InteropServices;
10387 using System.Runtime.Serialization;
10388 using System.Collections;
10389
10390 namespace Guestfs
10391 {
10392   class Error : System.ApplicationException
10393   {
10394     public Error (string message) : base (message) {}
10395     protected Error (SerializationInfo info, StreamingContext context) {}
10396   }
10397
10398   class Guestfs
10399   {
10400     IntPtr _handle;
10401
10402     [DllImport (\"%s\")]
10403     static extern IntPtr guestfs_create ();
10404
10405     public Guestfs ()
10406     {
10407       _handle = guestfs_create ();
10408       if (_handle == IntPtr.Zero)
10409         throw new Error (\"could not create guestfs handle\");
10410     }
10411
10412     [DllImport (\"%s\")]
10413     static extern void guestfs_close (IntPtr h);
10414
10415     ~Guestfs ()
10416     {
10417       guestfs_close (_handle);
10418     }
10419
10420     [DllImport (\"%s\")]
10421     static extern string guestfs_last_error (IntPtr h);
10422
10423 " library library library;
10424
10425   (* Generate C# structure bindings.  We prefix struct names with
10426    * underscore because C# cannot have conflicting struct names and
10427    * method names (eg. "class stat" and "stat").
10428    *)
10429   List.iter (
10430     fun (typ, cols) ->
10431       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10432       pr "    public class _%s {\n" typ;
10433       List.iter (
10434         function
10435         | name, FChar -> pr "      char %s;\n" name
10436         | name, FString -> pr "      string %s;\n" name
10437         | name, FBuffer ->
10438             pr "      uint %s_len;\n" name;
10439             pr "      string %s;\n" name
10440         | name, FUUID ->
10441             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10442             pr "      string %s;\n" name
10443         | name, FUInt32 -> pr "      uint %s;\n" name
10444         | name, FInt32 -> pr "      int %s;\n" name
10445         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10446         | name, FInt64 -> pr "      long %s;\n" name
10447         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10448       ) cols;
10449       pr "    }\n";
10450       pr "\n"
10451   ) structs;
10452
10453   (* Generate C# function bindings. *)
10454   List.iter (
10455     fun (name, style, _, _, _, shortdesc, _) ->
10456       let rec csharp_return_type () =
10457         match fst style with
10458         | RErr -> "void"
10459         | RBool n -> "bool"
10460         | RInt n -> "int"
10461         | RInt64 n -> "long"
10462         | RConstString n
10463         | RConstOptString n
10464         | RString n
10465         | RBufferOut n -> "string"
10466         | RStruct (_,n) -> "_" ^ n
10467         | RHashtable n -> "Hashtable"
10468         | RStringList n -> "string[]"
10469         | RStructList (_,n) -> sprintf "_%s[]" n
10470
10471       and c_return_type () =
10472         match fst style with
10473         | RErr
10474         | RBool _
10475         | RInt _ -> "int"
10476         | RInt64 _ -> "long"
10477         | RConstString _
10478         | RConstOptString _
10479         | RString _
10480         | RBufferOut _ -> "string"
10481         | RStruct (_,n) -> "_" ^ n
10482         | RHashtable _
10483         | RStringList _ -> "string[]"
10484         | RStructList (_,n) -> sprintf "_%s[]" n
10485
10486       and c_error_comparison () =
10487         match fst style with
10488         | RErr
10489         | RBool _
10490         | RInt _
10491         | RInt64 _ -> "== -1"
10492         | RConstString _
10493         | RConstOptString _
10494         | RString _
10495         | RBufferOut _
10496         | RStruct (_,_)
10497         | RHashtable _
10498         | RStringList _
10499         | RStructList (_,_) -> "== null"
10500
10501       and generate_extern_prototype () =
10502         pr "    static extern %s guestfs_%s (IntPtr h"
10503           (c_return_type ()) name;
10504         List.iter (
10505           function
10506           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10507           | FileIn n | FileOut n ->
10508               pr ", [In] string %s" n
10509           | StringList n | DeviceList n ->
10510               pr ", [In] string[] %s" n
10511           | Bool n ->
10512               pr ", bool %s" n
10513           | Int n ->
10514               pr ", int %s" n
10515           | Int64 n ->
10516               pr ", long %s" n
10517         ) (snd style);
10518         pr ");\n"
10519
10520       and generate_public_prototype () =
10521         pr "    public %s %s (" (csharp_return_type ()) name;
10522         let comma = ref false in
10523         let next () =
10524           if !comma then pr ", ";
10525           comma := true
10526         in
10527         List.iter (
10528           function
10529           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10530           | FileIn n | FileOut n ->
10531               next (); pr "string %s" n
10532           | StringList n | DeviceList n ->
10533               next (); pr "string[] %s" n
10534           | Bool n ->
10535               next (); pr "bool %s" n
10536           | Int n ->
10537               next (); pr "int %s" n
10538           | Int64 n ->
10539               next (); pr "long %s" n
10540         ) (snd style);
10541         pr ")\n"
10542
10543       and generate_call () =
10544         pr "guestfs_%s (_handle" name;
10545         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10546         pr ");\n";
10547       in
10548
10549       pr "    [DllImport (\"%s\")]\n" library;
10550       generate_extern_prototype ();
10551       pr "\n";
10552       pr "    /// <summary>\n";
10553       pr "    /// %s\n" shortdesc;
10554       pr "    /// </summary>\n";
10555       generate_public_prototype ();
10556       pr "    {\n";
10557       pr "      %s r;\n" (c_return_type ());
10558       pr "      r = ";
10559       generate_call ();
10560       pr "      if (r %s)\n" (c_error_comparison ());
10561       pr "        throw new Error (guestfs_last_error (_handle));\n";
10562       (match fst style with
10563        | RErr -> ()
10564        | RBool _ ->
10565            pr "      return r != 0 ? true : false;\n"
10566        | RHashtable _ ->
10567            pr "      Hashtable rr = new Hashtable ();\n";
10568            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10569            pr "        rr.Add (r[i], r[i+1]);\n";
10570            pr "      return rr;\n"
10571        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10572        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10573        | RStructList _ ->
10574            pr "      return r;\n"
10575       );
10576       pr "    }\n";
10577       pr "\n";
10578   ) all_functions_sorted;
10579
10580   pr "  }
10581 }
10582 "
10583
10584 and generate_bindtests () =
10585   generate_header CStyle LGPLv2plus;
10586
10587   pr "\
10588 #include <stdio.h>
10589 #include <stdlib.h>
10590 #include <inttypes.h>
10591 #include <string.h>
10592
10593 #include \"guestfs.h\"
10594 #include \"guestfs-internal.h\"
10595 #include \"guestfs-internal-actions.h\"
10596 #include \"guestfs_protocol.h\"
10597
10598 #define error guestfs_error
10599 #define safe_calloc guestfs_safe_calloc
10600 #define safe_malloc guestfs_safe_malloc
10601
10602 static void
10603 print_strings (char *const *argv)
10604 {
10605   int argc;
10606
10607   printf (\"[\");
10608   for (argc = 0; argv[argc] != NULL; ++argc) {
10609     if (argc > 0) printf (\", \");
10610     printf (\"\\\"%%s\\\"\", argv[argc]);
10611   }
10612   printf (\"]\\n\");
10613 }
10614
10615 /* The test0 function prints its parameters to stdout. */
10616 ";
10617
10618   let test0, tests =
10619     match test_functions with
10620     | [] -> assert false
10621     | test0 :: tests -> test0, tests in
10622
10623   let () =
10624     let (name, style, _, _, _, _, _) = test0 in
10625     generate_prototype ~extern:false ~semicolon:false ~newline:true
10626       ~handle:"g" ~prefix:"guestfs__" name style;
10627     pr "{\n";
10628     List.iter (
10629       function
10630       | Pathname n
10631       | Device n | Dev_or_Path n
10632       | String n
10633       | FileIn n
10634       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10635       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10636       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10637       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10638       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10639       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10640     ) (snd style);
10641     pr "  /* Java changes stdout line buffering so we need this: */\n";
10642     pr "  fflush (stdout);\n";
10643     pr "  return 0;\n";
10644     pr "}\n";
10645     pr "\n" in
10646
10647   List.iter (
10648     fun (name, style, _, _, _, _, _) ->
10649       if String.sub name (String.length name - 3) 3 <> "err" then (
10650         pr "/* Test normal return. */\n";
10651         generate_prototype ~extern:false ~semicolon:false ~newline:true
10652           ~handle:"g" ~prefix:"guestfs__" name style;
10653         pr "{\n";
10654         (match fst style with
10655          | RErr ->
10656              pr "  return 0;\n"
10657          | RInt _ ->
10658              pr "  int r;\n";
10659              pr "  sscanf (val, \"%%d\", &r);\n";
10660              pr "  return r;\n"
10661          | RInt64 _ ->
10662              pr "  int64_t r;\n";
10663              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10664              pr "  return r;\n"
10665          | RBool _ ->
10666              pr "  return STREQ (val, \"true\");\n"
10667          | RConstString _
10668          | RConstOptString _ ->
10669              (* Can't return the input string here.  Return a static
10670               * string so we ensure we get a segfault if the caller
10671               * tries to free it.
10672               *)
10673              pr "  return \"static string\";\n"
10674          | RString _ ->
10675              pr "  return strdup (val);\n"
10676          | RStringList _ ->
10677              pr "  char **strs;\n";
10678              pr "  int n, i;\n";
10679              pr "  sscanf (val, \"%%d\", &n);\n";
10680              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10681              pr "  for (i = 0; i < n; ++i) {\n";
10682              pr "    strs[i] = safe_malloc (g, 16);\n";
10683              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10684              pr "  }\n";
10685              pr "  strs[n] = NULL;\n";
10686              pr "  return strs;\n"
10687          | RStruct (_, typ) ->
10688              pr "  struct guestfs_%s *r;\n" typ;
10689              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10690              pr "  return r;\n"
10691          | RStructList (_, typ) ->
10692              pr "  struct guestfs_%s_list *r;\n" typ;
10693              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10694              pr "  sscanf (val, \"%%d\", &r->len);\n";
10695              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10696              pr "  return r;\n"
10697          | RHashtable _ ->
10698              pr "  char **strs;\n";
10699              pr "  int n, i;\n";
10700              pr "  sscanf (val, \"%%d\", &n);\n";
10701              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10702              pr "  for (i = 0; i < n; ++i) {\n";
10703              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10704              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10705              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10706              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10707              pr "  }\n";
10708              pr "  strs[n*2] = NULL;\n";
10709              pr "  return strs;\n"
10710          | RBufferOut _ ->
10711              pr "  return strdup (val);\n"
10712         );
10713         pr "}\n";
10714         pr "\n"
10715       ) else (
10716         pr "/* Test error return. */\n";
10717         generate_prototype ~extern:false ~semicolon:false ~newline:true
10718           ~handle:"g" ~prefix:"guestfs__" name style;
10719         pr "{\n";
10720         pr "  error (g, \"error\");\n";
10721         (match fst style with
10722          | RErr | RInt _ | RInt64 _ | RBool _ ->
10723              pr "  return -1;\n"
10724          | RConstString _ | RConstOptString _
10725          | RString _ | RStringList _ | RStruct _
10726          | RStructList _
10727          | RHashtable _
10728          | RBufferOut _ ->
10729              pr "  return NULL;\n"
10730         );
10731         pr "}\n";
10732         pr "\n"
10733       )
10734   ) tests
10735
10736 and generate_ocaml_bindtests () =
10737   generate_header OCamlStyle GPLv2plus;
10738
10739   pr "\
10740 let () =
10741   let g = Guestfs.create () in
10742 ";
10743
10744   let mkargs args =
10745     String.concat " " (
10746       List.map (
10747         function
10748         | CallString s -> "\"" ^ s ^ "\""
10749         | CallOptString None -> "None"
10750         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10751         | CallStringList xs ->
10752             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10753         | CallInt i when i >= 0 -> string_of_int i
10754         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10755         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10756         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10757         | CallBool b -> string_of_bool b
10758       ) args
10759     )
10760   in
10761
10762   generate_lang_bindtests (
10763     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10764   );
10765
10766   pr "print_endline \"EOF\"\n"
10767
10768 and generate_perl_bindtests () =
10769   pr "#!/usr/bin/perl -w\n";
10770   generate_header HashStyle GPLv2plus;
10771
10772   pr "\
10773 use strict;
10774
10775 use Sys::Guestfs;
10776
10777 my $g = Sys::Guestfs->new ();
10778 ";
10779
10780   let mkargs args =
10781     String.concat ", " (
10782       List.map (
10783         function
10784         | CallString s -> "\"" ^ s ^ "\""
10785         | CallOptString None -> "undef"
10786         | CallOptString (Some s) -> sprintf "\"%s\"" s
10787         | CallStringList xs ->
10788             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10789         | CallInt i -> string_of_int i
10790         | CallInt64 i -> Int64.to_string i
10791         | CallBool b -> if b then "1" else "0"
10792       ) args
10793     )
10794   in
10795
10796   generate_lang_bindtests (
10797     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10798   );
10799
10800   pr "print \"EOF\\n\"\n"
10801
10802 and generate_python_bindtests () =
10803   generate_header HashStyle GPLv2plus;
10804
10805   pr "\
10806 import guestfs
10807
10808 g = guestfs.GuestFS ()
10809 ";
10810
10811   let mkargs args =
10812     String.concat ", " (
10813       List.map (
10814         function
10815         | CallString s -> "\"" ^ s ^ "\""
10816         | CallOptString None -> "None"
10817         | CallOptString (Some s) -> sprintf "\"%s\"" s
10818         | CallStringList xs ->
10819             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10820         | CallInt i -> string_of_int i
10821         | CallInt64 i -> Int64.to_string i
10822         | CallBool b -> if b then "1" else "0"
10823       ) args
10824     )
10825   in
10826
10827   generate_lang_bindtests (
10828     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10829   );
10830
10831   pr "print \"EOF\"\n"
10832
10833 and generate_ruby_bindtests () =
10834   generate_header HashStyle GPLv2plus;
10835
10836   pr "\
10837 require 'guestfs'
10838
10839 g = Guestfs::create()
10840 ";
10841
10842   let mkargs args =
10843     String.concat ", " (
10844       List.map (
10845         function
10846         | CallString s -> "\"" ^ s ^ "\""
10847         | CallOptString None -> "nil"
10848         | CallOptString (Some s) -> sprintf "\"%s\"" s
10849         | CallStringList xs ->
10850             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10851         | CallInt i -> string_of_int i
10852         | CallInt64 i -> Int64.to_string i
10853         | CallBool b -> string_of_bool b
10854       ) args
10855     )
10856   in
10857
10858   generate_lang_bindtests (
10859     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10860   );
10861
10862   pr "print \"EOF\\n\"\n"
10863
10864 and generate_java_bindtests () =
10865   generate_header CStyle GPLv2plus;
10866
10867   pr "\
10868 import com.redhat.et.libguestfs.*;
10869
10870 public class Bindtests {
10871     public static void main (String[] argv)
10872     {
10873         try {
10874             GuestFS g = new GuestFS ();
10875 ";
10876
10877   let mkargs args =
10878     String.concat ", " (
10879       List.map (
10880         function
10881         | CallString s -> "\"" ^ s ^ "\""
10882         | CallOptString None -> "null"
10883         | CallOptString (Some s) -> sprintf "\"%s\"" s
10884         | CallStringList xs ->
10885             "new String[]{" ^
10886               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10887         | CallInt i -> string_of_int i
10888         | CallInt64 i -> Int64.to_string i
10889         | CallBool b -> string_of_bool b
10890       ) args
10891     )
10892   in
10893
10894   generate_lang_bindtests (
10895     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10896   );
10897
10898   pr "
10899             System.out.println (\"EOF\");
10900         }
10901         catch (Exception exn) {
10902             System.err.println (exn);
10903             System.exit (1);
10904         }
10905     }
10906 }
10907 "
10908
10909 and generate_haskell_bindtests () =
10910   generate_header HaskellStyle GPLv2plus;
10911
10912   pr "\
10913 module Bindtests where
10914 import qualified Guestfs
10915
10916 main = do
10917   g <- Guestfs.create
10918 ";
10919
10920   let mkargs args =
10921     String.concat " " (
10922       List.map (
10923         function
10924         | CallString s -> "\"" ^ s ^ "\""
10925         | CallOptString None -> "Nothing"
10926         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10927         | CallStringList xs ->
10928             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10929         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10930         | CallInt i -> string_of_int i
10931         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10932         | CallInt64 i -> Int64.to_string i
10933         | CallBool true -> "True"
10934         | CallBool false -> "False"
10935       ) args
10936     )
10937   in
10938
10939   generate_lang_bindtests (
10940     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10941   );
10942
10943   pr "  putStrLn \"EOF\"\n"
10944
10945 (* Language-independent bindings tests - we do it this way to
10946  * ensure there is parity in testing bindings across all languages.
10947  *)
10948 and generate_lang_bindtests call =
10949   call "test0" [CallString "abc"; CallOptString (Some "def");
10950                 CallStringList []; CallBool false;
10951                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10952   call "test0" [CallString "abc"; CallOptString None;
10953                 CallStringList []; CallBool false;
10954                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10955   call "test0" [CallString ""; CallOptString (Some "def");
10956                 CallStringList []; CallBool false;
10957                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10958   call "test0" [CallString ""; CallOptString (Some "");
10959                 CallStringList []; CallBool false;
10960                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10961   call "test0" [CallString "abc"; CallOptString (Some "def");
10962                 CallStringList ["1"]; CallBool false;
10963                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10964   call "test0" [CallString "abc"; CallOptString (Some "def");
10965                 CallStringList ["1"; "2"]; CallBool false;
10966                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10967   call "test0" [CallString "abc"; CallOptString (Some "def");
10968                 CallStringList ["1"]; CallBool true;
10969                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10970   call "test0" [CallString "abc"; CallOptString (Some "def");
10971                 CallStringList ["1"]; CallBool false;
10972                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
10973   call "test0" [CallString "abc"; CallOptString (Some "def");
10974                 CallStringList ["1"]; CallBool false;
10975                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
10976   call "test0" [CallString "abc"; CallOptString (Some "def");
10977                 CallStringList ["1"]; CallBool false;
10978                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
10979   call "test0" [CallString "abc"; CallOptString (Some "def");
10980                 CallStringList ["1"]; CallBool false;
10981                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
10982   call "test0" [CallString "abc"; CallOptString (Some "def");
10983                 CallStringList ["1"]; CallBool false;
10984                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
10985   call "test0" [CallString "abc"; CallOptString (Some "def");
10986                 CallStringList ["1"]; CallBool false;
10987                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
10988
10989 (* XXX Add here tests of the return and error functions. *)
10990
10991 (* Code to generator bindings for virt-inspector.  Currently only
10992  * implemented for OCaml code (for virt-p2v 2.0).
10993  *)
10994 let rng_input = "inspector/virt-inspector.rng"
10995
10996 (* Read the input file and parse it into internal structures.  This is
10997  * by no means a complete RELAX NG parser, but is just enough to be
10998  * able to parse the specific input file.
10999  *)
11000 type rng =
11001   | Element of string * rng list        (* <element name=name/> *)
11002   | Attribute of string * rng list        (* <attribute name=name/> *)
11003   | Interleave of rng list                (* <interleave/> *)
11004   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11005   | OneOrMore of rng                        (* <oneOrMore/> *)
11006   | Optional of rng                        (* <optional/> *)
11007   | Choice of string list                (* <choice><value/>*</choice> *)
11008   | Value of string                        (* <value>str</value> *)
11009   | Text                                (* <text/> *)
11010
11011 let rec string_of_rng = function
11012   | Element (name, xs) ->
11013       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11014   | Attribute (name, xs) ->
11015       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11016   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11017   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11018   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11019   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11020   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11021   | Value value -> "Value \"" ^ value ^ "\""
11022   | Text -> "Text"
11023
11024 and string_of_rng_list xs =
11025   String.concat ", " (List.map string_of_rng xs)
11026
11027 let rec parse_rng ?defines context = function
11028   | [] -> []
11029   | Xml.Element ("element", ["name", name], children) :: rest ->
11030       Element (name, parse_rng ?defines context children)
11031       :: parse_rng ?defines context rest
11032   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11033       Attribute (name, parse_rng ?defines context children)
11034       :: parse_rng ?defines context rest
11035   | Xml.Element ("interleave", [], children) :: rest ->
11036       Interleave (parse_rng ?defines context children)
11037       :: parse_rng ?defines context rest
11038   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11039       let rng = parse_rng ?defines context [child] in
11040       (match rng with
11041        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11042        | _ ->
11043            failwithf "%s: <zeroOrMore> contains more than one child element"
11044              context
11045       )
11046   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11047       let rng = parse_rng ?defines context [child] in
11048       (match rng with
11049        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11050        | _ ->
11051            failwithf "%s: <oneOrMore> contains more than one child element"
11052              context
11053       )
11054   | Xml.Element ("optional", [], [child]) :: rest ->
11055       let rng = parse_rng ?defines context [child] in
11056       (match rng with
11057        | [child] -> Optional child :: parse_rng ?defines context rest
11058        | _ ->
11059            failwithf "%s: <optional> contains more than one child element"
11060              context
11061       )
11062   | Xml.Element ("choice", [], children) :: rest ->
11063       let values = List.map (
11064         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11065         | _ ->
11066             failwithf "%s: can't handle anything except <value> in <choice>"
11067               context
11068       ) children in
11069       Choice values
11070       :: parse_rng ?defines context rest
11071   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11072       Value value :: parse_rng ?defines context rest
11073   | Xml.Element ("text", [], []) :: rest ->
11074       Text :: parse_rng ?defines context rest
11075   | Xml.Element ("ref", ["name", name], []) :: rest ->
11076       (* Look up the reference.  Because of limitations in this parser,
11077        * we can't handle arbitrarily nested <ref> yet.  You can only
11078        * use <ref> from inside <start>.
11079        *)
11080       (match defines with
11081        | None ->
11082            failwithf "%s: contains <ref>, but no refs are defined yet" context
11083        | Some map ->
11084            let rng = StringMap.find name map in
11085            rng @ parse_rng ?defines context rest
11086       )
11087   | x :: _ ->
11088       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11089
11090 let grammar =
11091   let xml = Xml.parse_file rng_input in
11092   match xml with
11093   | Xml.Element ("grammar", _,
11094                  Xml.Element ("start", _, gram) :: defines) ->
11095       (* The <define/> elements are referenced in the <start> section,
11096        * so build a map of those first.
11097        *)
11098       let defines = List.fold_left (
11099         fun map ->
11100           function Xml.Element ("define", ["name", name], defn) ->
11101             StringMap.add name defn map
11102           | _ ->
11103               failwithf "%s: expected <define name=name/>" rng_input
11104       ) StringMap.empty defines in
11105       let defines = StringMap.mapi parse_rng defines in
11106
11107       (* Parse the <start> clause, passing the defines. *)
11108       parse_rng ~defines "<start>" gram
11109   | _ ->
11110       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11111         rng_input
11112
11113 let name_of_field = function
11114   | Element (name, _) | Attribute (name, _)
11115   | ZeroOrMore (Element (name, _))
11116   | OneOrMore (Element (name, _))
11117   | Optional (Element (name, _)) -> name
11118   | Optional (Attribute (name, _)) -> name
11119   | Text -> (* an unnamed field in an element *)
11120       "data"
11121   | rng ->
11122       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11123
11124 (* At the moment this function only generates OCaml types.  However we
11125  * should parameterize it later so it can generate types/structs in a
11126  * variety of languages.
11127  *)
11128 let generate_types xs =
11129   (* A simple type is one that can be printed out directly, eg.
11130    * "string option".  A complex type is one which has a name and has
11131    * to be defined via another toplevel definition, eg. a struct.
11132    *
11133    * generate_type generates code for either simple or complex types.
11134    * In the simple case, it returns the string ("string option").  In
11135    * the complex case, it returns the name ("mountpoint").  In the
11136    * complex case it has to print out the definition before returning,
11137    * so it should only be called when we are at the beginning of a
11138    * new line (BOL context).
11139    *)
11140   let rec generate_type = function
11141     | Text ->                                (* string *)
11142         "string", true
11143     | Choice values ->                        (* [`val1|`val2|...] *)
11144         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11145     | ZeroOrMore rng ->                        (* <rng> list *)
11146         let t, is_simple = generate_type rng in
11147         t ^ " list (* 0 or more *)", is_simple
11148     | OneOrMore rng ->                        (* <rng> list *)
11149         let t, is_simple = generate_type rng in
11150         t ^ " list (* 1 or more *)", is_simple
11151                                         (* virt-inspector hack: bool *)
11152     | Optional (Attribute (name, [Value "1"])) ->
11153         "bool", true
11154     | Optional rng ->                        (* <rng> list *)
11155         let t, is_simple = generate_type rng in
11156         t ^ " option", is_simple
11157                                         (* type name = { fields ... } *)
11158     | Element (name, fields) when is_attrs_interleave fields ->
11159         generate_type_struct name (get_attrs_interleave fields)
11160     | Element (name, [field])                (* type name = field *)
11161     | Attribute (name, [field]) ->
11162         let t, is_simple = generate_type field in
11163         if is_simple then (t, true)
11164         else (
11165           pr "type %s = %s\n" name t;
11166           name, false
11167         )
11168     | Element (name, fields) ->              (* type name = { fields ... } *)
11169         generate_type_struct name fields
11170     | rng ->
11171         failwithf "generate_type failed at: %s" (string_of_rng rng)
11172
11173   and is_attrs_interleave = function
11174     | [Interleave _] -> true
11175     | Attribute _ :: fields -> is_attrs_interleave fields
11176     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11177     | _ -> false
11178
11179   and get_attrs_interleave = function
11180     | [Interleave fields] -> fields
11181     | ((Attribute _) as field) :: fields
11182     | ((Optional (Attribute _)) as field) :: fields ->
11183         field :: get_attrs_interleave fields
11184     | _ -> assert false
11185
11186   and generate_types xs =
11187     List.iter (fun x -> ignore (generate_type x)) xs
11188
11189   and generate_type_struct name fields =
11190     (* Calculate the types of the fields first.  We have to do this
11191      * before printing anything so we are still in BOL context.
11192      *)
11193     let types = List.map fst (List.map generate_type fields) in
11194
11195     (* Special case of a struct containing just a string and another
11196      * field.  Turn it into an assoc list.
11197      *)
11198     match types with
11199     | ["string"; other] ->
11200         let fname1, fname2 =
11201           match fields with
11202           | [f1; f2] -> name_of_field f1, name_of_field f2
11203           | _ -> assert false in
11204         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11205         name, false
11206
11207     | types ->
11208         pr "type %s = {\n" name;
11209         List.iter (
11210           fun (field, ftype) ->
11211             let fname = name_of_field field in
11212             pr "  %s_%s : %s;\n" name fname ftype
11213         ) (List.combine fields types);
11214         pr "}\n";
11215         (* Return the name of this type, and
11216          * false because it's not a simple type.
11217          *)
11218         name, false
11219   in
11220
11221   generate_types xs
11222
11223 let generate_parsers xs =
11224   (* As for generate_type above, generate_parser makes a parser for
11225    * some type, and returns the name of the parser it has generated.
11226    * Because it (may) need to print something, it should always be
11227    * called in BOL context.
11228    *)
11229   let rec generate_parser = function
11230     | Text ->                                (* string *)
11231         "string_child_or_empty"
11232     | Choice values ->                        (* [`val1|`val2|...] *)
11233         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11234           (String.concat "|"
11235              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11236     | ZeroOrMore rng ->                        (* <rng> list *)
11237         let pa = generate_parser rng in
11238         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11239     | OneOrMore rng ->                        (* <rng> list *)
11240         let pa = generate_parser rng in
11241         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11242                                         (* virt-inspector hack: bool *)
11243     | Optional (Attribute (name, [Value "1"])) ->
11244         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11245     | Optional rng ->                        (* <rng> list *)
11246         let pa = generate_parser rng in
11247         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11248                                         (* type name = { fields ... } *)
11249     | Element (name, fields) when is_attrs_interleave fields ->
11250         generate_parser_struct name (get_attrs_interleave fields)
11251     | Element (name, [field]) ->        (* type name = field *)
11252         let pa = generate_parser field in
11253         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11254         pr "let %s =\n" parser_name;
11255         pr "  %s\n" pa;
11256         pr "let parse_%s = %s\n" name parser_name;
11257         parser_name
11258     | Attribute (name, [field]) ->
11259         let pa = generate_parser field in
11260         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11261         pr "let %s =\n" parser_name;
11262         pr "  %s\n" pa;
11263         pr "let parse_%s = %s\n" name parser_name;
11264         parser_name
11265     | Element (name, fields) ->              (* type name = { fields ... } *)
11266         generate_parser_struct name ([], fields)
11267     | rng ->
11268         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11269
11270   and is_attrs_interleave = function
11271     | [Interleave _] -> true
11272     | Attribute _ :: fields -> is_attrs_interleave fields
11273     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11274     | _ -> false
11275
11276   and get_attrs_interleave = function
11277     | [Interleave fields] -> [], fields
11278     | ((Attribute _) as field) :: fields
11279     | ((Optional (Attribute _)) as field) :: fields ->
11280         let attrs, interleaves = get_attrs_interleave fields in
11281         (field :: attrs), interleaves
11282     | _ -> assert false
11283
11284   and generate_parsers xs =
11285     List.iter (fun x -> ignore (generate_parser x)) xs
11286
11287   and generate_parser_struct name (attrs, interleaves) =
11288     (* Generate parsers for the fields first.  We have to do this
11289      * before printing anything so we are still in BOL context.
11290      *)
11291     let fields = attrs @ interleaves in
11292     let pas = List.map generate_parser fields in
11293
11294     (* Generate an intermediate tuple from all the fields first.
11295      * If the type is just a string + another field, then we will
11296      * return this directly, otherwise it is turned into a record.
11297      *
11298      * RELAX NG note: This code treats <interleave> and plain lists of
11299      * fields the same.  In other words, it doesn't bother enforcing
11300      * any ordering of fields in the XML.
11301      *)
11302     pr "let parse_%s x =\n" name;
11303     pr "  let t = (\n    ";
11304     let comma = ref false in
11305     List.iter (
11306       fun x ->
11307         if !comma then pr ",\n    ";
11308         comma := true;
11309         match x with
11310         | Optional (Attribute (fname, [field])), pa ->
11311             pr "%s x" pa
11312         | Optional (Element (fname, [field])), pa ->
11313             pr "%s (optional_child %S x)" pa fname
11314         | Attribute (fname, [Text]), _ ->
11315             pr "attribute %S x" fname
11316         | (ZeroOrMore _ | OneOrMore _), pa ->
11317             pr "%s x" pa
11318         | Text, pa ->
11319             pr "%s x" pa
11320         | (field, pa) ->
11321             let fname = name_of_field field in
11322             pr "%s (child %S x)" pa fname
11323     ) (List.combine fields pas);
11324     pr "\n  ) in\n";
11325
11326     (match fields with
11327      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11328          pr "  t\n"
11329
11330      | _ ->
11331          pr "  (Obj.magic t : %s)\n" name
11332 (*
11333          List.iter (
11334            function
11335            | (Optional (Attribute (fname, [field])), pa) ->
11336                pr "  %s_%s =\n" name fname;
11337                pr "    %s x;\n" pa
11338            | (Optional (Element (fname, [field])), pa) ->
11339                pr "  %s_%s =\n" name fname;
11340                pr "    (let x = optional_child %S x in\n" fname;
11341                pr "     %s x);\n" pa
11342            | (field, pa) ->
11343                let fname = name_of_field field in
11344                pr "  %s_%s =\n" name fname;
11345                pr "    (let x = child %S x in\n" fname;
11346                pr "     %s x);\n" pa
11347          ) (List.combine fields pas);
11348          pr "}\n"
11349 *)
11350     );
11351     sprintf "parse_%s" name
11352   in
11353
11354   generate_parsers xs
11355
11356 (* Generate ocaml/guestfs_inspector.mli. *)
11357 let generate_ocaml_inspector_mli () =
11358   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11359
11360   pr "\
11361 (** This is an OCaml language binding to the external [virt-inspector]
11362     program.
11363
11364     For more information, please read the man page [virt-inspector(1)].
11365 *)
11366
11367 ";
11368
11369   generate_types grammar;
11370   pr "(** The nested information returned from the {!inspect} function. *)\n";
11371   pr "\n";
11372
11373   pr "\
11374 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11375 (** To inspect a libvirt domain called [name], pass a singleton
11376     list: [inspect [name]].  When using libvirt only, you may
11377     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11378
11379     To inspect a disk image or images, pass a list of the filenames
11380     of the disk images: [inspect filenames]
11381
11382     This function inspects the given guest or disk images and
11383     returns a list of operating system(s) found and a large amount
11384     of information about them.  In the vast majority of cases,
11385     a virtual machine only contains a single operating system.
11386
11387     If the optional [~xml] parameter is given, then this function
11388     skips running the external virt-inspector program and just
11389     parses the given XML directly (which is expected to be XML
11390     produced from a previous run of virt-inspector).  The list of
11391     names and connect URI are ignored in this case.
11392
11393     This function can throw a wide variety of exceptions, for example
11394     if the external virt-inspector program cannot be found, or if
11395     it doesn't generate valid XML.
11396 *)
11397 "
11398
11399 (* Generate ocaml/guestfs_inspector.ml. *)
11400 let generate_ocaml_inspector_ml () =
11401   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11402
11403   pr "open Unix\n";
11404   pr "\n";
11405
11406   generate_types grammar;
11407   pr "\n";
11408
11409   pr "\
11410 (* Misc functions which are used by the parser code below. *)
11411 let first_child = function
11412   | Xml.Element (_, _, c::_) -> c
11413   | Xml.Element (name, _, []) ->
11414       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11415   | Xml.PCData str ->
11416       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11417
11418 let string_child_or_empty = function
11419   | Xml.Element (_, _, [Xml.PCData s]) -> s
11420   | Xml.Element (_, _, []) -> \"\"
11421   | Xml.Element (x, _, _) ->
11422       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11423                 x ^ \" instead\")
11424   | Xml.PCData str ->
11425       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11426
11427 let optional_child name xml =
11428   let children = Xml.children xml in
11429   try
11430     Some (List.find (function
11431                      | Xml.Element (n, _, _) when n = name -> true
11432                      | _ -> false) children)
11433   with
11434     Not_found -> None
11435
11436 let child name xml =
11437   match optional_child name xml with
11438   | Some c -> c
11439   | None ->
11440       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11441
11442 let attribute name xml =
11443   try Xml.attrib xml name
11444   with Xml.No_attribute _ ->
11445     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11446
11447 ";
11448
11449   generate_parsers grammar;
11450   pr "\n";
11451
11452   pr "\
11453 (* Run external virt-inspector, then use parser to parse the XML. *)
11454 let inspect ?connect ?xml names =
11455   let xml =
11456     match xml with
11457     | None ->
11458         if names = [] then invalid_arg \"inspect: no names given\";
11459         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11460           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11461           names in
11462         let cmd = List.map Filename.quote cmd in
11463         let cmd = String.concat \" \" cmd in
11464         let chan = open_process_in cmd in
11465         let xml = Xml.parse_in chan in
11466         (match close_process_in chan with
11467          | WEXITED 0 -> ()
11468          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11469          | WSIGNALED i | WSTOPPED i ->
11470              failwith (\"external virt-inspector command died or stopped on sig \" ^
11471                        string_of_int i)
11472         );
11473         xml
11474     | Some doc ->
11475         Xml.parse_string doc in
11476   parse_operatingsystems xml
11477 "
11478
11479 (* This is used to generate the src/MAX_PROC_NR file which
11480  * contains the maximum procedure number, a surrogate for the
11481  * ABI version number.  See src/Makefile.am for the details.
11482  *)
11483 and generate_max_proc_nr () =
11484   let proc_nrs = List.map (
11485     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11486   ) daemon_functions in
11487
11488   let max_proc_nr = List.fold_left max 0 proc_nrs in
11489
11490   pr "%d\n" max_proc_nr
11491
11492 let output_to filename k =
11493   let filename_new = filename ^ ".new" in
11494   chan := open_out filename_new;
11495   k ();
11496   close_out !chan;
11497   chan := Pervasives.stdout;
11498
11499   (* Is the new file different from the current file? *)
11500   if Sys.file_exists filename && files_equal filename filename_new then
11501     unlink filename_new                 (* same, so skip it *)
11502   else (
11503     (* different, overwrite old one *)
11504     (try chmod filename 0o644 with Unix_error _ -> ());
11505     rename filename_new filename;
11506     chmod filename 0o444;
11507     printf "written %s\n%!" filename;
11508   )
11509
11510 let perror msg = function
11511   | Unix_error (err, _, _) ->
11512       eprintf "%s: %s\n" msg (error_message err)
11513   | exn ->
11514       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11515
11516 (* Main program. *)
11517 let () =
11518   let lock_fd =
11519     try openfile "HACKING" [O_RDWR] 0
11520     with
11521     | Unix_error (ENOENT, _, _) ->
11522         eprintf "\
11523 You are probably running this from the wrong directory.
11524 Run it from the top source directory using the command
11525   src/generator.ml
11526 ";
11527         exit 1
11528     | exn ->
11529         perror "open: HACKING" exn;
11530         exit 1 in
11531
11532   (* Acquire a lock so parallel builds won't try to run the generator
11533    * twice at the same time.  Subsequent builds will wait for the first
11534    * one to finish.  Note the lock is released implicitly when the
11535    * program exits.
11536    *)
11537   (try lockf lock_fd F_LOCK 1
11538    with exn ->
11539      perror "lock: HACKING" exn;
11540      exit 1);
11541
11542   check_functions ();
11543
11544   output_to "src/guestfs_protocol.x" generate_xdr;
11545   output_to "src/guestfs-structs.h" generate_structs_h;
11546   output_to "src/guestfs-actions.h" generate_actions_h;
11547   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11548   output_to "src/guestfs-actions.c" generate_client_actions;
11549   output_to "src/guestfs-bindtests.c" generate_bindtests;
11550   output_to "src/guestfs-structs.pod" generate_structs_pod;
11551   output_to "src/guestfs-actions.pod" generate_actions_pod;
11552   output_to "src/guestfs-availability.pod" generate_availability_pod;
11553   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11554   output_to "src/libguestfs.syms" generate_linker_script;
11555   output_to "daemon/actions.h" generate_daemon_actions_h;
11556   output_to "daemon/stubs.c" generate_daemon_actions;
11557   output_to "daemon/names.c" generate_daemon_names;
11558   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11559   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11560   output_to "capitests/tests.c" generate_tests;
11561   output_to "fish/cmds.c" generate_fish_cmds;
11562   output_to "fish/completion.c" generate_fish_completion;
11563   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11564   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11565   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11566   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11567   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11568   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11569   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11570   output_to "perl/Guestfs.xs" generate_perl_xs;
11571   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11572   output_to "perl/bindtests.pl" generate_perl_bindtests;
11573   output_to "python/guestfs-py.c" generate_python_c;
11574   output_to "python/guestfs.py" generate_python_py;
11575   output_to "python/bindtests.py" generate_python_bindtests;
11576   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11577   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11578   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11579
11580   List.iter (
11581     fun (typ, jtyp) ->
11582       let cols = cols_of_struct typ in
11583       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11584       output_to filename (generate_java_struct jtyp cols);
11585   ) java_structs;
11586
11587   output_to "java/Makefile.inc" generate_java_makefile_inc;
11588   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11589   output_to "java/Bindtests.java" generate_java_bindtests;
11590   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11591   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11592   output_to "csharp/Libguestfs.cs" generate_csharp;
11593
11594   (* Always generate this file last, and unconditionally.  It's used
11595    * by the Makefile to know when we must re-run the generator.
11596    *)
11597   let chan = open_out "src/stamp-generator" in
11598   fprintf chan "1\n";
11599   close_out chan;
11600
11601   printf "generated %d lines of code\n" !lines