fc3dc34c53a47734c9b27d9aa6d23f55c266ab7d
[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, [String "qemu"]), -1, [FishAlias "qemu"],
576    [],
577    "set the qemu binary",
578    "\
579 Set the qemu binary that we will use.
580
581 The default is chosen when the library was compiled by the
582 configure script.
583
584 You can also override this by setting the C<LIBGUESTFS_QEMU>
585 environment variable.
586
587 Setting C<qemu> to C<NULL> restores the default qemu binary.
588
589 Note that you should call this function as early as possible
590 after creating the handle.  This is because some pre-launch
591 operations depend on testing qemu features (by running C<qemu -help>).
592 If the qemu binary changes, we don't retest features, and
593 so you might see inconsistent results.  Using the environment
594 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
595 the qemu binary at the same time as the handle is created.");
596
597   ("get_qemu", (RConstString "qemu", []), -1, [],
598    [InitNone, Always, TestRun (
599       [["get_qemu"]])],
600    "get the qemu binary",
601    "\
602 Return the current qemu binary.
603
604 This is always non-NULL.  If it wasn't set already, then this will
605 return the default qemu binary name.");
606
607   ("set_path", (RErr, [String "searchpath"]), -1, [FishAlias "path"],
608    [],
609    "set the search path",
610    "\
611 Set the path that libguestfs searches for kernel and initrd.img.
612
613 The default is C<$libdir/guestfs> unless overridden by setting
614 C<LIBGUESTFS_PATH> environment variable.
615
616 Setting C<path> to C<NULL> restores the default path.");
617
618   ("get_path", (RConstString "path", []), -1, [],
619    [InitNone, Always, TestRun (
620       [["get_path"]])],
621    "get the search path",
622    "\
623 Return the current search path.
624
625 This is always non-NULL.  If it wasn't set already, then this will
626 return the default path.");
627
628   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
629    [],
630    "add options to kernel command line",
631    "\
632 This function is used to add additional options to the
633 guest kernel command line.
634
635 The default is C<NULL> unless overridden by setting
636 C<LIBGUESTFS_APPEND> environment variable.
637
638 Setting C<append> to C<NULL> means I<no> additional options
639 are passed (libguestfs always adds a few of its own).");
640
641   ("get_append", (RConstOptString "append", []), -1, [],
642    (* This cannot be tested with the current framework.  The
643     * function can return NULL in normal operations, which the
644     * test framework interprets as an error.
645     *)
646    [],
647    "get the additional kernel options",
648    "\
649 Return the additional kernel options which are added to the
650 guest kernel command line.
651
652 If C<NULL> then no options are added.");
653
654   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
655    [],
656    "set autosync mode",
657    "\
658 If C<autosync> is true, this enables autosync.  Libguestfs will make a
659 best effort attempt to run C<guestfs_umount_all> followed by
660 C<guestfs_sync> when the handle is closed
661 (also if the program exits without closing handles).
662
663 This is disabled by default (except in guestfish where it is
664 enabled by default).");
665
666   ("get_autosync", (RBool "autosync", []), -1, [],
667    [InitNone, Always, TestRun (
668       [["get_autosync"]])],
669    "get autosync mode",
670    "\
671 Get the autosync flag.");
672
673   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
674    [],
675    "set verbose mode",
676    "\
677 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
678
679 Verbose messages are disabled unless the environment variable
680 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
681
682   ("get_verbose", (RBool "verbose", []), -1, [],
683    [],
684    "get verbose mode",
685    "\
686 This returns the verbose messages flag.");
687
688   ("is_ready", (RBool "ready", []), -1, [],
689    [InitNone, Always, TestOutputTrue (
690       [["is_ready"]])],
691    "is ready to accept commands",
692    "\
693 This returns true iff this handle is ready to accept commands
694 (in the C<READY> state).
695
696 For more information on states, see L<guestfs(3)>.");
697
698   ("is_config", (RBool "config", []), -1, [],
699    [InitNone, Always, TestOutputFalse (
700       [["is_config"]])],
701    "is in configuration state",
702    "\
703 This returns true iff this handle is being configured
704 (in the C<CONFIG> state).
705
706 For more information on states, see L<guestfs(3)>.");
707
708   ("is_launching", (RBool "launching", []), -1, [],
709    [InitNone, Always, TestOutputFalse (
710       [["is_launching"]])],
711    "is launching subprocess",
712    "\
713 This returns true iff this handle is launching the subprocess
714 (in the C<LAUNCHING> state).
715
716 For more information on states, see L<guestfs(3)>.");
717
718   ("is_busy", (RBool "busy", []), -1, [],
719    [InitNone, Always, TestOutputFalse (
720       [["is_busy"]])],
721    "is busy processing a command",
722    "\
723 This returns true iff this handle is busy processing a command
724 (in the C<BUSY> state).
725
726 For more information on states, see L<guestfs(3)>.");
727
728   ("get_state", (RInt "state", []), -1, [],
729    [],
730    "get the current state",
731    "\
732 This returns the current state as an opaque integer.  This is
733 only useful for printing debug and internal error messages.
734
735 For more information on states, see L<guestfs(3)>.");
736
737   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
738    [InitNone, Always, TestOutputInt (
739       [["set_memsize"; "500"];
740        ["get_memsize"]], 500)],
741    "set memory allocated to the qemu subprocess",
742    "\
743 This sets the memory size in megabytes allocated to the
744 qemu subprocess.  This only has any effect if called before
745 C<guestfs_launch>.
746
747 You can also change this by setting the environment
748 variable C<LIBGUESTFS_MEMSIZE> before the handle is
749 created.
750
751 For more information on the architecture of libguestfs,
752 see L<guestfs(3)>.");
753
754   ("get_memsize", (RInt "memsize", []), -1, [],
755    [InitNone, Always, TestOutputIntOp (
756       [["get_memsize"]], ">=", 256)],
757    "get memory allocated to the qemu subprocess",
758    "\
759 This gets the memory size in megabytes allocated to the
760 qemu subprocess.
761
762 If C<guestfs_set_memsize> was not called
763 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
764 then this returns the compiled-in default value for memsize.
765
766 For more information on the architecture of libguestfs,
767 see L<guestfs(3)>.");
768
769   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
770    [InitNone, Always, TestOutputIntOp (
771       [["get_pid"]], ">=", 1)],
772    "get PID of qemu subprocess",
773    "\
774 Return the process ID of the qemu subprocess.  If there is no
775 qemu subprocess, then this will return an error.
776
777 This is an internal call used for debugging and testing.");
778
779   ("version", (RStruct ("version", "version"), []), -1, [],
780    [InitNone, Always, TestOutputStruct (
781       [["version"]], [CompareWithInt ("major", 1)])],
782    "get the library version number",
783    "\
784 Return the libguestfs version number that the program is linked
785 against.
786
787 Note that because of dynamic linking this is not necessarily
788 the version of libguestfs that you compiled against.  You can
789 compile the program, and then at runtime dynamically link
790 against a completely different C<libguestfs.so> library.
791
792 This call was added in version C<1.0.58>.  In previous
793 versions of libguestfs there was no way to get the version
794 number.  From C code you can use ELF weak linking tricks to find out if
795 this symbol exists (if it doesn't, then it's an earlier version).
796
797 The call returns a structure with four elements.  The first
798 three (C<major>, C<minor> and C<release>) are numbers and
799 correspond to the usual version triplet.  The fourth element
800 (C<extra>) is a string and is normally empty, but may be
801 used for distro-specific information.
802
803 To construct the original version string:
804 C<$major.$minor.$release$extra>
805
806 I<Note:> Don't use this call to test for availability
807 of features.  Distro backports makes this unreliable.  Use
808 C<guestfs_available> instead.");
809
810   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
811    [InitNone, Always, TestOutputTrue (
812       [["set_selinux"; "true"];
813        ["get_selinux"]])],
814    "set SELinux enabled or disabled at appliance boot",
815    "\
816 This sets the selinux flag that is passed to the appliance
817 at boot time.  The default is C<selinux=0> (disabled).
818
819 Note that if SELinux is enabled, it is always in
820 Permissive mode (C<enforcing=0>).
821
822 For more information on the architecture of libguestfs,
823 see L<guestfs(3)>.");
824
825   ("get_selinux", (RBool "selinux", []), -1, [],
826    [],
827    "get SELinux enabled flag",
828    "\
829 This returns the current setting of the selinux flag which
830 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
831
832 For more information on the architecture of libguestfs,
833 see L<guestfs(3)>.");
834
835   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
836    [InitNone, Always, TestOutputFalse (
837       [["set_trace"; "false"];
838        ["get_trace"]])],
839    "enable or disable command traces",
840    "\
841 If the command trace flag is set to 1, then commands are
842 printed on stdout before they are executed in a format
843 which is very similar to the one used by guestfish.  In
844 other words, you can run a program with this enabled, and
845 you will get out a script which you can feed to guestfish
846 to perform the same set of actions.
847
848 If you want to trace C API calls into libguestfs (and
849 other libraries) then possibly a better way is to use
850 the external ltrace(1) command.
851
852 Command traces are disabled unless the environment variable
853 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
854
855   ("get_trace", (RBool "trace", []), -1, [],
856    [],
857    "get command trace enabled flag",
858    "\
859 Return the command trace flag.");
860
861   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
862    [InitNone, Always, TestOutputFalse (
863       [["set_direct"; "false"];
864        ["get_direct"]])],
865    "enable or disable direct appliance mode",
866    "\
867 If the direct appliance mode flag is enabled, then stdin and
868 stdout are passed directly through to the appliance once it
869 is launched.
870
871 One consequence of this is that log messages aren't caught
872 by the library and handled by C<guestfs_set_log_message_callback>,
873 but go straight to stdout.
874
875 You probably don't want to use this unless you know what you
876 are doing.
877
878 The default is disabled.");
879
880   ("get_direct", (RBool "direct", []), -1, [],
881    [],
882    "get direct appliance mode flag",
883    "\
884 Return the direct appliance mode flag.");
885
886   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
887    [InitNone, Always, TestOutputTrue (
888       [["set_recovery_proc"; "true"];
889        ["get_recovery_proc"]])],
890    "enable or disable the recovery process",
891    "\
892 If this is called with the parameter C<false> then
893 C<guestfs_launch> does not create a recovery process.  The
894 purpose of the recovery process is to stop runaway qemu
895 processes in the case where the main program aborts abruptly.
896
897 This only has any effect if called before C<guestfs_launch>,
898 and the default is true.
899
900 About the only time when you would want to disable this is
901 if the main process will fork itself into the background
902 (\"daemonize\" itself).  In this case the recovery process
903 thinks that the main program has disappeared and so kills
904 qemu, which is not very helpful.");
905
906   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
907    [],
908    "get recovery process enabled flag",
909    "\
910 Return the recovery process enabled flag.");
911
912   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
913    [],
914    "add a drive specifying the QEMU block emulation to use",
915    "\
916 This is the same as C<guestfs_add_drive> but it allows you
917 to specify the QEMU interface emulation to use at run time.");
918
919   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
920    [],
921    "add a drive read-only specifying the QEMU block emulation to use",
922    "\
923 This is the same as C<guestfs_add_drive_ro> but it allows you
924 to specify the QEMU interface emulation to use at run time.");
925
926 ]
927
928 (* daemon_functions are any functions which cause some action
929  * to take place in the daemon.
930  *)
931
932 let daemon_functions = [
933   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
934    [InitEmpty, Always, TestOutput (
935       [["part_disk"; "/dev/sda"; "mbr"];
936        ["mkfs"; "ext2"; "/dev/sda1"];
937        ["mount"; "/dev/sda1"; "/"];
938        ["write_file"; "/new"; "new file contents"; "0"];
939        ["cat"; "/new"]], "new file contents")],
940    "mount a guest disk at a position in the filesystem",
941    "\
942 Mount a guest disk at a position in the filesystem.  Block devices
943 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
944 the guest.  If those block devices contain partitions, they will have
945 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
946 names can be used.
947
948 The rules are the same as for L<mount(2)>:  A filesystem must
949 first be mounted on C</> before others can be mounted.  Other
950 filesystems can only be mounted on directories which already
951 exist.
952
953 The mounted filesystem is writable, if we have sufficient permissions
954 on the underlying device.
955
956 The filesystem options C<sync> and C<noatime> are set with this
957 call, in order to improve reliability.");
958
959   ("sync", (RErr, []), 2, [],
960    [ InitEmpty, Always, TestRun [["sync"]]],
961    "sync disks, writes are flushed through to the disk image",
962    "\
963 This syncs the disk, so that any writes are flushed through to the
964 underlying disk image.
965
966 You should always call this if you have modified a disk image, before
967 closing the handle.");
968
969   ("touch", (RErr, [Pathname "path"]), 3, [],
970    [InitBasicFS, Always, TestOutputTrue (
971       [["touch"; "/new"];
972        ["exists"; "/new"]])],
973    "update file timestamps or create a new file",
974    "\
975 Touch acts like the L<touch(1)> command.  It can be used to
976 update the timestamps on a file, or, if the file does not exist,
977 to create a new zero-length file.");
978
979   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
980    [InitISOFS, Always, TestOutput (
981       [["cat"; "/known-2"]], "abcdef\n")],
982    "list the contents of a file",
983    "\
984 Return the contents of the file named C<path>.
985
986 Note that this function cannot correctly handle binary files
987 (specifically, files containing C<\\0> character which is treated
988 as end of string).  For those you need to use the C<guestfs_read_file>
989 or C<guestfs_download> functions which have a more complex interface.");
990
991   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
992    [], (* XXX Tricky to test because it depends on the exact format
993         * of the 'ls -l' command, which changes between F10 and F11.
994         *)
995    "list the files in a directory (long format)",
996    "\
997 List the files in C<directory> (relative to the root directory,
998 there is no cwd) in the format of 'ls -la'.
999
1000 This command is mostly useful for interactive sessions.  It
1001 is I<not> intended that you try to parse the output string.");
1002
1003   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1004    [InitBasicFS, Always, TestOutputList (
1005       [["touch"; "/new"];
1006        ["touch"; "/newer"];
1007        ["touch"; "/newest"];
1008        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1009    "list the files in a directory",
1010    "\
1011 List the files in C<directory> (relative to the root directory,
1012 there is no cwd).  The '.' and '..' entries are not returned, but
1013 hidden files are shown.
1014
1015 This command is mostly useful for interactive sessions.  Programs
1016 should probably use C<guestfs_readdir> instead.");
1017
1018   ("list_devices", (RStringList "devices", []), 7, [],
1019    [InitEmpty, Always, TestOutputListOfDevices (
1020       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1021    "list the block devices",
1022    "\
1023 List all the block devices.
1024
1025 The full block device names are returned, eg. C</dev/sda>");
1026
1027   ("list_partitions", (RStringList "partitions", []), 8, [],
1028    [InitBasicFS, Always, TestOutputListOfDevices (
1029       [["list_partitions"]], ["/dev/sda1"]);
1030     InitEmpty, Always, TestOutputListOfDevices (
1031       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1032        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1033    "list the partitions",
1034    "\
1035 List all the partitions detected on all block devices.
1036
1037 The full partition device names are returned, eg. C</dev/sda1>
1038
1039 This does not return logical volumes.  For that you will need to
1040 call C<guestfs_lvs>.");
1041
1042   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1043    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1044       [["pvs"]], ["/dev/sda1"]);
1045     InitEmpty, Always, TestOutputListOfDevices (
1046       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1047        ["pvcreate"; "/dev/sda1"];
1048        ["pvcreate"; "/dev/sda2"];
1049        ["pvcreate"; "/dev/sda3"];
1050        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1051    "list the LVM physical volumes (PVs)",
1052    "\
1053 List all the physical volumes detected.  This is the equivalent
1054 of the L<pvs(8)> command.
1055
1056 This returns a list of just the device names that contain
1057 PVs (eg. C</dev/sda2>).
1058
1059 See also C<guestfs_pvs_full>.");
1060
1061   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1062    [InitBasicFSonLVM, Always, TestOutputList (
1063       [["vgs"]], ["VG"]);
1064     InitEmpty, Always, TestOutputList (
1065       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1066        ["pvcreate"; "/dev/sda1"];
1067        ["pvcreate"; "/dev/sda2"];
1068        ["pvcreate"; "/dev/sda3"];
1069        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1070        ["vgcreate"; "VG2"; "/dev/sda3"];
1071        ["vgs"]], ["VG1"; "VG2"])],
1072    "list the LVM volume groups (VGs)",
1073    "\
1074 List all the volumes groups detected.  This is the equivalent
1075 of the L<vgs(8)> command.
1076
1077 This returns a list of just the volume group names that were
1078 detected (eg. C<VolGroup00>).
1079
1080 See also C<guestfs_vgs_full>.");
1081
1082   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1083    [InitBasicFSonLVM, Always, TestOutputList (
1084       [["lvs"]], ["/dev/VG/LV"]);
1085     InitEmpty, Always, TestOutputList (
1086       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1087        ["pvcreate"; "/dev/sda1"];
1088        ["pvcreate"; "/dev/sda2"];
1089        ["pvcreate"; "/dev/sda3"];
1090        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1091        ["vgcreate"; "VG2"; "/dev/sda3"];
1092        ["lvcreate"; "LV1"; "VG1"; "50"];
1093        ["lvcreate"; "LV2"; "VG1"; "50"];
1094        ["lvcreate"; "LV3"; "VG2"; "50"];
1095        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1096    "list the LVM logical volumes (LVs)",
1097    "\
1098 List all the logical volumes detected.  This is the equivalent
1099 of the L<lvs(8)> command.
1100
1101 This returns a list of the logical volume device names
1102 (eg. C</dev/VolGroup00/LogVol00>).
1103
1104 See also C<guestfs_lvs_full>.");
1105
1106   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1107    [], (* XXX how to test? *)
1108    "list the LVM physical volumes (PVs)",
1109    "\
1110 List all the physical volumes detected.  This is the equivalent
1111 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1112
1113   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1114    [], (* XXX how to test? *)
1115    "list the LVM volume groups (VGs)",
1116    "\
1117 List all the volumes groups detected.  This is the equivalent
1118 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1119
1120   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1121    [], (* XXX how to test? *)
1122    "list the LVM logical volumes (LVs)",
1123    "\
1124 List all the logical volumes detected.  This is the equivalent
1125 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1126
1127   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1128    [InitISOFS, Always, TestOutputList (
1129       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1130     InitISOFS, Always, TestOutputList (
1131       [["read_lines"; "/empty"]], [])],
1132    "read file as lines",
1133    "\
1134 Return the contents of the file named C<path>.
1135
1136 The file contents are returned as a list of lines.  Trailing
1137 C<LF> and C<CRLF> character sequences are I<not> returned.
1138
1139 Note that this function cannot correctly handle binary files
1140 (specifically, files containing C<\\0> character which is treated
1141 as end of line).  For those you need to use the C<guestfs_read_file>
1142 function which has a more complex interface.");
1143
1144   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1145    [], (* XXX Augeas code needs tests. *)
1146    "create a new Augeas handle",
1147    "\
1148 Create a new Augeas handle for editing configuration files.
1149 If there was any previous Augeas handle associated with this
1150 guestfs session, then it is closed.
1151
1152 You must call this before using any other C<guestfs_aug_*>
1153 commands.
1154
1155 C<root> is the filesystem root.  C<root> must not be NULL,
1156 use C</> instead.
1157
1158 The flags are the same as the flags defined in
1159 E<lt>augeas.hE<gt>, the logical I<or> of the following
1160 integers:
1161
1162 =over 4
1163
1164 =item C<AUG_SAVE_BACKUP> = 1
1165
1166 Keep the original file with a C<.augsave> extension.
1167
1168 =item C<AUG_SAVE_NEWFILE> = 2
1169
1170 Save changes into a file with extension C<.augnew>, and
1171 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1172
1173 =item C<AUG_TYPE_CHECK> = 4
1174
1175 Typecheck lenses (can be expensive).
1176
1177 =item C<AUG_NO_STDINC> = 8
1178
1179 Do not use standard load path for modules.
1180
1181 =item C<AUG_SAVE_NOOP> = 16
1182
1183 Make save a no-op, just record what would have been changed.
1184
1185 =item C<AUG_NO_LOAD> = 32
1186
1187 Do not load the tree in C<guestfs_aug_init>.
1188
1189 =back
1190
1191 To close the handle, you can call C<guestfs_aug_close>.
1192
1193 To find out more about Augeas, see L<http://augeas.net/>.");
1194
1195   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1196    [], (* XXX Augeas code needs tests. *)
1197    "close the current Augeas handle",
1198    "\
1199 Close the current Augeas handle and free up any resources
1200 used by it.  After calling this, you have to call
1201 C<guestfs_aug_init> again before you can use any other
1202 Augeas functions.");
1203
1204   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1205    [], (* XXX Augeas code needs tests. *)
1206    "define an Augeas variable",
1207    "\
1208 Defines an Augeas variable C<name> whose value is the result
1209 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1210 undefined.
1211
1212 On success this returns the number of nodes in C<expr>, or
1213 C<0> if C<expr> evaluates to something which is not a nodeset.");
1214
1215   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1216    [], (* XXX Augeas code needs tests. *)
1217    "define an Augeas node",
1218    "\
1219 Defines a variable C<name> whose value is the result of
1220 evaluating C<expr>.
1221
1222 If C<expr> evaluates to an empty nodeset, a node is created,
1223 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1224 C<name> will be the nodeset containing that single node.
1225
1226 On success this returns a pair containing the
1227 number of nodes in the nodeset, and a boolean flag
1228 if a node was created.");
1229
1230   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1231    [], (* XXX Augeas code needs tests. *)
1232    "look up the value of an Augeas path",
1233    "\
1234 Look up the value associated with C<path>.  If C<path>
1235 matches exactly one node, the C<value> is returned.");
1236
1237   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1238    [], (* XXX Augeas code needs tests. *)
1239    "set Augeas path to value",
1240    "\
1241 Set the value associated with C<path> to C<value>.");
1242
1243   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1244    [], (* XXX Augeas code needs tests. *)
1245    "insert a sibling Augeas node",
1246    "\
1247 Create a new sibling C<label> for C<path>, inserting it into
1248 the tree before or after C<path> (depending on the boolean
1249 flag C<before>).
1250
1251 C<path> must match exactly one existing node in the tree, and
1252 C<label> must be a label, ie. not contain C</>, C<*> or end
1253 with a bracketed index C<[N]>.");
1254
1255   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1256    [], (* XXX Augeas code needs tests. *)
1257    "remove an Augeas path",
1258    "\
1259 Remove C<path> and all of its children.
1260
1261 On success this returns the number of entries which were removed.");
1262
1263   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1264    [], (* XXX Augeas code needs tests. *)
1265    "move Augeas node",
1266    "\
1267 Move the node C<src> to C<dest>.  C<src> must match exactly
1268 one node.  C<dest> is overwritten if it exists.");
1269
1270   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1271    [], (* XXX Augeas code needs tests. *)
1272    "return Augeas nodes which match augpath",
1273    "\
1274 Returns a list of paths which match the path expression C<path>.
1275 The returned paths are sufficiently qualified so that they match
1276 exactly one node in the current tree.");
1277
1278   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1279    [], (* XXX Augeas code needs tests. *)
1280    "write all pending Augeas changes to disk",
1281    "\
1282 This writes all pending changes to disk.
1283
1284 The flags which were passed to C<guestfs_aug_init> affect exactly
1285 how files are saved.");
1286
1287   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1288    [], (* XXX Augeas code needs tests. *)
1289    "load files into the tree",
1290    "\
1291 Load files into the tree.
1292
1293 See C<aug_load> in the Augeas documentation for the full gory
1294 details.");
1295
1296   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1297    [], (* XXX Augeas code needs tests. *)
1298    "list Augeas nodes under augpath",
1299    "\
1300 This is just a shortcut for listing C<guestfs_aug_match>
1301 C<path/*> and sorting the resulting nodes into alphabetical order.");
1302
1303   ("rm", (RErr, [Pathname "path"]), 29, [],
1304    [InitBasicFS, Always, TestRun
1305       [["touch"; "/new"];
1306        ["rm"; "/new"]];
1307     InitBasicFS, Always, TestLastFail
1308       [["rm"; "/new"]];
1309     InitBasicFS, Always, TestLastFail
1310       [["mkdir"; "/new"];
1311        ["rm"; "/new"]]],
1312    "remove a file",
1313    "\
1314 Remove the single file C<path>.");
1315
1316   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1317    [InitBasicFS, Always, TestRun
1318       [["mkdir"; "/new"];
1319        ["rmdir"; "/new"]];
1320     InitBasicFS, Always, TestLastFail
1321       [["rmdir"; "/new"]];
1322     InitBasicFS, Always, TestLastFail
1323       [["touch"; "/new"];
1324        ["rmdir"; "/new"]]],
1325    "remove a directory",
1326    "\
1327 Remove the single directory C<path>.");
1328
1329   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1330    [InitBasicFS, Always, TestOutputFalse
1331       [["mkdir"; "/new"];
1332        ["mkdir"; "/new/foo"];
1333        ["touch"; "/new/foo/bar"];
1334        ["rm_rf"; "/new"];
1335        ["exists"; "/new"]]],
1336    "remove a file or directory recursively",
1337    "\
1338 Remove the file or directory C<path>, recursively removing the
1339 contents if its a directory.  This is like the C<rm -rf> shell
1340 command.");
1341
1342   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1343    [InitBasicFS, Always, TestOutputTrue
1344       [["mkdir"; "/new"];
1345        ["is_dir"; "/new"]];
1346     InitBasicFS, Always, TestLastFail
1347       [["mkdir"; "/new/foo/bar"]]],
1348    "create a directory",
1349    "\
1350 Create a directory named C<path>.");
1351
1352   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1353    [InitBasicFS, Always, TestOutputTrue
1354       [["mkdir_p"; "/new/foo/bar"];
1355        ["is_dir"; "/new/foo/bar"]];
1356     InitBasicFS, Always, TestOutputTrue
1357       [["mkdir_p"; "/new/foo/bar"];
1358        ["is_dir"; "/new/foo"]];
1359     InitBasicFS, Always, TestOutputTrue
1360       [["mkdir_p"; "/new/foo/bar"];
1361        ["is_dir"; "/new"]];
1362     (* Regression tests for RHBZ#503133: *)
1363     InitBasicFS, Always, TestRun
1364       [["mkdir"; "/new"];
1365        ["mkdir_p"; "/new"]];
1366     InitBasicFS, Always, TestLastFail
1367       [["touch"; "/new"];
1368        ["mkdir_p"; "/new"]]],
1369    "create a directory and parents",
1370    "\
1371 Create a directory named C<path>, creating any parent directories
1372 as necessary.  This is like the C<mkdir -p> shell command.");
1373
1374   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1375    [], (* XXX Need stat command to test *)
1376    "change file mode",
1377    "\
1378 Change the mode (permissions) of C<path> to C<mode>.  Only
1379 numeric modes are supported.
1380
1381 I<Note>: When using this command from guestfish, C<mode>
1382 by default would be decimal, unless you prefix it with
1383 C<0> to get octal, ie. use C<0700> not C<700>.
1384
1385 The mode actually set is affected by the umask.");
1386
1387   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1388    [], (* XXX Need stat command to test *)
1389    "change file owner and group",
1390    "\
1391 Change the file owner to C<owner> and group to C<group>.
1392
1393 Only numeric uid and gid are supported.  If you want to use
1394 names, you will need to locate and parse the password file
1395 yourself (Augeas support makes this relatively easy).");
1396
1397   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1398    [InitISOFS, Always, TestOutputTrue (
1399       [["exists"; "/empty"]]);
1400     InitISOFS, Always, TestOutputTrue (
1401       [["exists"; "/directory"]])],
1402    "test if file or directory exists",
1403    "\
1404 This returns C<true> if and only if there is a file, directory
1405 (or anything) with the given C<path> name.
1406
1407 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1408
1409   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1410    [InitISOFS, Always, TestOutputTrue (
1411       [["is_file"; "/known-1"]]);
1412     InitISOFS, Always, TestOutputFalse (
1413       [["is_file"; "/directory"]])],
1414    "test if file exists",
1415    "\
1416 This returns C<true> if and only if there is a file
1417 with the given C<path> name.  Note that it returns false for
1418 other objects like directories.
1419
1420 See also C<guestfs_stat>.");
1421
1422   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1423    [InitISOFS, Always, TestOutputFalse (
1424       [["is_dir"; "/known-3"]]);
1425     InitISOFS, Always, TestOutputTrue (
1426       [["is_dir"; "/directory"]])],
1427    "test if file exists",
1428    "\
1429 This returns C<true> if and only if there is a directory
1430 with the given C<path> name.  Note that it returns false for
1431 other objects like files.
1432
1433 See also C<guestfs_stat>.");
1434
1435   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1436    [InitEmpty, Always, TestOutputListOfDevices (
1437       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1438        ["pvcreate"; "/dev/sda1"];
1439        ["pvcreate"; "/dev/sda2"];
1440        ["pvcreate"; "/dev/sda3"];
1441        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1442    "create an LVM physical volume",
1443    "\
1444 This creates an LVM physical volume on the named C<device>,
1445 where C<device> should usually be a partition name such
1446 as C</dev/sda1>.");
1447
1448   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1449    [InitEmpty, Always, TestOutputList (
1450       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1451        ["pvcreate"; "/dev/sda1"];
1452        ["pvcreate"; "/dev/sda2"];
1453        ["pvcreate"; "/dev/sda3"];
1454        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1455        ["vgcreate"; "VG2"; "/dev/sda3"];
1456        ["vgs"]], ["VG1"; "VG2"])],
1457    "create an LVM volume group",
1458    "\
1459 This creates an LVM volume group called C<volgroup>
1460 from the non-empty list of physical volumes C<physvols>.");
1461
1462   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1463    [InitEmpty, Always, TestOutputList (
1464       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1465        ["pvcreate"; "/dev/sda1"];
1466        ["pvcreate"; "/dev/sda2"];
1467        ["pvcreate"; "/dev/sda3"];
1468        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1469        ["vgcreate"; "VG2"; "/dev/sda3"];
1470        ["lvcreate"; "LV1"; "VG1"; "50"];
1471        ["lvcreate"; "LV2"; "VG1"; "50"];
1472        ["lvcreate"; "LV3"; "VG2"; "50"];
1473        ["lvcreate"; "LV4"; "VG2"; "50"];
1474        ["lvcreate"; "LV5"; "VG2"; "50"];
1475        ["lvs"]],
1476       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1477        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1478    "create an LVM logical volume",
1479    "\
1480 This creates an LVM logical volume called C<logvol>
1481 on the volume group C<volgroup>, with C<size> megabytes.");
1482
1483   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1484    [InitEmpty, Always, TestOutput (
1485       [["part_disk"; "/dev/sda"; "mbr"];
1486        ["mkfs"; "ext2"; "/dev/sda1"];
1487        ["mount_options"; ""; "/dev/sda1"; "/"];
1488        ["write_file"; "/new"; "new file contents"; "0"];
1489        ["cat"; "/new"]], "new file contents")],
1490    "make a filesystem",
1491    "\
1492 This creates a filesystem on C<device> (usually a partition
1493 or LVM logical volume).  The filesystem type is C<fstype>, for
1494 example C<ext3>.");
1495
1496   ("sfdisk", (RErr, [Device "device";
1497                      Int "cyls"; Int "heads"; Int "sectors";
1498                      StringList "lines"]), 43, [DangerWillRobinson],
1499    [],
1500    "create partitions on a block device",
1501    "\
1502 This is a direct interface to the L<sfdisk(8)> program for creating
1503 partitions on block devices.
1504
1505 C<device> should be a block device, for example C</dev/sda>.
1506
1507 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1508 and sectors on the device, which are passed directly to sfdisk as
1509 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1510 of these, then the corresponding parameter is omitted.  Usually for
1511 'large' disks, you can just pass C<0> for these, but for small
1512 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1513 out the right geometry and you will need to tell it.
1514
1515 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1516 information refer to the L<sfdisk(8)> manpage.
1517
1518 To create a single partition occupying the whole disk, you would
1519 pass C<lines> as a single element list, when the single element being
1520 the string C<,> (comma).
1521
1522 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1523 C<guestfs_part_init>");
1524
1525   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1526    [InitBasicFS, Always, TestOutput (
1527       [["write_file"; "/new"; "new file contents"; "0"];
1528        ["cat"; "/new"]], "new file contents");
1529     InitBasicFS, Always, TestOutput (
1530       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1531        ["cat"; "/new"]], "\nnew file contents\n");
1532     InitBasicFS, Always, TestOutput (
1533       [["write_file"; "/new"; "\n\n"; "0"];
1534        ["cat"; "/new"]], "\n\n");
1535     InitBasicFS, Always, TestOutput (
1536       [["write_file"; "/new"; ""; "0"];
1537        ["cat"; "/new"]], "");
1538     InitBasicFS, Always, TestOutput (
1539       [["write_file"; "/new"; "\n\n\n"; "0"];
1540        ["cat"; "/new"]], "\n\n\n");
1541     InitBasicFS, Always, TestOutput (
1542       [["write_file"; "/new"; "\n"; "0"];
1543        ["cat"; "/new"]], "\n")],
1544    "create a file",
1545    "\
1546 This call creates a file called C<path>.  The contents of the
1547 file is the string C<content> (which can contain any 8 bit data),
1548 with length C<size>.
1549
1550 As a special case, if C<size> is C<0>
1551 then the length is calculated using C<strlen> (so in this case
1552 the content cannot contain embedded ASCII NULs).
1553
1554 I<NB.> Owing to a bug, writing content containing ASCII NUL
1555 characters does I<not> work, even if the length is specified.
1556 We hope to resolve this bug in a future version.  In the meantime
1557 use C<guestfs_upload>.");
1558
1559   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1560    [InitEmpty, Always, TestOutputListOfDevices (
1561       [["part_disk"; "/dev/sda"; "mbr"];
1562        ["mkfs"; "ext2"; "/dev/sda1"];
1563        ["mount_options"; ""; "/dev/sda1"; "/"];
1564        ["mounts"]], ["/dev/sda1"]);
1565     InitEmpty, Always, TestOutputList (
1566       [["part_disk"; "/dev/sda"; "mbr"];
1567        ["mkfs"; "ext2"; "/dev/sda1"];
1568        ["mount_options"; ""; "/dev/sda1"; "/"];
1569        ["umount"; "/"];
1570        ["mounts"]], [])],
1571    "unmount a filesystem",
1572    "\
1573 This unmounts the given filesystem.  The filesystem may be
1574 specified either by its mountpoint (path) or the device which
1575 contains the filesystem.");
1576
1577   ("mounts", (RStringList "devices", []), 46, [],
1578    [InitBasicFS, Always, TestOutputListOfDevices (
1579       [["mounts"]], ["/dev/sda1"])],
1580    "show mounted filesystems",
1581    "\
1582 This returns the list of currently mounted filesystems.  It returns
1583 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1584
1585 Some internal mounts are not shown.
1586
1587 See also: C<guestfs_mountpoints>");
1588
1589   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1590    [InitBasicFS, Always, TestOutputList (
1591       [["umount_all"];
1592        ["mounts"]], []);
1593     (* check that umount_all can unmount nested mounts correctly: *)
1594     InitEmpty, Always, TestOutputList (
1595       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1596        ["mkfs"; "ext2"; "/dev/sda1"];
1597        ["mkfs"; "ext2"; "/dev/sda2"];
1598        ["mkfs"; "ext2"; "/dev/sda3"];
1599        ["mount_options"; ""; "/dev/sda1"; "/"];
1600        ["mkdir"; "/mp1"];
1601        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1602        ["mkdir"; "/mp1/mp2"];
1603        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1604        ["mkdir"; "/mp1/mp2/mp3"];
1605        ["umount_all"];
1606        ["mounts"]], [])],
1607    "unmount all filesystems",
1608    "\
1609 This unmounts all mounted filesystems.
1610
1611 Some internal mounts are not unmounted by this call.");
1612
1613   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1614    [],
1615    "remove all LVM LVs, VGs and PVs",
1616    "\
1617 This command removes all LVM logical volumes, volume groups
1618 and physical volumes.");
1619
1620   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1621    [InitISOFS, Always, TestOutput (
1622       [["file"; "/empty"]], "empty");
1623     InitISOFS, Always, TestOutput (
1624       [["file"; "/known-1"]], "ASCII text");
1625     InitISOFS, Always, TestLastFail (
1626       [["file"; "/notexists"]])],
1627    "determine file type",
1628    "\
1629 This call uses the standard L<file(1)> command to determine
1630 the type or contents of the file.  This also works on devices,
1631 for example to find out whether a partition contains a filesystem.
1632
1633 This call will also transparently look inside various types
1634 of compressed file.
1635
1636 The exact command which runs is C<file -zbsL path>.  Note in
1637 particular that the filename is not prepended to the output
1638 (the C<-b> option).");
1639
1640   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1641    [InitBasicFS, Always, TestOutput (
1642       [["upload"; "test-command"; "/test-command"];
1643        ["chmod"; "0o755"; "/test-command"];
1644        ["command"; "/test-command 1"]], "Result1");
1645     InitBasicFS, Always, TestOutput (
1646       [["upload"; "test-command"; "/test-command"];
1647        ["chmod"; "0o755"; "/test-command"];
1648        ["command"; "/test-command 2"]], "Result2\n");
1649     InitBasicFS, Always, TestOutput (
1650       [["upload"; "test-command"; "/test-command"];
1651        ["chmod"; "0o755"; "/test-command"];
1652        ["command"; "/test-command 3"]], "\nResult3");
1653     InitBasicFS, Always, TestOutput (
1654       [["upload"; "test-command"; "/test-command"];
1655        ["chmod"; "0o755"; "/test-command"];
1656        ["command"; "/test-command 4"]], "\nResult4\n");
1657     InitBasicFS, Always, TestOutput (
1658       [["upload"; "test-command"; "/test-command"];
1659        ["chmod"; "0o755"; "/test-command"];
1660        ["command"; "/test-command 5"]], "\nResult5\n\n");
1661     InitBasicFS, Always, TestOutput (
1662       [["upload"; "test-command"; "/test-command"];
1663        ["chmod"; "0o755"; "/test-command"];
1664        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1665     InitBasicFS, Always, TestOutput (
1666       [["upload"; "test-command"; "/test-command"];
1667        ["chmod"; "0o755"; "/test-command"];
1668        ["command"; "/test-command 7"]], "");
1669     InitBasicFS, Always, TestOutput (
1670       [["upload"; "test-command"; "/test-command"];
1671        ["chmod"; "0o755"; "/test-command"];
1672        ["command"; "/test-command 8"]], "\n");
1673     InitBasicFS, Always, TestOutput (
1674       [["upload"; "test-command"; "/test-command"];
1675        ["chmod"; "0o755"; "/test-command"];
1676        ["command"; "/test-command 9"]], "\n\n");
1677     InitBasicFS, Always, TestOutput (
1678       [["upload"; "test-command"; "/test-command"];
1679        ["chmod"; "0o755"; "/test-command"];
1680        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1681     InitBasicFS, Always, TestOutput (
1682       [["upload"; "test-command"; "/test-command"];
1683        ["chmod"; "0o755"; "/test-command"];
1684        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1685     InitBasicFS, Always, TestLastFail (
1686       [["upload"; "test-command"; "/test-command"];
1687        ["chmod"; "0o755"; "/test-command"];
1688        ["command"; "/test-command"]])],
1689    "run a command from the guest filesystem",
1690    "\
1691 This call runs a command from the guest filesystem.  The
1692 filesystem must be mounted, and must contain a compatible
1693 operating system (ie. something Linux, with the same
1694 or compatible processor architecture).
1695
1696 The single parameter is an argv-style list of arguments.
1697 The first element is the name of the program to run.
1698 Subsequent elements are parameters.  The list must be
1699 non-empty (ie. must contain a program name).  Note that
1700 the command runs directly, and is I<not> invoked via
1701 the shell (see C<guestfs_sh>).
1702
1703 The return value is anything printed to I<stdout> by
1704 the command.
1705
1706 If the command returns a non-zero exit status, then
1707 this function returns an error message.  The error message
1708 string is the content of I<stderr> from the command.
1709
1710 The C<$PATH> environment variable will contain at least
1711 C</usr/bin> and C</bin>.  If you require a program from
1712 another location, you should provide the full path in the
1713 first parameter.
1714
1715 Shared libraries and data files required by the program
1716 must be available on filesystems which are mounted in the
1717 correct places.  It is the caller's responsibility to ensure
1718 all filesystems that are needed are mounted at the right
1719 locations.");
1720
1721   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1722    [InitBasicFS, Always, TestOutputList (
1723       [["upload"; "test-command"; "/test-command"];
1724        ["chmod"; "0o755"; "/test-command"];
1725        ["command_lines"; "/test-command 1"]], ["Result1"]);
1726     InitBasicFS, Always, TestOutputList (
1727       [["upload"; "test-command"; "/test-command"];
1728        ["chmod"; "0o755"; "/test-command"];
1729        ["command_lines"; "/test-command 2"]], ["Result2"]);
1730     InitBasicFS, Always, TestOutputList (
1731       [["upload"; "test-command"; "/test-command"];
1732        ["chmod"; "0o755"; "/test-command"];
1733        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1734     InitBasicFS, Always, TestOutputList (
1735       [["upload"; "test-command"; "/test-command"];
1736        ["chmod"; "0o755"; "/test-command"];
1737        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1738     InitBasicFS, Always, TestOutputList (
1739       [["upload"; "test-command"; "/test-command"];
1740        ["chmod"; "0o755"; "/test-command"];
1741        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1742     InitBasicFS, Always, TestOutputList (
1743       [["upload"; "test-command"; "/test-command"];
1744        ["chmod"; "0o755"; "/test-command"];
1745        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1746     InitBasicFS, Always, TestOutputList (
1747       [["upload"; "test-command"; "/test-command"];
1748        ["chmod"; "0o755"; "/test-command"];
1749        ["command_lines"; "/test-command 7"]], []);
1750     InitBasicFS, Always, TestOutputList (
1751       [["upload"; "test-command"; "/test-command"];
1752        ["chmod"; "0o755"; "/test-command"];
1753        ["command_lines"; "/test-command 8"]], [""]);
1754     InitBasicFS, Always, TestOutputList (
1755       [["upload"; "test-command"; "/test-command"];
1756        ["chmod"; "0o755"; "/test-command"];
1757        ["command_lines"; "/test-command 9"]], ["";""]);
1758     InitBasicFS, Always, TestOutputList (
1759       [["upload"; "test-command"; "/test-command"];
1760        ["chmod"; "0o755"; "/test-command"];
1761        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1762     InitBasicFS, Always, TestOutputList (
1763       [["upload"; "test-command"; "/test-command"];
1764        ["chmod"; "0o755"; "/test-command"];
1765        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1766    "run a command, returning lines",
1767    "\
1768 This is the same as C<guestfs_command>, but splits the
1769 result into a list of lines.
1770
1771 See also: C<guestfs_sh_lines>");
1772
1773   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1774    [InitISOFS, Always, TestOutputStruct (
1775       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1776    "get file information",
1777    "\
1778 Returns file information for the given C<path>.
1779
1780 This is the same as the C<stat(2)> system call.");
1781
1782   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1783    [InitISOFS, Always, TestOutputStruct (
1784       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1785    "get file information for a symbolic link",
1786    "\
1787 Returns file information for the given C<path>.
1788
1789 This is the same as C<guestfs_stat> except that if C<path>
1790 is a symbolic link, then the link is stat-ed, not the file it
1791 refers to.
1792
1793 This is the same as the C<lstat(2)> system call.");
1794
1795   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1796    [InitISOFS, Always, TestOutputStruct (
1797       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1798    "get file system statistics",
1799    "\
1800 Returns file system statistics for any mounted file system.
1801 C<path> should be a file or directory in the mounted file system
1802 (typically it is the mount point itself, but it doesn't need to be).
1803
1804 This is the same as the C<statvfs(2)> system call.");
1805
1806   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1807    [], (* XXX test *)
1808    "get ext2/ext3/ext4 superblock details",
1809    "\
1810 This returns the contents of the ext2, ext3 or ext4 filesystem
1811 superblock on C<device>.
1812
1813 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1814 manpage for more details.  The list of fields returned isn't
1815 clearly defined, and depends on both the version of C<tune2fs>
1816 that libguestfs was built against, and the filesystem itself.");
1817
1818   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1819    [InitEmpty, Always, TestOutputTrue (
1820       [["blockdev_setro"; "/dev/sda"];
1821        ["blockdev_getro"; "/dev/sda"]])],
1822    "set block device to read-only",
1823    "\
1824 Sets the block device named C<device> to read-only.
1825
1826 This uses the L<blockdev(8)> command.");
1827
1828   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1829    [InitEmpty, Always, TestOutputFalse (
1830       [["blockdev_setrw"; "/dev/sda"];
1831        ["blockdev_getro"; "/dev/sda"]])],
1832    "set block device to read-write",
1833    "\
1834 Sets the block device named C<device> to read-write.
1835
1836 This uses the L<blockdev(8)> command.");
1837
1838   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1839    [InitEmpty, Always, TestOutputTrue (
1840       [["blockdev_setro"; "/dev/sda"];
1841        ["blockdev_getro"; "/dev/sda"]])],
1842    "is block device set to read-only",
1843    "\
1844 Returns a boolean indicating if the block device is read-only
1845 (true if read-only, false if not).
1846
1847 This uses the L<blockdev(8)> command.");
1848
1849   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1850    [InitEmpty, Always, TestOutputInt (
1851       [["blockdev_getss"; "/dev/sda"]], 512)],
1852    "get sectorsize of block device",
1853    "\
1854 This returns the size of sectors on a block device.
1855 Usually 512, but can be larger for modern devices.
1856
1857 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1858 for that).
1859
1860 This uses the L<blockdev(8)> command.");
1861
1862   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1863    [InitEmpty, Always, TestOutputInt (
1864       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1865    "get blocksize of block device",
1866    "\
1867 This returns the block size of a device.
1868
1869 (Note this is different from both I<size in blocks> and
1870 I<filesystem block size>).
1871
1872 This uses the L<blockdev(8)> command.");
1873
1874   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1875    [], (* XXX test *)
1876    "set blocksize of block device",
1877    "\
1878 This sets the block size of a device.
1879
1880 (Note this is different from both I<size in blocks> and
1881 I<filesystem block size>).
1882
1883 This uses the L<blockdev(8)> command.");
1884
1885   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1886    [InitEmpty, Always, TestOutputInt (
1887       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1888    "get total size of device in 512-byte sectors",
1889    "\
1890 This returns the size of the device in units of 512-byte sectors
1891 (even if the sectorsize isn't 512 bytes ... weird).
1892
1893 See also C<guestfs_blockdev_getss> for the real sector size of
1894 the device, and C<guestfs_blockdev_getsize64> for the more
1895 useful I<size in bytes>.
1896
1897 This uses the L<blockdev(8)> command.");
1898
1899   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1900    [InitEmpty, Always, TestOutputInt (
1901       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1902    "get total size of device in bytes",
1903    "\
1904 This returns the size of the device in bytes.
1905
1906 See also C<guestfs_blockdev_getsz>.
1907
1908 This uses the L<blockdev(8)> command.");
1909
1910   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1911    [InitEmpty, Always, TestRun
1912       [["blockdev_flushbufs"; "/dev/sda"]]],
1913    "flush device buffers",
1914    "\
1915 This tells the kernel to flush internal buffers associated
1916 with C<device>.
1917
1918 This uses the L<blockdev(8)> command.");
1919
1920   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1921    [InitEmpty, Always, TestRun
1922       [["blockdev_rereadpt"; "/dev/sda"]]],
1923    "reread partition table",
1924    "\
1925 Reread the partition table on C<device>.
1926
1927 This uses the L<blockdev(8)> command.");
1928
1929   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1930    [InitBasicFS, Always, TestOutput (
1931       (* Pick a file from cwd which isn't likely to change. *)
1932       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1933        ["checksum"; "md5"; "/COPYING.LIB"]],
1934       Digest.to_hex (Digest.file "COPYING.LIB"))],
1935    "upload a file from the local machine",
1936    "\
1937 Upload local file C<filename> to C<remotefilename> on the
1938 filesystem.
1939
1940 C<filename> can also be a named pipe.
1941
1942 See also C<guestfs_download>.");
1943
1944   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1945    [InitBasicFS, Always, TestOutput (
1946       (* Pick a file from cwd which isn't likely to change. *)
1947       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1948        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1949        ["upload"; "testdownload.tmp"; "/upload"];
1950        ["checksum"; "md5"; "/upload"]],
1951       Digest.to_hex (Digest.file "COPYING.LIB"))],
1952    "download a file to the local machine",
1953    "\
1954 Download file C<remotefilename> and save it as C<filename>
1955 on the local machine.
1956
1957 C<filename> can also be a named pipe.
1958
1959 See also C<guestfs_upload>, C<guestfs_cat>.");
1960
1961   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1962    [InitISOFS, Always, TestOutput (
1963       [["checksum"; "crc"; "/known-3"]], "2891671662");
1964     InitISOFS, Always, TestLastFail (
1965       [["checksum"; "crc"; "/notexists"]]);
1966     InitISOFS, Always, TestOutput (
1967       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1968     InitISOFS, Always, TestOutput (
1969       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1970     InitISOFS, Always, TestOutput (
1971       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1972     InitISOFS, Always, TestOutput (
1973       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1974     InitISOFS, Always, TestOutput (
1975       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1976     InitISOFS, Always, TestOutput (
1977       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1978    "compute MD5, SHAx or CRC checksum of file",
1979    "\
1980 This call computes the MD5, SHAx or CRC checksum of the
1981 file named C<path>.
1982
1983 The type of checksum to compute is given by the C<csumtype>
1984 parameter which must have one of the following values:
1985
1986 =over 4
1987
1988 =item C<crc>
1989
1990 Compute the cyclic redundancy check (CRC) specified by POSIX
1991 for the C<cksum> command.
1992
1993 =item C<md5>
1994
1995 Compute the MD5 hash (using the C<md5sum> program).
1996
1997 =item C<sha1>
1998
1999 Compute the SHA1 hash (using the C<sha1sum> program).
2000
2001 =item C<sha224>
2002
2003 Compute the SHA224 hash (using the C<sha224sum> program).
2004
2005 =item C<sha256>
2006
2007 Compute the SHA256 hash (using the C<sha256sum> program).
2008
2009 =item C<sha384>
2010
2011 Compute the SHA384 hash (using the C<sha384sum> program).
2012
2013 =item C<sha512>
2014
2015 Compute the SHA512 hash (using the C<sha512sum> program).
2016
2017 =back
2018
2019 The checksum is returned as a printable string.");
2020
2021   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2022    [InitBasicFS, Always, TestOutput (
2023       [["tar_in"; "../images/helloworld.tar"; "/"];
2024        ["cat"; "/hello"]], "hello\n")],
2025    "unpack tarfile to directory",
2026    "\
2027 This command uploads and unpacks local file C<tarfile> (an
2028 I<uncompressed> tar file) into C<directory>.
2029
2030 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2031
2032   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2033    [],
2034    "pack directory into tarfile",
2035    "\
2036 This command packs the contents of C<directory> and downloads
2037 it to local file C<tarfile>.
2038
2039 To download a compressed tarball, use C<guestfs_tgz_out>.");
2040
2041   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2042    [InitBasicFS, Always, TestOutput (
2043       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2044        ["cat"; "/hello"]], "hello\n")],
2045    "unpack compressed tarball to directory",
2046    "\
2047 This command uploads and unpacks local file C<tarball> (a
2048 I<gzip compressed> tar file) into C<directory>.
2049
2050 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2051
2052   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2053    [],
2054    "pack directory into compressed tarball",
2055    "\
2056 This command packs the contents of C<directory> and downloads
2057 it to local file C<tarball>.
2058
2059 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2060
2061   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2062    [InitBasicFS, Always, TestLastFail (
2063       [["umount"; "/"];
2064        ["mount_ro"; "/dev/sda1"; "/"];
2065        ["touch"; "/new"]]);
2066     InitBasicFS, Always, TestOutput (
2067       [["write_file"; "/new"; "data"; "0"];
2068        ["umount"; "/"];
2069        ["mount_ro"; "/dev/sda1"; "/"];
2070        ["cat"; "/new"]], "data")],
2071    "mount a guest disk, read-only",
2072    "\
2073 This is the same as the C<guestfs_mount> command, but it
2074 mounts the filesystem with the read-only (I<-o ro>) flag.");
2075
2076   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2077    [],
2078    "mount a guest disk with mount options",
2079    "\
2080 This is the same as the C<guestfs_mount> command, but it
2081 allows you to set the mount options as for the
2082 L<mount(8)> I<-o> flag.");
2083
2084   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2085    [],
2086    "mount a guest disk with mount options and vfstype",
2087    "\
2088 This is the same as the C<guestfs_mount> command, but it
2089 allows you to set both the mount options and the vfstype
2090 as for the L<mount(8)> I<-o> and I<-t> flags.");
2091
2092   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2093    [],
2094    "debugging and internals",
2095    "\
2096 The C<guestfs_debug> command exposes some internals of
2097 C<guestfsd> (the guestfs daemon) that runs inside the
2098 qemu subprocess.
2099
2100 There is no comprehensive help for this command.  You have
2101 to look at the file C<daemon/debug.c> in the libguestfs source
2102 to find out what you can do.");
2103
2104   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2105    [InitEmpty, Always, TestOutputList (
2106       [["part_disk"; "/dev/sda"; "mbr"];
2107        ["pvcreate"; "/dev/sda1"];
2108        ["vgcreate"; "VG"; "/dev/sda1"];
2109        ["lvcreate"; "LV1"; "VG"; "50"];
2110        ["lvcreate"; "LV2"; "VG"; "50"];
2111        ["lvremove"; "/dev/VG/LV1"];
2112        ["lvs"]], ["/dev/VG/LV2"]);
2113     InitEmpty, Always, TestOutputList (
2114       [["part_disk"; "/dev/sda"; "mbr"];
2115        ["pvcreate"; "/dev/sda1"];
2116        ["vgcreate"; "VG"; "/dev/sda1"];
2117        ["lvcreate"; "LV1"; "VG"; "50"];
2118        ["lvcreate"; "LV2"; "VG"; "50"];
2119        ["lvremove"; "/dev/VG"];
2120        ["lvs"]], []);
2121     InitEmpty, Always, TestOutputList (
2122       [["part_disk"; "/dev/sda"; "mbr"];
2123        ["pvcreate"; "/dev/sda1"];
2124        ["vgcreate"; "VG"; "/dev/sda1"];
2125        ["lvcreate"; "LV1"; "VG"; "50"];
2126        ["lvcreate"; "LV2"; "VG"; "50"];
2127        ["lvremove"; "/dev/VG"];
2128        ["vgs"]], ["VG"])],
2129    "remove an LVM logical volume",
2130    "\
2131 Remove an LVM logical volume C<device>, where C<device> is
2132 the path to the LV, such as C</dev/VG/LV>.
2133
2134 You can also remove all LVs in a volume group by specifying
2135 the VG name, C</dev/VG>.");
2136
2137   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2138    [InitEmpty, Always, TestOutputList (
2139       [["part_disk"; "/dev/sda"; "mbr"];
2140        ["pvcreate"; "/dev/sda1"];
2141        ["vgcreate"; "VG"; "/dev/sda1"];
2142        ["lvcreate"; "LV1"; "VG"; "50"];
2143        ["lvcreate"; "LV2"; "VG"; "50"];
2144        ["vgremove"; "VG"];
2145        ["lvs"]], []);
2146     InitEmpty, Always, TestOutputList (
2147       [["part_disk"; "/dev/sda"; "mbr"];
2148        ["pvcreate"; "/dev/sda1"];
2149        ["vgcreate"; "VG"; "/dev/sda1"];
2150        ["lvcreate"; "LV1"; "VG"; "50"];
2151        ["lvcreate"; "LV2"; "VG"; "50"];
2152        ["vgremove"; "VG"];
2153        ["vgs"]], [])],
2154    "remove an LVM volume group",
2155    "\
2156 Remove an LVM volume group C<vgname>, (for example C<VG>).
2157
2158 This also forcibly removes all logical volumes in the volume
2159 group (if any).");
2160
2161   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2162    [InitEmpty, Always, TestOutputListOfDevices (
2163       [["part_disk"; "/dev/sda"; "mbr"];
2164        ["pvcreate"; "/dev/sda1"];
2165        ["vgcreate"; "VG"; "/dev/sda1"];
2166        ["lvcreate"; "LV1"; "VG"; "50"];
2167        ["lvcreate"; "LV2"; "VG"; "50"];
2168        ["vgremove"; "VG"];
2169        ["pvremove"; "/dev/sda1"];
2170        ["lvs"]], []);
2171     InitEmpty, Always, TestOutputListOfDevices (
2172       [["part_disk"; "/dev/sda"; "mbr"];
2173        ["pvcreate"; "/dev/sda1"];
2174        ["vgcreate"; "VG"; "/dev/sda1"];
2175        ["lvcreate"; "LV1"; "VG"; "50"];
2176        ["lvcreate"; "LV2"; "VG"; "50"];
2177        ["vgremove"; "VG"];
2178        ["pvremove"; "/dev/sda1"];
2179        ["vgs"]], []);
2180     InitEmpty, Always, TestOutputListOfDevices (
2181       [["part_disk"; "/dev/sda"; "mbr"];
2182        ["pvcreate"; "/dev/sda1"];
2183        ["vgcreate"; "VG"; "/dev/sda1"];
2184        ["lvcreate"; "LV1"; "VG"; "50"];
2185        ["lvcreate"; "LV2"; "VG"; "50"];
2186        ["vgremove"; "VG"];
2187        ["pvremove"; "/dev/sda1"];
2188        ["pvs"]], [])],
2189    "remove an LVM physical volume",
2190    "\
2191 This wipes a physical volume C<device> so that LVM will no longer
2192 recognise it.
2193
2194 The implementation uses the C<pvremove> command which refuses to
2195 wipe physical volumes that contain any volume groups, so you have
2196 to remove those first.");
2197
2198   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2199    [InitBasicFS, Always, TestOutput (
2200       [["set_e2label"; "/dev/sda1"; "testlabel"];
2201        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2202    "set the ext2/3/4 filesystem label",
2203    "\
2204 This sets the ext2/3/4 filesystem label of the filesystem on
2205 C<device> to C<label>.  Filesystem labels are limited to
2206 16 characters.
2207
2208 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2209 to return the existing label on a filesystem.");
2210
2211   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2212    [],
2213    "get the ext2/3/4 filesystem label",
2214    "\
2215 This returns the ext2/3/4 filesystem label of the filesystem on
2216 C<device>.");
2217
2218   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2219    (let uuid = uuidgen () in
2220     [InitBasicFS, Always, TestOutput (
2221        [["set_e2uuid"; "/dev/sda1"; uuid];
2222         ["get_e2uuid"; "/dev/sda1"]], uuid);
2223      InitBasicFS, Always, TestOutput (
2224        [["set_e2uuid"; "/dev/sda1"; "clear"];
2225         ["get_e2uuid"; "/dev/sda1"]], "");
2226      (* We can't predict what UUIDs will be, so just check the commands run. *)
2227      InitBasicFS, Always, TestRun (
2228        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2229      InitBasicFS, Always, TestRun (
2230        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2231    "set the ext2/3/4 filesystem UUID",
2232    "\
2233 This sets the ext2/3/4 filesystem UUID of the filesystem on
2234 C<device> to C<uuid>.  The format of the UUID and alternatives
2235 such as C<clear>, C<random> and C<time> are described in the
2236 L<tune2fs(8)> manpage.
2237
2238 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2239 to return the existing UUID of a filesystem.");
2240
2241   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2242    [],
2243    "get the ext2/3/4 filesystem UUID",
2244    "\
2245 This returns the ext2/3/4 filesystem UUID of the filesystem on
2246 C<device>.");
2247
2248   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2249    [InitBasicFS, Always, TestOutputInt (
2250       [["umount"; "/dev/sda1"];
2251        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2252     InitBasicFS, Always, TestOutputInt (
2253       [["umount"; "/dev/sda1"];
2254        ["zero"; "/dev/sda1"];
2255        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2256    "run the filesystem checker",
2257    "\
2258 This runs the filesystem checker (fsck) on C<device> which
2259 should have filesystem type C<fstype>.
2260
2261 The returned integer is the status.  See L<fsck(8)> for the
2262 list of status codes from C<fsck>.
2263
2264 Notes:
2265
2266 =over 4
2267
2268 =item *
2269
2270 Multiple status codes can be summed together.
2271
2272 =item *
2273
2274 A non-zero return code can mean \"success\", for example if
2275 errors have been corrected on the filesystem.
2276
2277 =item *
2278
2279 Checking or repairing NTFS volumes is not supported
2280 (by linux-ntfs).
2281
2282 =back
2283
2284 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2285
2286   ("zero", (RErr, [Device "device"]), 85, [],
2287    [InitBasicFS, Always, TestOutput (
2288       [["umount"; "/dev/sda1"];
2289        ["zero"; "/dev/sda1"];
2290        ["file"; "/dev/sda1"]], "data")],
2291    "write zeroes to the device",
2292    "\
2293 This command writes zeroes over the first few blocks of C<device>.
2294
2295 How many blocks are zeroed isn't specified (but it's I<not> enough
2296 to securely wipe the device).  It should be sufficient to remove
2297 any partition tables, filesystem superblocks and so on.
2298
2299 See also: C<guestfs_scrub_device>.");
2300
2301   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2302    (* Test disabled because grub-install incompatible with virtio-blk driver.
2303     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2304     *)
2305    [InitBasicFS, Disabled, TestOutputTrue (
2306       [["grub_install"; "/"; "/dev/sda1"];
2307        ["is_dir"; "/boot"]])],
2308    "install GRUB",
2309    "\
2310 This command installs GRUB (the Grand Unified Bootloader) on
2311 C<device>, with the root directory being C<root>.");
2312
2313   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2314    [InitBasicFS, Always, TestOutput (
2315       [["write_file"; "/old"; "file content"; "0"];
2316        ["cp"; "/old"; "/new"];
2317        ["cat"; "/new"]], "file content");
2318     InitBasicFS, Always, TestOutputTrue (
2319       [["write_file"; "/old"; "file content"; "0"];
2320        ["cp"; "/old"; "/new"];
2321        ["is_file"; "/old"]]);
2322     InitBasicFS, Always, TestOutput (
2323       [["write_file"; "/old"; "file content"; "0"];
2324        ["mkdir"; "/dir"];
2325        ["cp"; "/old"; "/dir/new"];
2326        ["cat"; "/dir/new"]], "file content")],
2327    "copy a file",
2328    "\
2329 This copies a file from C<src> to C<dest> where C<dest> is
2330 either a destination filename or destination directory.");
2331
2332   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2333    [InitBasicFS, Always, TestOutput (
2334       [["mkdir"; "/olddir"];
2335        ["mkdir"; "/newdir"];
2336        ["write_file"; "/olddir/file"; "file content"; "0"];
2337        ["cp_a"; "/olddir"; "/newdir"];
2338        ["cat"; "/newdir/olddir/file"]], "file content")],
2339    "copy a file or directory recursively",
2340    "\
2341 This copies a file or directory from C<src> to C<dest>
2342 recursively using the C<cp -a> command.");
2343
2344   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2345    [InitBasicFS, Always, TestOutput (
2346       [["write_file"; "/old"; "file content"; "0"];
2347        ["mv"; "/old"; "/new"];
2348        ["cat"; "/new"]], "file content");
2349     InitBasicFS, Always, TestOutputFalse (
2350       [["write_file"; "/old"; "file content"; "0"];
2351        ["mv"; "/old"; "/new"];
2352        ["is_file"; "/old"]])],
2353    "move a file",
2354    "\
2355 This moves a file from C<src> to C<dest> where C<dest> is
2356 either a destination filename or destination directory.");
2357
2358   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2359    [InitEmpty, Always, TestRun (
2360       [["drop_caches"; "3"]])],
2361    "drop kernel page cache, dentries and inodes",
2362    "\
2363 This instructs the guest kernel to drop its page cache,
2364 and/or dentries and inode caches.  The parameter C<whattodrop>
2365 tells the kernel what precisely to drop, see
2366 L<http://linux-mm.org/Drop_Caches>
2367
2368 Setting C<whattodrop> to 3 should drop everything.
2369
2370 This automatically calls L<sync(2)> before the operation,
2371 so that the maximum guest memory is freed.");
2372
2373   ("dmesg", (RString "kmsgs", []), 91, [],
2374    [InitEmpty, Always, TestRun (
2375       [["dmesg"]])],
2376    "return kernel messages",
2377    "\
2378 This returns the kernel messages (C<dmesg> output) from
2379 the guest kernel.  This is sometimes useful for extended
2380 debugging of problems.
2381
2382 Another way to get the same information is to enable
2383 verbose messages with C<guestfs_set_verbose> or by setting
2384 the environment variable C<LIBGUESTFS_DEBUG=1> before
2385 running the program.");
2386
2387   ("ping_daemon", (RErr, []), 92, [],
2388    [InitEmpty, Always, TestRun (
2389       [["ping_daemon"]])],
2390    "ping the guest daemon",
2391    "\
2392 This is a test probe into the guestfs daemon running inside
2393 the qemu subprocess.  Calling this function checks that the
2394 daemon responds to the ping message, without affecting the daemon
2395 or attached block device(s) in any other way.");
2396
2397   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2398    [InitBasicFS, Always, TestOutputTrue (
2399       [["write_file"; "/file1"; "contents of a file"; "0"];
2400        ["cp"; "/file1"; "/file2"];
2401        ["equal"; "/file1"; "/file2"]]);
2402     InitBasicFS, Always, TestOutputFalse (
2403       [["write_file"; "/file1"; "contents of a file"; "0"];
2404        ["write_file"; "/file2"; "contents of another file"; "0"];
2405        ["equal"; "/file1"; "/file2"]]);
2406     InitBasicFS, Always, TestLastFail (
2407       [["equal"; "/file1"; "/file2"]])],
2408    "test if two files have equal contents",
2409    "\
2410 This compares the two files C<file1> and C<file2> and returns
2411 true if their content is exactly equal, or false otherwise.
2412
2413 The external L<cmp(1)> program is used for the comparison.");
2414
2415   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2416    [InitISOFS, Always, TestOutputList (
2417       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2418     InitISOFS, Always, TestOutputList (
2419       [["strings"; "/empty"]], [])],
2420    "print the printable strings in a file",
2421    "\
2422 This runs the L<strings(1)> command on a file and returns
2423 the list of printable strings found.");
2424
2425   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2426    [InitISOFS, Always, TestOutputList (
2427       [["strings_e"; "b"; "/known-5"]], []);
2428     InitBasicFS, Disabled, TestOutputList (
2429       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2430        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2431    "print the printable strings in a file",
2432    "\
2433 This is like the C<guestfs_strings> command, but allows you to
2434 specify the encoding.
2435
2436 See the L<strings(1)> manpage for the full list of encodings.
2437
2438 Commonly useful encodings are C<l> (lower case L) which will
2439 show strings inside Windows/x86 files.
2440
2441 The returned strings are transcoded to UTF-8.");
2442
2443   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2444    [InitISOFS, Always, TestOutput (
2445       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2446     (* Test for RHBZ#501888c2 regression which caused large hexdump
2447      * commands to segfault.
2448      *)
2449     InitISOFS, Always, TestRun (
2450       [["hexdump"; "/100krandom"]])],
2451    "dump a file in hexadecimal",
2452    "\
2453 This runs C<hexdump -C> on the given C<path>.  The result is
2454 the human-readable, canonical hex dump of the file.");
2455
2456   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2457    [InitNone, Always, TestOutput (
2458       [["part_disk"; "/dev/sda"; "mbr"];
2459        ["mkfs"; "ext3"; "/dev/sda1"];
2460        ["mount_options"; ""; "/dev/sda1"; "/"];
2461        ["write_file"; "/new"; "test file"; "0"];
2462        ["umount"; "/dev/sda1"];
2463        ["zerofree"; "/dev/sda1"];
2464        ["mount_options"; ""; "/dev/sda1"; "/"];
2465        ["cat"; "/new"]], "test file")],
2466    "zero unused inodes and disk blocks on ext2/3 filesystem",
2467    "\
2468 This runs the I<zerofree> program on C<device>.  This program
2469 claims to zero unused inodes and disk blocks on an ext2/3
2470 filesystem, thus making it possible to compress the filesystem
2471 more effectively.
2472
2473 You should B<not> run this program if the filesystem is
2474 mounted.
2475
2476 It is possible that using this program can damage the filesystem
2477 or data on the filesystem.");
2478
2479   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2480    [],
2481    "resize an LVM physical volume",
2482    "\
2483 This resizes (expands or shrinks) an existing LVM physical
2484 volume to match the new size of the underlying device.");
2485
2486   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2487                        Int "cyls"; Int "heads"; Int "sectors";
2488                        String "line"]), 99, [DangerWillRobinson],
2489    [],
2490    "modify a single partition on a block device",
2491    "\
2492 This runs L<sfdisk(8)> option to modify just the single
2493 partition C<n> (note: C<n> counts from 1).
2494
2495 For other parameters, see C<guestfs_sfdisk>.  You should usually
2496 pass C<0> for the cyls/heads/sectors parameters.
2497
2498 See also: C<guestfs_part_add>");
2499
2500   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2501    [],
2502    "display the partition table",
2503    "\
2504 This displays the partition table on C<device>, in the
2505 human-readable output of the L<sfdisk(8)> command.  It is
2506 not intended to be parsed.
2507
2508 See also: C<guestfs_part_list>");
2509
2510   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2511    [],
2512    "display the kernel geometry",
2513    "\
2514 This displays the kernel's idea of the geometry of C<device>.
2515
2516 The result is in human-readable format, and not designed to
2517 be parsed.");
2518
2519   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2520    [],
2521    "display the disk geometry from the partition table",
2522    "\
2523 This displays the disk geometry of C<device> read from the
2524 partition table.  Especially in the case where the underlying
2525 block device has been resized, this can be different from the
2526 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2527
2528 The result is in human-readable format, and not designed to
2529 be parsed.");
2530
2531   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2532    [],
2533    "activate or deactivate all volume groups",
2534    "\
2535 This command activates or (if C<activate> is false) deactivates
2536 all logical volumes in all volume groups.
2537 If activated, then they are made known to the
2538 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2539 then those devices disappear.
2540
2541 This command is the same as running C<vgchange -a y|n>");
2542
2543   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2544    [],
2545    "activate or deactivate some volume groups",
2546    "\
2547 This command activates or (if C<activate> is false) deactivates
2548 all logical volumes in the listed volume groups C<volgroups>.
2549 If activated, then they are made known to the
2550 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2551 then those devices disappear.
2552
2553 This command is the same as running C<vgchange -a y|n volgroups...>
2554
2555 Note that if C<volgroups> is an empty list then B<all> volume groups
2556 are activated or deactivated.");
2557
2558   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2559    [InitNone, Always, TestOutput (
2560       [["part_disk"; "/dev/sda"; "mbr"];
2561        ["pvcreate"; "/dev/sda1"];
2562        ["vgcreate"; "VG"; "/dev/sda1"];
2563        ["lvcreate"; "LV"; "VG"; "10"];
2564        ["mkfs"; "ext2"; "/dev/VG/LV"];
2565        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2566        ["write_file"; "/new"; "test content"; "0"];
2567        ["umount"; "/"];
2568        ["lvresize"; "/dev/VG/LV"; "20"];
2569        ["e2fsck_f"; "/dev/VG/LV"];
2570        ["resize2fs"; "/dev/VG/LV"];
2571        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2572        ["cat"; "/new"]], "test content");
2573     InitNone, Always, TestRun (
2574       (* Make an LV smaller to test RHBZ#587484. *)
2575       [["part_disk"; "/dev/sda"; "mbr"];
2576        ["pvcreate"; "/dev/sda1"];
2577        ["vgcreate"; "VG"; "/dev/sda1"];
2578        ["lvcreate"; "LV"; "VG"; "20"];
2579        ["lvresize"; "/dev/VG/LV"; "10"]])],
2580    "resize an LVM logical volume",
2581    "\
2582 This resizes (expands or shrinks) an existing LVM logical
2583 volume to C<mbytes>.  When reducing, data in the reduced part
2584 is lost.");
2585
2586   ("resize2fs", (RErr, [Device "device"]), 106, [],
2587    [], (* lvresize tests this *)
2588    "resize an ext2/ext3 filesystem",
2589    "\
2590 This resizes an ext2 or ext3 filesystem to match the size of
2591 the underlying device.
2592
2593 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2594 on the C<device> before calling this command.  For unknown reasons
2595 C<resize2fs> sometimes gives an error about this and sometimes not.
2596 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2597 calling this function.");
2598
2599   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2600    [InitBasicFS, Always, TestOutputList (
2601       [["find"; "/"]], ["lost+found"]);
2602     InitBasicFS, Always, TestOutputList (
2603       [["touch"; "/a"];
2604        ["mkdir"; "/b"];
2605        ["touch"; "/b/c"];
2606        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2607     InitBasicFS, Always, TestOutputList (
2608       [["mkdir_p"; "/a/b/c"];
2609        ["touch"; "/a/b/c/d"];
2610        ["find"; "/a/b/"]], ["c"; "c/d"])],
2611    "find all files and directories",
2612    "\
2613 This command lists out all files and directories, recursively,
2614 starting at C<directory>.  It is essentially equivalent to
2615 running the shell command C<find directory -print> but some
2616 post-processing happens on the output, described below.
2617
2618 This returns a list of strings I<without any prefix>.  Thus
2619 if the directory structure was:
2620
2621  /tmp/a
2622  /tmp/b
2623  /tmp/c/d
2624
2625 then the returned list from C<guestfs_find> C</tmp> would be
2626 4 elements:
2627
2628  a
2629  b
2630  c
2631  c/d
2632
2633 If C<directory> is not a directory, then this command returns
2634 an error.
2635
2636 The returned list is sorted.
2637
2638 See also C<guestfs_find0>.");
2639
2640   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2641    [], (* lvresize tests this *)
2642    "check an ext2/ext3 filesystem",
2643    "\
2644 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2645 filesystem checker on C<device>, noninteractively (C<-p>),
2646 even if the filesystem appears to be clean (C<-f>).
2647
2648 This command is only needed because of C<guestfs_resize2fs>
2649 (q.v.).  Normally you should use C<guestfs_fsck>.");
2650
2651   ("sleep", (RErr, [Int "secs"]), 109, [],
2652    [InitNone, Always, TestRun (
2653       [["sleep"; "1"]])],
2654    "sleep for some seconds",
2655    "\
2656 Sleep for C<secs> seconds.");
2657
2658   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2659    [InitNone, Always, TestOutputInt (
2660       [["part_disk"; "/dev/sda"; "mbr"];
2661        ["mkfs"; "ntfs"; "/dev/sda1"];
2662        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2663     InitNone, Always, TestOutputInt (
2664       [["part_disk"; "/dev/sda"; "mbr"];
2665        ["mkfs"; "ext2"; "/dev/sda1"];
2666        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2667    "probe NTFS volume",
2668    "\
2669 This command runs the L<ntfs-3g.probe(8)> command which probes
2670 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2671 be mounted read-write, and some cannot be mounted at all).
2672
2673 C<rw> is a boolean flag.  Set it to true if you want to test
2674 if the volume can be mounted read-write.  Set it to false if
2675 you want to test if the volume can be mounted read-only.
2676
2677 The return value is an integer which C<0> if the operation
2678 would succeed, or some non-zero value documented in the
2679 L<ntfs-3g.probe(8)> manual page.");
2680
2681   ("sh", (RString "output", [String "command"]), 111, [],
2682    [], (* XXX needs tests *)
2683    "run a command via the shell",
2684    "\
2685 This call runs a command from the guest filesystem via the
2686 guest's C</bin/sh>.
2687
2688 This is like C<guestfs_command>, but passes the command to:
2689
2690  /bin/sh -c \"command\"
2691
2692 Depending on the guest's shell, this usually results in
2693 wildcards being expanded, shell expressions being interpolated
2694 and so on.
2695
2696 All the provisos about C<guestfs_command> apply to this call.");
2697
2698   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2699    [], (* XXX needs tests *)
2700    "run a command via the shell returning lines",
2701    "\
2702 This is the same as C<guestfs_sh>, but splits the result
2703 into a list of lines.
2704
2705 See also: C<guestfs_command_lines>");
2706
2707   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2708    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2709     * code in stubs.c, since all valid glob patterns must start with "/".
2710     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2711     *)
2712    [InitBasicFS, Always, TestOutputList (
2713       [["mkdir_p"; "/a/b/c"];
2714        ["touch"; "/a/b/c/d"];
2715        ["touch"; "/a/b/c/e"];
2716        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2717     InitBasicFS, Always, TestOutputList (
2718       [["mkdir_p"; "/a/b/c"];
2719        ["touch"; "/a/b/c/d"];
2720        ["touch"; "/a/b/c/e"];
2721        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2722     InitBasicFS, Always, TestOutputList (
2723       [["mkdir_p"; "/a/b/c"];
2724        ["touch"; "/a/b/c/d"];
2725        ["touch"; "/a/b/c/e"];
2726        ["glob_expand"; "/a/*/x/*"]], [])],
2727    "expand a wildcard path",
2728    "\
2729 This command searches for all the pathnames matching
2730 C<pattern> according to the wildcard expansion rules
2731 used by the shell.
2732
2733 If no paths match, then this returns an empty list
2734 (note: not an error).
2735
2736 It is just a wrapper around the C L<glob(3)> function
2737 with flags C<GLOB_MARK|GLOB_BRACE>.
2738 See that manual page for more details.");
2739
2740   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2741    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2742       [["scrub_device"; "/dev/sdc"]])],
2743    "scrub (securely wipe) a device",
2744    "\
2745 This command writes patterns over C<device> to make data retrieval
2746 more difficult.
2747
2748 It is an interface to the L<scrub(1)> program.  See that
2749 manual page for more details.");
2750
2751   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2752    [InitBasicFS, Always, TestRun (
2753       [["write_file"; "/file"; "content"; "0"];
2754        ["scrub_file"; "/file"]])],
2755    "scrub (securely wipe) a file",
2756    "\
2757 This command writes patterns over a file to make data retrieval
2758 more difficult.
2759
2760 The file is I<removed> after scrubbing.
2761
2762 It is an interface to the L<scrub(1)> program.  See that
2763 manual page for more details.");
2764
2765   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2766    [], (* XXX needs testing *)
2767    "scrub (securely wipe) free space",
2768    "\
2769 This command creates the directory C<dir> and then fills it
2770 with files until the filesystem is full, and scrubs the files
2771 as for C<guestfs_scrub_file>, and deletes them.
2772 The intention is to scrub any free space on the partition
2773 containing C<dir>.
2774
2775 It is an interface to the L<scrub(1)> program.  See that
2776 manual page for more details.");
2777
2778   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2779    [InitBasicFS, Always, TestRun (
2780       [["mkdir"; "/tmp"];
2781        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2782    "create a temporary directory",
2783    "\
2784 This command creates a temporary directory.  The
2785 C<template> parameter should be a full pathname for the
2786 temporary directory name with the final six characters being
2787 \"XXXXXX\".
2788
2789 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2790 the second one being suitable for Windows filesystems.
2791
2792 The name of the temporary directory that was created
2793 is returned.
2794
2795 The temporary directory is created with mode 0700
2796 and is owned by root.
2797
2798 The caller is responsible for deleting the temporary
2799 directory and its contents after use.
2800
2801 See also: L<mkdtemp(3)>");
2802
2803   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2804    [InitISOFS, Always, TestOutputInt (
2805       [["wc_l"; "/10klines"]], 10000)],
2806    "count lines in a file",
2807    "\
2808 This command counts the lines in a file, using the
2809 C<wc -l> external command.");
2810
2811   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2812    [InitISOFS, Always, TestOutputInt (
2813       [["wc_w"; "/10klines"]], 10000)],
2814    "count words in a file",
2815    "\
2816 This command counts the words in a file, using the
2817 C<wc -w> external command.");
2818
2819   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2820    [InitISOFS, Always, TestOutputInt (
2821       [["wc_c"; "/100kallspaces"]], 102400)],
2822    "count characters in a file",
2823    "\
2824 This command counts the characters in a file, using the
2825 C<wc -c> external command.");
2826
2827   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2828    [InitISOFS, Always, TestOutputList (
2829       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2830    "return first 10 lines of a file",
2831    "\
2832 This command returns up to the first 10 lines of a file as
2833 a list of strings.");
2834
2835   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2836    [InitISOFS, Always, TestOutputList (
2837       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2838     InitISOFS, Always, TestOutputList (
2839       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2840     InitISOFS, Always, TestOutputList (
2841       [["head_n"; "0"; "/10klines"]], [])],
2842    "return first N lines of a file",
2843    "\
2844 If the parameter C<nrlines> is a positive number, this returns the first
2845 C<nrlines> lines of the file C<path>.
2846
2847 If the parameter C<nrlines> is a negative number, this returns lines
2848 from the file C<path>, excluding the last C<nrlines> lines.
2849
2850 If the parameter C<nrlines> is zero, this returns an empty list.");
2851
2852   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2853    [InitISOFS, Always, TestOutputList (
2854       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2855    "return last 10 lines of a file",
2856    "\
2857 This command returns up to the last 10 lines of a file as
2858 a list of strings.");
2859
2860   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2861    [InitISOFS, Always, TestOutputList (
2862       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2863     InitISOFS, Always, TestOutputList (
2864       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2865     InitISOFS, Always, TestOutputList (
2866       [["tail_n"; "0"; "/10klines"]], [])],
2867    "return last N lines of a file",
2868    "\
2869 If the parameter C<nrlines> is a positive number, this returns the last
2870 C<nrlines> lines of the file C<path>.
2871
2872 If the parameter C<nrlines> is a negative number, this returns lines
2873 from the file C<path>, starting with the C<-nrlines>th line.
2874
2875 If the parameter C<nrlines> is zero, this returns an empty list.");
2876
2877   ("df", (RString "output", []), 125, [],
2878    [], (* XXX Tricky to test because it depends on the exact format
2879         * of the 'df' command and other imponderables.
2880         *)
2881    "report file system disk space usage",
2882    "\
2883 This command runs the C<df> command to report disk space used.
2884
2885 This command is mostly useful for interactive sessions.  It
2886 is I<not> intended that you try to parse the output string.
2887 Use C<statvfs> from programs.");
2888
2889   ("df_h", (RString "output", []), 126, [],
2890    [], (* XXX Tricky to test because it depends on the exact format
2891         * of the 'df' command and other imponderables.
2892         *)
2893    "report file system disk space usage (human readable)",
2894    "\
2895 This command runs the C<df -h> command to report disk space used
2896 in human-readable format.
2897
2898 This command is mostly useful for interactive sessions.  It
2899 is I<not> intended that you try to parse the output string.
2900 Use C<statvfs> from programs.");
2901
2902   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2903    [InitISOFS, Always, TestOutputInt (
2904       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2905    "estimate file space usage",
2906    "\
2907 This command runs the C<du -s> command to estimate file space
2908 usage for C<path>.
2909
2910 C<path> can be a file or a directory.  If C<path> is a directory
2911 then the estimate includes the contents of the directory and all
2912 subdirectories (recursively).
2913
2914 The result is the estimated size in I<kilobytes>
2915 (ie. units of 1024 bytes).");
2916
2917   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2918    [InitISOFS, Always, TestOutputList (
2919       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2920    "list files in an initrd",
2921    "\
2922 This command lists out files contained in an initrd.
2923
2924 The files are listed without any initial C</> character.  The
2925 files are listed in the order they appear (not necessarily
2926 alphabetical).  Directory names are listed as separate items.
2927
2928 Old Linux kernels (2.4 and earlier) used a compressed ext2
2929 filesystem as initrd.  We I<only> support the newer initramfs
2930 format (compressed cpio files).");
2931
2932   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2933    [],
2934    "mount a file using the loop device",
2935    "\
2936 This command lets you mount C<file> (a filesystem image
2937 in a file) on a mount point.  It is entirely equivalent to
2938 the command C<mount -o loop file mountpoint>.");
2939
2940   ("mkswap", (RErr, [Device "device"]), 130, [],
2941    [InitEmpty, Always, TestRun (
2942       [["part_disk"; "/dev/sda"; "mbr"];
2943        ["mkswap"; "/dev/sda1"]])],
2944    "create a swap partition",
2945    "\
2946 Create a swap partition on C<device>.");
2947
2948   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
2949    [InitEmpty, Always, TestRun (
2950       [["part_disk"; "/dev/sda"; "mbr"];
2951        ["mkswap_L"; "hello"; "/dev/sda1"]])],
2952    "create a swap partition with a label",
2953    "\
2954 Create a swap partition on C<device> with label C<label>.
2955
2956 Note that you cannot attach a swap label to a block device
2957 (eg. C</dev/sda>), just to a partition.  This appears to be
2958 a limitation of the kernel or swap tools.");
2959
2960   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
2961    (let uuid = uuidgen () in
2962     [InitEmpty, Always, TestRun (
2963        [["part_disk"; "/dev/sda"; "mbr"];
2964         ["mkswap_U"; uuid; "/dev/sda1"]])]),
2965    "create a swap partition with an explicit UUID",
2966    "\
2967 Create a swap partition on C<device> with UUID C<uuid>.");
2968
2969   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
2970    [InitBasicFS, Always, TestOutputStruct (
2971       [["mknod"; "0o10777"; "0"; "0"; "/node"];
2972        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
2973        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
2974     InitBasicFS, Always, TestOutputStruct (
2975       [["mknod"; "0o60777"; "66"; "99"; "/node"];
2976        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
2977    "make block, character or FIFO devices",
2978    "\
2979 This call creates block or character special devices, or
2980 named pipes (FIFOs).
2981
2982 The C<mode> parameter should be the mode, using the standard
2983 constants.  C<devmajor> and C<devminor> are the
2984 device major and minor numbers, only used when creating block
2985 and character special devices.
2986
2987 Note that, just like L<mknod(2)>, the mode must be bitwise
2988 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
2989 just creates a regular file).  These constants are
2990 available in the standard Linux header files, or you can use
2991 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
2992 which are wrappers around this command which bitwise OR
2993 in the appropriate constant for you.
2994
2995 The mode actually set is affected by the umask.");
2996
2997   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
2998    [InitBasicFS, Always, TestOutputStruct (
2999       [["mkfifo"; "0o777"; "/node"];
3000        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3001    "make FIFO (named pipe)",
3002    "\
3003 This call creates a FIFO (named pipe) called C<path> with
3004 mode C<mode>.  It is just a convenient wrapper around
3005 C<guestfs_mknod>.
3006
3007 The mode actually set is affected by the umask.");
3008
3009   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3010    [InitBasicFS, Always, TestOutputStruct (
3011       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3012        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3013    "make block device node",
3014    "\
3015 This call creates a block device node called C<path> with
3016 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3017 It is just a convenient wrapper around C<guestfs_mknod>.
3018
3019 The mode actually set is affected by the umask.");
3020
3021   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3022    [InitBasicFS, Always, TestOutputStruct (
3023       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3024        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3025    "make char device node",
3026    "\
3027 This call creates a char device node called C<path> with
3028 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3029 It is just a convenient wrapper around C<guestfs_mknod>.
3030
3031 The mode actually set is affected by the umask.");
3032
3033   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3034    [InitEmpty, Always, TestOutputInt (
3035       [["umask"; "0o22"]], 0o22)],
3036    "set file mode creation mask (umask)",
3037    "\
3038 This function sets the mask used for creating new files and
3039 device nodes to C<mask & 0777>.
3040
3041 Typical umask values would be C<022> which creates new files
3042 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3043 C<002> which creates new files with permissions like
3044 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3045
3046 The default umask is C<022>.  This is important because it
3047 means that directories and device nodes will be created with
3048 C<0644> or C<0755> mode even if you specify C<0777>.
3049
3050 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3051
3052 This call returns the previous umask.");
3053
3054   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3055    [],
3056    "read directories entries",
3057    "\
3058 This returns the list of directory entries in directory C<dir>.
3059
3060 All entries in the directory are returned, including C<.> and
3061 C<..>.  The entries are I<not> sorted, but returned in the same
3062 order as the underlying filesystem.
3063
3064 Also this call returns basic file type information about each
3065 file.  The C<ftyp> field will contain one of the following characters:
3066
3067 =over 4
3068
3069 =item 'b'
3070
3071 Block special
3072
3073 =item 'c'
3074
3075 Char special
3076
3077 =item 'd'
3078
3079 Directory
3080
3081 =item 'f'
3082
3083 FIFO (named pipe)
3084
3085 =item 'l'
3086
3087 Symbolic link
3088
3089 =item 'r'
3090
3091 Regular file
3092
3093 =item 's'
3094
3095 Socket
3096
3097 =item 'u'
3098
3099 Unknown file type
3100
3101 =item '?'
3102
3103 The L<readdir(3)> returned a C<d_type> field with an
3104 unexpected value
3105
3106 =back
3107
3108 This function is primarily intended for use by programs.  To
3109 get a simple list of names, use C<guestfs_ls>.  To get a printable
3110 directory for human consumption, use C<guestfs_ll>.");
3111
3112   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3113    [],
3114    "create partitions on a block device",
3115    "\
3116 This is a simplified interface to the C<guestfs_sfdisk>
3117 command, where partition sizes are specified in megabytes
3118 only (rounded to the nearest cylinder) and you don't need
3119 to specify the cyls, heads and sectors parameters which
3120 were rarely if ever used anyway.
3121
3122 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3123 and C<guestfs_part_disk>");
3124
3125   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3126    [],
3127    "determine file type inside a compressed file",
3128    "\
3129 This command runs C<file> after first decompressing C<path>
3130 using C<method>.
3131
3132 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3133
3134 Since 1.0.63, use C<guestfs_file> instead which can now
3135 process compressed files.");
3136
3137   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3138    [],
3139    "list extended attributes of a file or directory",
3140    "\
3141 This call lists the extended attributes of the file or directory
3142 C<path>.
3143
3144 At the system call level, this is a combination of the
3145 L<listxattr(2)> and L<getxattr(2)> calls.
3146
3147 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3148
3149   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3150    [],
3151    "list extended attributes of a file or directory",
3152    "\
3153 This is the same as C<guestfs_getxattrs>, but if C<path>
3154 is a symbolic link, then it returns the extended attributes
3155 of the link itself.");
3156
3157   ("setxattr", (RErr, [String "xattr";
3158                        String "val"; Int "vallen"; (* will be BufferIn *)
3159                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3160    [],
3161    "set extended attribute of a file or directory",
3162    "\
3163 This call sets the extended attribute named C<xattr>
3164 of the file C<path> to the value C<val> (of length C<vallen>).
3165 The value is arbitrary 8 bit data.
3166
3167 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3168
3169   ("lsetxattr", (RErr, [String "xattr";
3170                         String "val"; Int "vallen"; (* will be BufferIn *)
3171                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3172    [],
3173    "set extended attribute of a file or directory",
3174    "\
3175 This is the same as C<guestfs_setxattr>, but if C<path>
3176 is a symbolic link, then it sets an extended attribute
3177 of the link itself.");
3178
3179   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3180    [],
3181    "remove extended attribute of a file or directory",
3182    "\
3183 This call removes the extended attribute named C<xattr>
3184 of the file C<path>.
3185
3186 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3187
3188   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3189    [],
3190    "remove extended attribute of a file or directory",
3191    "\
3192 This is the same as C<guestfs_removexattr>, but if C<path>
3193 is a symbolic link, then it removes an extended attribute
3194 of the link itself.");
3195
3196   ("mountpoints", (RHashtable "mps", []), 147, [],
3197    [],
3198    "show mountpoints",
3199    "\
3200 This call is similar to C<guestfs_mounts>.  That call returns
3201 a list of devices.  This one returns a hash table (map) of
3202 device name to directory where the device is mounted.");
3203
3204   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3205    (* This is a special case: while you would expect a parameter
3206     * of type "Pathname", that doesn't work, because it implies
3207     * NEED_ROOT in the generated calling code in stubs.c, and
3208     * this function cannot use NEED_ROOT.
3209     *)
3210    [],
3211    "create a mountpoint",
3212    "\
3213 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3214 specialized calls that can be used to create extra mountpoints
3215 before mounting the first filesystem.
3216
3217 These calls are I<only> necessary in some very limited circumstances,
3218 mainly the case where you want to mount a mix of unrelated and/or
3219 read-only filesystems together.
3220
3221 For example, live CDs often contain a \"Russian doll\" nest of
3222 filesystems, an ISO outer layer, with a squashfs image inside, with
3223 an ext2/3 image inside that.  You can unpack this as follows
3224 in guestfish:
3225
3226  add-ro Fedora-11-i686-Live.iso
3227  run
3228  mkmountpoint /cd
3229  mkmountpoint /squash
3230  mkmountpoint /ext3
3231  mount /dev/sda /cd
3232  mount-loop /cd/LiveOS/squashfs.img /squash
3233  mount-loop /squash/LiveOS/ext3fs.img /ext3
3234
3235 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3236
3237   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3238    [],
3239    "remove a mountpoint",
3240    "\
3241 This calls removes a mountpoint that was previously created
3242 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3243 for full details.");
3244
3245   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3246    [InitISOFS, Always, TestOutputBuffer (
3247       [["read_file"; "/known-4"]], "abc\ndef\nghi")],
3248    "read a file",
3249    "\
3250 This calls returns the contents of the file C<path> as a
3251 buffer.
3252
3253 Unlike C<guestfs_cat>, this function can correctly
3254 handle files that contain embedded ASCII NUL characters.
3255 However unlike C<guestfs_download>, this function is limited
3256 in the total size of file that can be handled.");
3257
3258   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3259    [InitISOFS, Always, TestOutputList (
3260       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3261     InitISOFS, Always, TestOutputList (
3262       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3263    "return lines matching a pattern",
3264    "\
3265 This calls the external C<grep> program and returns the
3266 matching lines.");
3267
3268   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3269    [InitISOFS, Always, TestOutputList (
3270       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3271    "return lines matching a pattern",
3272    "\
3273 This calls the external C<egrep> program and returns the
3274 matching lines.");
3275
3276   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3277    [InitISOFS, Always, TestOutputList (
3278       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3279    "return lines matching a pattern",
3280    "\
3281 This calls the external C<fgrep> program and returns the
3282 matching lines.");
3283
3284   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3285    [InitISOFS, Always, TestOutputList (
3286       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3287    "return lines matching a pattern",
3288    "\
3289 This calls the external C<grep -i> program and returns the
3290 matching lines.");
3291
3292   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3293    [InitISOFS, Always, TestOutputList (
3294       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3295    "return lines matching a pattern",
3296    "\
3297 This calls the external C<egrep -i> program and returns the
3298 matching lines.");
3299
3300   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3301    [InitISOFS, Always, TestOutputList (
3302       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3303    "return lines matching a pattern",
3304    "\
3305 This calls the external C<fgrep -i> program and returns the
3306 matching lines.");
3307
3308   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3309    [InitISOFS, Always, TestOutputList (
3310       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3311    "return lines matching a pattern",
3312    "\
3313 This calls the external C<zgrep> program and returns the
3314 matching lines.");
3315
3316   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3317    [InitISOFS, Always, TestOutputList (
3318       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3319    "return lines matching a pattern",
3320    "\
3321 This calls the external C<zegrep> program and returns the
3322 matching lines.");
3323
3324   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3325    [InitISOFS, Always, TestOutputList (
3326       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3327    "return lines matching a pattern",
3328    "\
3329 This calls the external C<zfgrep> program and returns the
3330 matching lines.");
3331
3332   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3333    [InitISOFS, Always, TestOutputList (
3334       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3335    "return lines matching a pattern",
3336    "\
3337 This calls the external C<zgrep -i> program and returns the
3338 matching lines.");
3339
3340   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3341    [InitISOFS, Always, TestOutputList (
3342       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3343    "return lines matching a pattern",
3344    "\
3345 This calls the external C<zegrep -i> program and returns the
3346 matching lines.");
3347
3348   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3349    [InitISOFS, Always, TestOutputList (
3350       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3351    "return lines matching a pattern",
3352    "\
3353 This calls the external C<zfgrep -i> program and returns the
3354 matching lines.");
3355
3356   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3357    [InitISOFS, Always, TestOutput (
3358       [["realpath"; "/../directory"]], "/directory")],
3359    "canonicalized absolute pathname",
3360    "\
3361 Return the canonicalized absolute pathname of C<path>.  The
3362 returned path has no C<.>, C<..> or symbolic link path elements.");
3363
3364   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3365    [InitBasicFS, Always, TestOutputStruct (
3366       [["touch"; "/a"];
3367        ["ln"; "/a"; "/b"];
3368        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3369    "create a hard link",
3370    "\
3371 This command creates a hard link using the C<ln> command.");
3372
3373   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3374    [InitBasicFS, Always, TestOutputStruct (
3375       [["touch"; "/a"];
3376        ["touch"; "/b"];
3377        ["ln_f"; "/a"; "/b"];
3378        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3379    "create a hard link",
3380    "\
3381 This command creates a hard link using the C<ln -f> command.
3382 The C<-f> option removes the link (C<linkname>) if it exists already.");
3383
3384   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3385    [InitBasicFS, Always, TestOutputStruct (
3386       [["touch"; "/a"];
3387        ["ln_s"; "a"; "/b"];
3388        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3389    "create a symbolic link",
3390    "\
3391 This command creates a symbolic link using the C<ln -s> command.");
3392
3393   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3394    [InitBasicFS, Always, TestOutput (
3395       [["mkdir_p"; "/a/b"];
3396        ["touch"; "/a/b/c"];
3397        ["ln_sf"; "../d"; "/a/b/c"];
3398        ["readlink"; "/a/b/c"]], "../d")],
3399    "create a symbolic link",
3400    "\
3401 This command creates a symbolic link using the C<ln -sf> command,
3402 The C<-f> option removes the link (C<linkname>) if it exists already.");
3403
3404   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3405    [] (* XXX tested above *),
3406    "read the target of a symbolic link",
3407    "\
3408 This command reads the target of a symbolic link.");
3409
3410   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3411    [InitBasicFS, Always, TestOutputStruct (
3412       [["fallocate"; "/a"; "1000000"];
3413        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3414    "preallocate a file in the guest filesystem",
3415    "\
3416 This command preallocates a file (containing zero bytes) named
3417 C<path> of size C<len> bytes.  If the file exists already, it
3418 is overwritten.
3419
3420 Do not confuse this with the guestfish-specific
3421 C<alloc> command which allocates a file in the host and
3422 attaches it as a device.");
3423
3424   ("swapon_device", (RErr, [Device "device"]), 170, [],
3425    [InitPartition, Always, TestRun (
3426       [["mkswap"; "/dev/sda1"];
3427        ["swapon_device"; "/dev/sda1"];
3428        ["swapoff_device"; "/dev/sda1"]])],
3429    "enable swap on device",
3430    "\
3431 This command enables the libguestfs appliance to use the
3432 swap device or partition named C<device>.  The increased
3433 memory is made available for all commands, for example
3434 those run using C<guestfs_command> or C<guestfs_sh>.
3435
3436 Note that you should not swap to existing guest swap
3437 partitions unless you know what you are doing.  They may
3438 contain hibernation information, or other information that
3439 the guest doesn't want you to trash.  You also risk leaking
3440 information about the host to the guest this way.  Instead,
3441 attach a new host device to the guest and swap on that.");
3442
3443   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3444    [], (* XXX tested by swapon_device *)
3445    "disable swap on device",
3446    "\
3447 This command disables the libguestfs appliance swap
3448 device or partition named C<device>.
3449 See C<guestfs_swapon_device>.");
3450
3451   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3452    [InitBasicFS, Always, TestRun (
3453       [["fallocate"; "/swap"; "8388608"];
3454        ["mkswap_file"; "/swap"];
3455        ["swapon_file"; "/swap"];
3456        ["swapoff_file"; "/swap"]])],
3457    "enable swap on file",
3458    "\
3459 This command enables swap to a file.
3460 See C<guestfs_swapon_device> for other notes.");
3461
3462   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3463    [], (* XXX tested by swapon_file *)
3464    "disable swap on file",
3465    "\
3466 This command disables the libguestfs appliance swap on file.");
3467
3468   ("swapon_label", (RErr, [String "label"]), 174, [],
3469    [InitEmpty, Always, TestRun (
3470       [["part_disk"; "/dev/sdb"; "mbr"];
3471        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3472        ["swapon_label"; "swapit"];
3473        ["swapoff_label"; "swapit"];
3474        ["zero"; "/dev/sdb"];
3475        ["blockdev_rereadpt"; "/dev/sdb"]])],
3476    "enable swap on labeled swap partition",
3477    "\
3478 This command enables swap to a labeled swap partition.
3479 See C<guestfs_swapon_device> for other notes.");
3480
3481   ("swapoff_label", (RErr, [String "label"]), 175, [],
3482    [], (* XXX tested by swapon_label *)
3483    "disable swap on labeled swap partition",
3484    "\
3485 This command disables the libguestfs appliance swap on
3486 labeled swap partition.");
3487
3488   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3489    (let uuid = uuidgen () in
3490     [InitEmpty, Always, TestRun (
3491        [["mkswap_U"; uuid; "/dev/sdb"];
3492         ["swapon_uuid"; uuid];
3493         ["swapoff_uuid"; uuid]])]),
3494    "enable swap on swap partition by UUID",
3495    "\
3496 This command enables swap to a swap partition with the given UUID.
3497 See C<guestfs_swapon_device> for other notes.");
3498
3499   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3500    [], (* XXX tested by swapon_uuid *)
3501    "disable swap on swap partition by UUID",
3502    "\
3503 This command disables the libguestfs appliance swap partition
3504 with the given UUID.");
3505
3506   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3507    [InitBasicFS, Always, TestRun (
3508       [["fallocate"; "/swap"; "8388608"];
3509        ["mkswap_file"; "/swap"]])],
3510    "create a swap file",
3511    "\
3512 Create a swap file.
3513
3514 This command just writes a swap file signature to an existing
3515 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3516
3517   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3518    [InitISOFS, Always, TestRun (
3519       [["inotify_init"; "0"]])],
3520    "create an inotify handle",
3521    "\
3522 This command creates a new inotify handle.
3523 The inotify subsystem can be used to notify events which happen to
3524 objects in the guest filesystem.
3525
3526 C<maxevents> is the maximum number of events which will be
3527 queued up between calls to C<guestfs_inotify_read> or
3528 C<guestfs_inotify_files>.
3529 If this is passed as C<0>, then the kernel (or previously set)
3530 default is used.  For Linux 2.6.29 the default was 16384 events.
3531 Beyond this limit, the kernel throws away events, but records
3532 the fact that it threw them away by setting a flag
3533 C<IN_Q_OVERFLOW> in the returned structure list (see
3534 C<guestfs_inotify_read>).
3535
3536 Before any events are generated, you have to add some
3537 watches to the internal watch list.  See:
3538 C<guestfs_inotify_add_watch>,
3539 C<guestfs_inotify_rm_watch> and
3540 C<guestfs_inotify_watch_all>.
3541
3542 Queued up events should be read periodically by calling
3543 C<guestfs_inotify_read>
3544 (or C<guestfs_inotify_files> which is just a helpful
3545 wrapper around C<guestfs_inotify_read>).  If you don't
3546 read the events out often enough then you risk the internal
3547 queue overflowing.
3548
3549 The handle should be closed after use by calling
3550 C<guestfs_inotify_close>.  This also removes any
3551 watches automatically.
3552
3553 See also L<inotify(7)> for an overview of the inotify interface
3554 as exposed by the Linux kernel, which is roughly what we expose
3555 via libguestfs.  Note that there is one global inotify handle
3556 per libguestfs instance.");
3557
3558   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3559    [InitBasicFS, Always, TestOutputList (
3560       [["inotify_init"; "0"];
3561        ["inotify_add_watch"; "/"; "1073741823"];
3562        ["touch"; "/a"];
3563        ["touch"; "/b"];
3564        ["inotify_files"]], ["a"; "b"])],
3565    "add an inotify watch",
3566    "\
3567 Watch C<path> for the events listed in C<mask>.
3568
3569 Note that if C<path> is a directory then events within that
3570 directory are watched, but this does I<not> happen recursively
3571 (in subdirectories).
3572
3573 Note for non-C or non-Linux callers: the inotify events are
3574 defined by the Linux kernel ABI and are listed in
3575 C</usr/include/sys/inotify.h>.");
3576
3577   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3578    [],
3579    "remove an inotify watch",
3580    "\
3581 Remove a previously defined inotify watch.
3582 See C<guestfs_inotify_add_watch>.");
3583
3584   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3585    [],
3586    "return list of inotify events",
3587    "\
3588 Return the complete queue of events that have happened
3589 since the previous read call.
3590
3591 If no events have happened, this returns an empty list.
3592
3593 I<Note>: In order to make sure that all events have been
3594 read, you must call this function repeatedly until it
3595 returns an empty list.  The reason is that the call will
3596 read events up to the maximum appliance-to-host message
3597 size and leave remaining events in the queue.");
3598
3599   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3600    [],
3601    "return list of watched files that had events",
3602    "\
3603 This function is a helpful wrapper around C<guestfs_inotify_read>
3604 which just returns a list of pathnames of objects that were
3605 touched.  The returned pathnames are sorted and deduplicated.");
3606
3607   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3608    [],
3609    "close the inotify handle",
3610    "\
3611 This closes the inotify handle which was previously
3612 opened by inotify_init.  It removes all watches, throws
3613 away any pending events, and deallocates all resources.");
3614
3615   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3616    [],
3617    "set SELinux security context",
3618    "\
3619 This sets the SELinux security context of the daemon
3620 to the string C<context>.
3621
3622 See the documentation about SELINUX in L<guestfs(3)>.");
3623
3624   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3625    [],
3626    "get SELinux security context",
3627    "\
3628 This gets the SELinux security context of the daemon.
3629
3630 See the documentation about SELINUX in L<guestfs(3)>,
3631 and C<guestfs_setcon>");
3632
3633   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3634    [InitEmpty, Always, TestOutput (
3635       [["part_disk"; "/dev/sda"; "mbr"];
3636        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3637        ["mount_options"; ""; "/dev/sda1"; "/"];
3638        ["write_file"; "/new"; "new file contents"; "0"];
3639        ["cat"; "/new"]], "new file contents")],
3640    "make a filesystem with block size",
3641    "\
3642 This call is similar to C<guestfs_mkfs>, but it allows you to
3643 control the block size of the resulting filesystem.  Supported
3644 block sizes depend on the filesystem type, but typically they
3645 are C<1024>, C<2048> or C<4096> only.");
3646
3647   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3648    [InitEmpty, Always, TestOutput (
3649       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3650        ["mke2journal"; "4096"; "/dev/sda1"];
3651        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3652        ["mount_options"; ""; "/dev/sda2"; "/"];
3653        ["write_file"; "/new"; "new file contents"; "0"];
3654        ["cat"; "/new"]], "new file contents")],
3655    "make ext2/3/4 external journal",
3656    "\
3657 This creates an ext2 external journal on C<device>.  It is equivalent
3658 to the command:
3659
3660  mke2fs -O journal_dev -b blocksize device");
3661
3662   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3663    [InitEmpty, Always, TestOutput (
3664       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3665        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3666        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3667        ["mount_options"; ""; "/dev/sda2"; "/"];
3668        ["write_file"; "/new"; "new file contents"; "0"];
3669        ["cat"; "/new"]], "new file contents")],
3670    "make ext2/3/4 external journal with label",
3671    "\
3672 This creates an ext2 external journal on C<device> with label C<label>.");
3673
3674   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3675    (let uuid = uuidgen () in
3676     [InitEmpty, Always, TestOutput (
3677        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3678         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3679         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3680         ["mount_options"; ""; "/dev/sda2"; "/"];
3681         ["write_file"; "/new"; "new file contents"; "0"];
3682         ["cat"; "/new"]], "new file contents")]),
3683    "make ext2/3/4 external journal with UUID",
3684    "\
3685 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3686
3687   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3688    [],
3689    "make ext2/3/4 filesystem with external journal",
3690    "\
3691 This creates an ext2/3/4 filesystem on C<device> with
3692 an external journal on C<journal>.  It is equivalent
3693 to the command:
3694
3695  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3696
3697 See also C<guestfs_mke2journal>.");
3698
3699   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3700    [],
3701    "make ext2/3/4 filesystem with external journal",
3702    "\
3703 This creates an ext2/3/4 filesystem on C<device> with
3704 an external journal on the journal labeled C<label>.
3705
3706 See also C<guestfs_mke2journal_L>.");
3707
3708   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3709    [],
3710    "make ext2/3/4 filesystem with external journal",
3711    "\
3712 This creates an ext2/3/4 filesystem on C<device> with
3713 an external journal on the journal with UUID C<uuid>.
3714
3715 See also C<guestfs_mke2journal_U>.");
3716
3717   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3718    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3719    "load a kernel module",
3720    "\
3721 This loads a kernel module in the appliance.
3722
3723 The kernel module must have been whitelisted when libguestfs
3724 was built (see C<appliance/kmod.whitelist.in> in the source).");
3725
3726   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3727    [InitNone, Always, TestOutput (
3728       [["echo_daemon"; "This is a test"]], "This is a test"
3729     )],
3730    "echo arguments back to the client",
3731    "\
3732 This command concatenate the list of C<words> passed with single spaces between
3733 them and returns the resulting string.
3734
3735 You can use this command to test the connection through to the daemon.
3736
3737 See also C<guestfs_ping_daemon>.");
3738
3739   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3740    [], (* There is a regression test for this. *)
3741    "find all files and directories, returning NUL-separated list",
3742    "\
3743 This command lists out all files and directories, recursively,
3744 starting at C<directory>, placing the resulting list in the
3745 external file called C<files>.
3746
3747 This command works the same way as C<guestfs_find> with the
3748 following exceptions:
3749
3750 =over 4
3751
3752 =item *
3753
3754 The resulting list is written to an external file.
3755
3756 =item *
3757
3758 Items (filenames) in the result are separated
3759 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3760
3761 =item *
3762
3763 This command is not limited in the number of names that it
3764 can return.
3765
3766 =item *
3767
3768 The result list is not sorted.
3769
3770 =back");
3771
3772   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3773    [InitISOFS, Always, TestOutput (
3774       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3775     InitISOFS, Always, TestOutput (
3776       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3777     InitISOFS, Always, TestOutput (
3778       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3779     InitISOFS, Always, TestLastFail (
3780       [["case_sensitive_path"; "/Known-1/"]]);
3781     InitBasicFS, Always, TestOutput (
3782       [["mkdir"; "/a"];
3783        ["mkdir"; "/a/bbb"];
3784        ["touch"; "/a/bbb/c"];
3785        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3786     InitBasicFS, Always, TestOutput (
3787       [["mkdir"; "/a"];
3788        ["mkdir"; "/a/bbb"];
3789        ["touch"; "/a/bbb/c"];
3790        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3791     InitBasicFS, Always, TestLastFail (
3792       [["mkdir"; "/a"];
3793        ["mkdir"; "/a/bbb"];
3794        ["touch"; "/a/bbb/c"];
3795        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3796    "return true path on case-insensitive filesystem",
3797    "\
3798 This can be used to resolve case insensitive paths on
3799 a filesystem which is case sensitive.  The use case is
3800 to resolve paths which you have read from Windows configuration
3801 files or the Windows Registry, to the true path.
3802
3803 The command handles a peculiarity of the Linux ntfs-3g
3804 filesystem driver (and probably others), which is that although
3805 the underlying filesystem is case-insensitive, the driver
3806 exports the filesystem to Linux as case-sensitive.
3807
3808 One consequence of this is that special directories such
3809 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3810 (or other things) depending on the precise details of how
3811 they were created.  In Windows itself this would not be
3812 a problem.
3813
3814 Bug or feature?  You decide:
3815 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3816
3817 This function resolves the true case of each element in the
3818 path and returns the case-sensitive path.
3819
3820 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3821 might return C<\"/WINDOWS/system32\"> (the exact return value
3822 would depend on details of how the directories were originally
3823 created under Windows).
3824
3825 I<Note>:
3826 This function does not handle drive names, backslashes etc.
3827
3828 See also C<guestfs_realpath>.");
3829
3830   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3831    [InitBasicFS, Always, TestOutput (
3832       [["vfs_type"; "/dev/sda1"]], "ext2")],
3833    "get the Linux VFS type corresponding to a mounted device",
3834    "\
3835 This command gets the block device type corresponding to
3836 a mounted device called C<device>.
3837
3838 Usually the result is the name of the Linux VFS module that
3839 is used to mount this device (probably determined automatically
3840 if you used the C<guestfs_mount> call).");
3841
3842   ("truncate", (RErr, [Pathname "path"]), 199, [],
3843    [InitBasicFS, Always, TestOutputStruct (
3844       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3845        ["truncate"; "/test"];
3846        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3847    "truncate a file to zero size",
3848    "\
3849 This command truncates C<path> to a zero-length file.  The
3850 file must exist already.");
3851
3852   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3853    [InitBasicFS, Always, TestOutputStruct (
3854       [["touch"; "/test"];
3855        ["truncate_size"; "/test"; "1000"];
3856        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3857    "truncate a file to a particular size",
3858    "\
3859 This command truncates C<path> to size C<size> bytes.  The file
3860 must exist already.  If the file is smaller than C<size> then
3861 the file is extended to the required size with null bytes.");
3862
3863   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3864    [InitBasicFS, Always, TestOutputStruct (
3865       [["touch"; "/test"];
3866        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3867        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3868    "set timestamp of a file with nanosecond precision",
3869    "\
3870 This command sets the timestamps of a file with nanosecond
3871 precision.
3872
3873 C<atsecs, atnsecs> are the last access time (atime) in secs and
3874 nanoseconds from the epoch.
3875
3876 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3877 secs and nanoseconds from the epoch.
3878
3879 If the C<*nsecs> field contains the special value C<-1> then
3880 the corresponding timestamp is set to the current time.  (The
3881 C<*secs> field is ignored in this case).
3882
3883 If the C<*nsecs> field contains the special value C<-2> then
3884 the corresponding timestamp is left unchanged.  (The
3885 C<*secs> field is ignored in this case).");
3886
3887   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3888    [InitBasicFS, Always, TestOutputStruct (
3889       [["mkdir_mode"; "/test"; "0o111"];
3890        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3891    "create a directory with a particular mode",
3892    "\
3893 This command creates a directory, setting the initial permissions
3894 of the directory to C<mode>.
3895
3896 For common Linux filesystems, the actual mode which is set will
3897 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3898 interpret the mode in other ways.
3899
3900 See also C<guestfs_mkdir>, C<guestfs_umask>");
3901
3902   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3903    [], (* XXX *)
3904    "change file owner and group",
3905    "\
3906 Change the file owner to C<owner> and group to C<group>.
3907 This is like C<guestfs_chown> but if C<path> is a symlink then
3908 the link itself is changed, not the target.
3909
3910 Only numeric uid and gid are supported.  If you want to use
3911 names, you will need to locate and parse the password file
3912 yourself (Augeas support makes this relatively easy).");
3913
3914   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3915    [], (* XXX *)
3916    "lstat on multiple files",
3917    "\
3918 This call allows you to perform the C<guestfs_lstat> operation
3919 on multiple files, where all files are in the directory C<path>.
3920 C<names> is the list of files from this directory.
3921
3922 On return you get a list of stat structs, with a one-to-one
3923 correspondence to the C<names> list.  If any name did not exist
3924 or could not be lstat'd, then the C<ino> field of that structure
3925 is set to C<-1>.
3926
3927 This call is intended for programs that want to efficiently
3928 list a directory contents without making many round-trips.
3929 See also C<guestfs_lxattrlist> for a similarly efficient call
3930 for getting extended attributes.  Very long directory listings
3931 might cause the protocol message size to be exceeded, causing
3932 this call to fail.  The caller must split up such requests
3933 into smaller groups of names.");
3934
3935   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
3936    [], (* XXX *)
3937    "lgetxattr on multiple files",
3938    "\
3939 This call allows you to get the extended attributes
3940 of multiple files, where all files are in the directory C<path>.
3941 C<names> is the list of files from this directory.
3942
3943 On return you get a flat list of xattr structs which must be
3944 interpreted sequentially.  The first xattr struct always has a zero-length
3945 C<attrname>.  C<attrval> in this struct is zero-length
3946 to indicate there was an error doing C<lgetxattr> for this
3947 file, I<or> is a C string which is a decimal number
3948 (the number of following attributes for this file, which could
3949 be C<\"0\">).  Then after the first xattr struct are the
3950 zero or more attributes for the first named file.
3951 This repeats for the second and subsequent files.
3952
3953 This call is intended for programs that want to efficiently
3954 list a directory contents without making many round-trips.
3955 See also C<guestfs_lstatlist> for a similarly efficient call
3956 for getting standard stats.  Very long directory listings
3957 might cause the protocol message size to be exceeded, causing
3958 this call to fail.  The caller must split up such requests
3959 into smaller groups of names.");
3960
3961   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
3962    [], (* XXX *)
3963    "readlink on multiple files",
3964    "\
3965 This call allows you to do a C<readlink> operation
3966 on multiple files, where all files are in the directory C<path>.
3967 C<names> is the list of files from this directory.
3968
3969 On return you get a list of strings, with a one-to-one
3970 correspondence to the C<names> list.  Each string is the
3971 value of the symbol link.
3972
3973 If the C<readlink(2)> operation fails on any name, then
3974 the corresponding result string is the empty string C<\"\">.
3975 However the whole operation is completed even if there
3976 were C<readlink(2)> errors, and so you can call this
3977 function with names where you don't know if they are
3978 symbolic links already (albeit slightly less efficient).
3979
3980 This call is intended for programs that want to efficiently
3981 list a directory contents without making many round-trips.
3982 Very long directory listings might cause the protocol
3983 message size to be exceeded, causing
3984 this call to fail.  The caller must split up such requests
3985 into smaller groups of names.");
3986
3987   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
3988    [InitISOFS, Always, TestOutputBuffer (
3989       [["pread"; "/known-4"; "1"; "3"]], "\n");
3990     InitISOFS, Always, TestOutputBuffer (
3991       [["pread"; "/empty"; "0"; "100"]], "")],
3992    "read part of a file",
3993    "\
3994 This command lets you read part of a file.  It reads C<count>
3995 bytes of the file, starting at C<offset>, from file C<path>.
3996
3997 This may read fewer bytes than requested.  For further details
3998 see the L<pread(2)> system call.");
3999
4000   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4001    [InitEmpty, Always, TestRun (
4002       [["part_init"; "/dev/sda"; "gpt"]])],
4003    "create an empty partition table",
4004    "\
4005 This creates an empty partition table on C<device> of one of the
4006 partition types listed below.  Usually C<parttype> should be
4007 either C<msdos> or C<gpt> (for large disks).
4008
4009 Initially there are no partitions.  Following this, you should
4010 call C<guestfs_part_add> for each partition required.
4011
4012 Possible values for C<parttype> are:
4013
4014 =over 4
4015
4016 =item B<efi> | B<gpt>
4017
4018 Intel EFI / GPT partition table.
4019
4020 This is recommended for >= 2 TB partitions that will be accessed
4021 from Linux and Intel-based Mac OS X.  It also has limited backwards
4022 compatibility with the C<mbr> format.
4023
4024 =item B<mbr> | B<msdos>
4025
4026 The standard PC \"Master Boot Record\" (MBR) format used
4027 by MS-DOS and Windows.  This partition type will B<only> work
4028 for device sizes up to 2 TB.  For large disks we recommend
4029 using C<gpt>.
4030
4031 =back
4032
4033 Other partition table types that may work but are not
4034 supported include:
4035
4036 =over 4
4037
4038 =item B<aix>
4039
4040 AIX disk labels.
4041
4042 =item B<amiga> | B<rdb>
4043
4044 Amiga \"Rigid Disk Block\" format.
4045
4046 =item B<bsd>
4047
4048 BSD disk labels.
4049
4050 =item B<dasd>
4051
4052 DASD, used on IBM mainframes.
4053
4054 =item B<dvh>
4055
4056 MIPS/SGI volumes.
4057
4058 =item B<mac>
4059
4060 Old Mac partition format.  Modern Macs use C<gpt>.
4061
4062 =item B<pc98>
4063
4064 NEC PC-98 format, common in Japan apparently.
4065
4066 =item B<sun>
4067
4068 Sun disk labels.
4069
4070 =back");
4071
4072   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4073    [InitEmpty, Always, TestRun (
4074       [["part_init"; "/dev/sda"; "mbr"];
4075        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4076     InitEmpty, Always, TestRun (
4077       [["part_init"; "/dev/sda"; "gpt"];
4078        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4079        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4080     InitEmpty, Always, TestRun (
4081       [["part_init"; "/dev/sda"; "mbr"];
4082        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4083        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4084        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4085        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4086    "add a partition to the device",
4087    "\
4088 This command adds a partition to C<device>.  If there is no partition
4089 table on the device, call C<guestfs_part_init> first.
4090
4091 The C<prlogex> parameter is the type of partition.  Normally you
4092 should pass C<p> or C<primary> here, but MBR partition tables also
4093 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4094 types.
4095
4096 C<startsect> and C<endsect> are the start and end of the partition
4097 in I<sectors>.  C<endsect> may be negative, which means it counts
4098 backwards from the end of the disk (C<-1> is the last sector).
4099
4100 Creating a partition which covers the whole disk is not so easy.
4101 Use C<guestfs_part_disk> to do that.");
4102
4103   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4104    [InitEmpty, Always, TestRun (
4105       [["part_disk"; "/dev/sda"; "mbr"]]);
4106     InitEmpty, Always, TestRun (
4107       [["part_disk"; "/dev/sda"; "gpt"]])],
4108    "partition whole disk with a single primary partition",
4109    "\
4110 This command is simply a combination of C<guestfs_part_init>
4111 followed by C<guestfs_part_add> to create a single primary partition
4112 covering the whole disk.
4113
4114 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4115 but other possible values are described in C<guestfs_part_init>.");
4116
4117   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4118    [InitEmpty, Always, TestRun (
4119       [["part_disk"; "/dev/sda"; "mbr"];
4120        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4121    "make a partition bootable",
4122    "\
4123 This sets the bootable flag on partition numbered C<partnum> on
4124 device C<device>.  Note that partitions are numbered from 1.
4125
4126 The bootable flag is used by some operating systems (notably
4127 Windows) to determine which partition to boot from.  It is by
4128 no means universally recognized.");
4129
4130   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4131    [InitEmpty, Always, TestRun (
4132       [["part_disk"; "/dev/sda"; "gpt"];
4133        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4134    "set partition name",
4135    "\
4136 This sets the partition name on partition numbered C<partnum> on
4137 device C<device>.  Note that partitions are numbered from 1.
4138
4139 The partition name can only be set on certain types of partition
4140 table.  This works on C<gpt> but not on C<mbr> partitions.");
4141
4142   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4143    [], (* XXX Add a regression test for this. *)
4144    "list partitions on a device",
4145    "\
4146 This command parses the partition table on C<device> and
4147 returns the list of partitions found.
4148
4149 The fields in the returned structure are:
4150
4151 =over 4
4152
4153 =item B<part_num>
4154
4155 Partition number, counting from 1.
4156
4157 =item B<part_start>
4158
4159 Start of the partition I<in bytes>.  To get sectors you have to
4160 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4161
4162 =item B<part_end>
4163
4164 End of the partition in bytes.
4165
4166 =item B<part_size>
4167
4168 Size of the partition in bytes.
4169
4170 =back");
4171
4172   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4173    [InitEmpty, Always, TestOutput (
4174       [["part_disk"; "/dev/sda"; "gpt"];
4175        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4176    "get the partition table type",
4177    "\
4178 This command examines the partition table on C<device> and
4179 returns the partition table type (format) being used.
4180
4181 Common return values include: C<msdos> (a DOS/Windows style MBR
4182 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4183 values are possible, although unusual.  See C<guestfs_part_init>
4184 for a full list.");
4185
4186   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4187    [InitBasicFS, Always, TestOutputBuffer (
4188       [["fill"; "0x63"; "10"; "/test"];
4189        ["read_file"; "/test"]], "cccccccccc")],
4190    "fill a file with octets",
4191    "\
4192 This command creates a new file called C<path>.  The initial
4193 content of the file is C<len> octets of C<c>, where C<c>
4194 must be a number in the range C<[0..255]>.
4195
4196 To fill a file with zero bytes (sparsely), it is
4197 much more efficient to use C<guestfs_truncate_size>.");
4198
4199   ("available", (RErr, [StringList "groups"]), 216, [],
4200    [InitNone, Always, TestRun [["available"; ""]]],
4201    "test availability of some parts of the API",
4202    "\
4203 This command is used to check the availability of some
4204 groups of functionality in the appliance, which not all builds of
4205 the libguestfs appliance will be able to provide.
4206
4207 The libguestfs groups, and the functions that those
4208 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4209
4210 The argument C<groups> is a list of group names, eg:
4211 C<[\"inotify\", \"augeas\"]> would check for the availability of
4212 the Linux inotify functions and Augeas (configuration file
4213 editing) functions.
4214
4215 The command returns no error if I<all> requested groups are available.
4216
4217 It fails with an error if one or more of the requested
4218 groups is unavailable in the appliance.
4219
4220 If an unknown group name is included in the
4221 list of groups then an error is always returned.
4222
4223 I<Notes:>
4224
4225 =over 4
4226
4227 =item *
4228
4229 You must call C<guestfs_launch> before calling this function.
4230
4231 The reason is because we don't know what groups are
4232 supported by the appliance/daemon until it is running and can
4233 be queried.
4234
4235 =item *
4236
4237 If a group of functions is available, this does not necessarily
4238 mean that they will work.  You still have to check for errors
4239 when calling individual API functions even if they are
4240 available.
4241
4242 =item *
4243
4244 It is usually the job of distro packagers to build
4245 complete functionality into the libguestfs appliance.
4246 Upstream libguestfs, if built from source with all
4247 requirements satisfied, will support everything.
4248
4249 =item *
4250
4251 This call was added in version C<1.0.80>.  In previous
4252 versions of libguestfs all you could do would be to speculatively
4253 execute a command to find out if the daemon implemented it.
4254 See also C<guestfs_version>.
4255
4256 =back");
4257
4258   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4259    [InitBasicFS, Always, TestOutputBuffer (
4260       [["write_file"; "/src"; "hello, world"; "0"];
4261        ["dd"; "/src"; "/dest"];
4262        ["read_file"; "/dest"]], "hello, world")],
4263    "copy from source to destination using dd",
4264    "\
4265 This command copies from one source device or file C<src>
4266 to another destination device or file C<dest>.  Normally you
4267 would use this to copy to or from a device or partition, for
4268 example to duplicate a filesystem.
4269
4270 If the destination is a device, it must be as large or larger
4271 than the source file or device, otherwise the copy will fail.
4272 This command cannot do partial copies (see C<guestfs_copy_size>).");
4273
4274   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4275    [InitBasicFS, Always, TestOutputInt (
4276       [["write_file"; "/file"; "hello, world"; "0"];
4277        ["filesize"; "/file"]], 12)],
4278    "return the size of the file in bytes",
4279    "\
4280 This command returns the size of C<file> in bytes.
4281
4282 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4283 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4284 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4285
4286   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4287    [InitBasicFSonLVM, Always, TestOutputList (
4288       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4289        ["lvs"]], ["/dev/VG/LV2"])],
4290    "rename an LVM logical volume",
4291    "\
4292 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4293
4294   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4295    [InitBasicFSonLVM, Always, TestOutputList (
4296       [["umount"; "/"];
4297        ["vg_activate"; "false"; "VG"];
4298        ["vgrename"; "VG"; "VG2"];
4299        ["vg_activate"; "true"; "VG2"];
4300        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4301        ["vgs"]], ["VG2"])],
4302    "rename an LVM volume group",
4303    "\
4304 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4305
4306   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4307    [InitISOFS, Always, TestOutputBuffer (
4308       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4309    "list the contents of a single file in an initrd",
4310    "\
4311 This command unpacks the file C<filename> from the initrd file
4312 called C<initrdpath>.  The filename must be given I<without> the
4313 initial C</> character.
4314
4315 For example, in guestfish you could use the following command
4316 to examine the boot script (usually called C</init>)
4317 contained in a Linux initrd or initramfs image:
4318
4319  initrd-cat /boot/initrd-<version>.img init
4320
4321 See also C<guestfs_initrd_list>.");
4322
4323   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4324    [],
4325    "get the UUID of a physical volume",
4326    "\
4327 This command returns the UUID of the LVM PV C<device>.");
4328
4329   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4330    [],
4331    "get the UUID of a volume group",
4332    "\
4333 This command returns the UUID of the LVM VG named C<vgname>.");
4334
4335   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4336    [],
4337    "get the UUID of a logical volume",
4338    "\
4339 This command returns the UUID of the LVM LV C<device>.");
4340
4341   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4342    [],
4343    "get the PV UUIDs containing the volume group",
4344    "\
4345 Given a VG called C<vgname>, this returns the UUIDs of all
4346 the physical volumes that this volume group resides on.
4347
4348 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4349 calls to associate physical volumes and volume groups.
4350
4351 See also C<guestfs_vglvuuids>.");
4352
4353   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4354    [],
4355    "get the LV UUIDs of all LVs in the volume group",
4356    "\
4357 Given a VG called C<vgname>, this returns the UUIDs of all
4358 the logical volumes created in this volume group.
4359
4360 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4361 calls to associate logical volumes and volume groups.
4362
4363 See also C<guestfs_vgpvuuids>.");
4364
4365   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4366    [InitBasicFS, Always, TestOutputBuffer (
4367       [["write_file"; "/src"; "hello, world"; "0"];
4368        ["copy_size"; "/src"; "/dest"; "5"];
4369        ["read_file"; "/dest"]], "hello")],
4370    "copy size bytes from source to destination using dd",
4371    "\
4372 This command copies exactly C<size> bytes from one source device
4373 or file C<src> to another destination device or file C<dest>.
4374
4375 Note this will fail if the source is too short or if the destination
4376 is not large enough.");
4377
4378   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4379    [InitEmpty, Always, TestRun (
4380       [["part_init"; "/dev/sda"; "mbr"];
4381        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4382        ["part_del"; "/dev/sda"; "1"]])],
4383    "delete a partition",
4384    "\
4385 This command deletes the partition numbered C<partnum> on C<device>.
4386
4387 Note that in the case of MBR partitioning, deleting an
4388 extended partition also deletes any logical partitions
4389 it contains.");
4390
4391   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4392    [InitEmpty, Always, TestOutputTrue (
4393       [["part_init"; "/dev/sda"; "mbr"];
4394        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4395        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4396        ["part_get_bootable"; "/dev/sda"; "1"]])],
4397    "return true if a partition is bootable",
4398    "\
4399 This command returns true if the partition C<partnum> on
4400 C<device> has the bootable flag set.
4401
4402 See also C<guestfs_part_set_bootable>.");
4403
4404   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4405    [InitEmpty, Always, TestOutputInt (
4406       [["part_init"; "/dev/sda"; "mbr"];
4407        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4408        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4409        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4410    "get the MBR type byte (ID byte) from a partition",
4411    "\
4412 Returns the MBR type byte (also known as the ID byte) from
4413 the numbered partition C<partnum>.
4414
4415 Note that only MBR (old DOS-style) partitions have type bytes.
4416 You will get undefined results for other partition table
4417 types (see C<guestfs_part_get_parttype>).");
4418
4419   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4420    [], (* tested by part_get_mbr_id *)
4421    "set the MBR type byte (ID byte) of a partition",
4422    "\
4423 Sets the MBR type byte (also known as the ID byte) of
4424 the numbered partition C<partnum> to C<idbyte>.  Note
4425 that the type bytes quoted in most documentation are
4426 in fact hexadecimal numbers, but usually documented
4427 without any leading \"0x\" which might be confusing.
4428
4429 Note that only MBR (old DOS-style) partitions have type bytes.
4430 You will get undefined results for other partition table
4431 types (see C<guestfs_part_get_parttype>).");
4432
4433 ]
4434
4435 let all_functions = non_daemon_functions @ daemon_functions
4436
4437 (* In some places we want the functions to be displayed sorted
4438  * alphabetically, so this is useful:
4439  *)
4440 let all_functions_sorted =
4441   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4442                compare n1 n2) all_functions
4443
4444 (* Field types for structures. *)
4445 type field =
4446   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4447   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4448   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4449   | FUInt32
4450   | FInt32
4451   | FUInt64
4452   | FInt64
4453   | FBytes                      (* Any int measure that counts bytes. *)
4454   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4455   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4456
4457 (* Because we generate extra parsing code for LVM command line tools,
4458  * we have to pull out the LVM columns separately here.
4459  *)
4460 let lvm_pv_cols = [
4461   "pv_name", FString;
4462   "pv_uuid", FUUID;
4463   "pv_fmt", FString;
4464   "pv_size", FBytes;
4465   "dev_size", FBytes;
4466   "pv_free", FBytes;
4467   "pv_used", FBytes;
4468   "pv_attr", FString (* XXX *);
4469   "pv_pe_count", FInt64;
4470   "pv_pe_alloc_count", FInt64;
4471   "pv_tags", FString;
4472   "pe_start", FBytes;
4473   "pv_mda_count", FInt64;
4474   "pv_mda_free", FBytes;
4475   (* Not in Fedora 10:
4476      "pv_mda_size", FBytes;
4477   *)
4478 ]
4479 let lvm_vg_cols = [
4480   "vg_name", FString;
4481   "vg_uuid", FUUID;
4482   "vg_fmt", FString;
4483   "vg_attr", FString (* XXX *);
4484   "vg_size", FBytes;
4485   "vg_free", FBytes;
4486   "vg_sysid", FString;
4487   "vg_extent_size", FBytes;
4488   "vg_extent_count", FInt64;
4489   "vg_free_count", FInt64;
4490   "max_lv", FInt64;
4491   "max_pv", FInt64;
4492   "pv_count", FInt64;
4493   "lv_count", FInt64;
4494   "snap_count", FInt64;
4495   "vg_seqno", FInt64;
4496   "vg_tags", FString;
4497   "vg_mda_count", FInt64;
4498   "vg_mda_free", FBytes;
4499   (* Not in Fedora 10:
4500      "vg_mda_size", FBytes;
4501   *)
4502 ]
4503 let lvm_lv_cols = [
4504   "lv_name", FString;
4505   "lv_uuid", FUUID;
4506   "lv_attr", FString (* XXX *);
4507   "lv_major", FInt64;
4508   "lv_minor", FInt64;
4509   "lv_kernel_major", FInt64;
4510   "lv_kernel_minor", FInt64;
4511   "lv_size", FBytes;
4512   "seg_count", FInt64;
4513   "origin", FString;
4514   "snap_percent", FOptPercent;
4515   "copy_percent", FOptPercent;
4516   "move_pv", FString;
4517   "lv_tags", FString;
4518   "mirror_log", FString;
4519   "modules", FString;
4520 ]
4521
4522 (* Names and fields in all structures (in RStruct and RStructList)
4523  * that we support.
4524  *)
4525 let structs = [
4526   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4527    * not use this struct in any new code.
4528    *)
4529   "int_bool", [
4530     "i", FInt32;                (* for historical compatibility *)
4531     "b", FInt32;                (* for historical compatibility *)
4532   ];
4533
4534   (* LVM PVs, VGs, LVs. *)
4535   "lvm_pv", lvm_pv_cols;
4536   "lvm_vg", lvm_vg_cols;
4537   "lvm_lv", lvm_lv_cols;
4538
4539   (* Column names and types from stat structures.
4540    * NB. Can't use things like 'st_atime' because glibc header files
4541    * define some of these as macros.  Ugh.
4542    *)
4543   "stat", [
4544     "dev", FInt64;
4545     "ino", FInt64;
4546     "mode", FInt64;
4547     "nlink", FInt64;
4548     "uid", FInt64;
4549     "gid", FInt64;
4550     "rdev", FInt64;
4551     "size", FInt64;
4552     "blksize", FInt64;
4553     "blocks", FInt64;
4554     "atime", FInt64;
4555     "mtime", FInt64;
4556     "ctime", FInt64;
4557   ];
4558   "statvfs", [
4559     "bsize", FInt64;
4560     "frsize", FInt64;
4561     "blocks", FInt64;
4562     "bfree", FInt64;
4563     "bavail", FInt64;
4564     "files", FInt64;
4565     "ffree", FInt64;
4566     "favail", FInt64;
4567     "fsid", FInt64;
4568     "flag", FInt64;
4569     "namemax", FInt64;
4570   ];
4571
4572   (* Column names in dirent structure. *)
4573   "dirent", [
4574     "ino", FInt64;
4575     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4576     "ftyp", FChar;
4577     "name", FString;
4578   ];
4579
4580   (* Version numbers. *)
4581   "version", [
4582     "major", FInt64;
4583     "minor", FInt64;
4584     "release", FInt64;
4585     "extra", FString;
4586   ];
4587
4588   (* Extended attribute. *)
4589   "xattr", [
4590     "attrname", FString;
4591     "attrval", FBuffer;
4592   ];
4593
4594   (* Inotify events. *)
4595   "inotify_event", [
4596     "in_wd", FInt64;
4597     "in_mask", FUInt32;
4598     "in_cookie", FUInt32;
4599     "in_name", FString;
4600   ];
4601
4602   (* Partition table entry. *)
4603   "partition", [
4604     "part_num", FInt32;
4605     "part_start", FBytes;
4606     "part_end", FBytes;
4607     "part_size", FBytes;
4608   ];
4609 ] (* end of structs *)
4610
4611 (* Ugh, Java has to be different ..
4612  * These names are also used by the Haskell bindings.
4613  *)
4614 let java_structs = [
4615   "int_bool", "IntBool";
4616   "lvm_pv", "PV";
4617   "lvm_vg", "VG";
4618   "lvm_lv", "LV";
4619   "stat", "Stat";
4620   "statvfs", "StatVFS";
4621   "dirent", "Dirent";
4622   "version", "Version";
4623   "xattr", "XAttr";
4624   "inotify_event", "INotifyEvent";
4625   "partition", "Partition";
4626 ]
4627
4628 (* What structs are actually returned. *)
4629 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4630
4631 (* Returns a list of RStruct/RStructList structs that are returned
4632  * by any function.  Each element of returned list is a pair:
4633  *
4634  * (structname, RStructOnly)
4635  *    == there exists function which returns RStruct (_, structname)
4636  * (structname, RStructListOnly)
4637  *    == there exists function which returns RStructList (_, structname)
4638  * (structname, RStructAndList)
4639  *    == there are functions returning both RStruct (_, structname)
4640  *                                      and RStructList (_, structname)
4641  *)
4642 let rstructs_used_by functions =
4643   (* ||| is a "logical OR" for rstructs_used_t *)
4644   let (|||) a b =
4645     match a, b with
4646     | RStructAndList, _
4647     | _, RStructAndList -> RStructAndList
4648     | RStructOnly, RStructListOnly
4649     | RStructListOnly, RStructOnly -> RStructAndList
4650     | RStructOnly, RStructOnly -> RStructOnly
4651     | RStructListOnly, RStructListOnly -> RStructListOnly
4652   in
4653
4654   let h = Hashtbl.create 13 in
4655
4656   (* if elem->oldv exists, update entry using ||| operator,
4657    * else just add elem->newv to the hash
4658    *)
4659   let update elem newv =
4660     try  let oldv = Hashtbl.find h elem in
4661          Hashtbl.replace h elem (newv ||| oldv)
4662     with Not_found -> Hashtbl.add h elem newv
4663   in
4664
4665   List.iter (
4666     fun (_, style, _, _, _, _, _) ->
4667       match fst style with
4668       | RStruct (_, structname) -> update structname RStructOnly
4669       | RStructList (_, structname) -> update structname RStructListOnly
4670       | _ -> ()
4671   ) functions;
4672
4673   (* return key->values as a list of (key,value) *)
4674   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4675
4676 (* Used for testing language bindings. *)
4677 type callt =
4678   | CallString of string
4679   | CallOptString of string option
4680   | CallStringList of string list
4681   | CallInt of int
4682   | CallInt64 of int64
4683   | CallBool of bool
4684
4685 (* Used to memoize the result of pod2text. *)
4686 let pod2text_memo_filename = "src/.pod2text.data"
4687 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4688   try
4689     let chan = open_in pod2text_memo_filename in
4690     let v = input_value chan in
4691     close_in chan;
4692     v
4693   with
4694     _ -> Hashtbl.create 13
4695 let pod2text_memo_updated () =
4696   let chan = open_out pod2text_memo_filename in
4697   output_value chan pod2text_memo;
4698   close_out chan
4699
4700 (* Useful functions.
4701  * Note we don't want to use any external OCaml libraries which
4702  * makes this a bit harder than it should be.
4703  *)
4704 module StringMap = Map.Make (String)
4705
4706 let failwithf fs = ksprintf failwith fs
4707
4708 let unique = let i = ref 0 in fun () -> incr i; !i
4709
4710 let replace_char s c1 c2 =
4711   let s2 = String.copy s in
4712   let r = ref false in
4713   for i = 0 to String.length s2 - 1 do
4714     if String.unsafe_get s2 i = c1 then (
4715       String.unsafe_set s2 i c2;
4716       r := true
4717     )
4718   done;
4719   if not !r then s else s2
4720
4721 let isspace c =
4722   c = ' '
4723   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4724
4725 let triml ?(test = isspace) str =
4726   let i = ref 0 in
4727   let n = ref (String.length str) in
4728   while !n > 0 && test str.[!i]; do
4729     decr n;
4730     incr i
4731   done;
4732   if !i = 0 then str
4733   else String.sub str !i !n
4734
4735 let trimr ?(test = isspace) str =
4736   let n = ref (String.length str) in
4737   while !n > 0 && test str.[!n-1]; do
4738     decr n
4739   done;
4740   if !n = String.length str then str
4741   else String.sub str 0 !n
4742
4743 let trim ?(test = isspace) str =
4744   trimr ~test (triml ~test str)
4745
4746 let rec find s sub =
4747   let len = String.length s in
4748   let sublen = String.length sub in
4749   let rec loop i =
4750     if i <= len-sublen then (
4751       let rec loop2 j =
4752         if j < sublen then (
4753           if s.[i+j] = sub.[j] then loop2 (j+1)
4754           else -1
4755         ) else
4756           i (* found *)
4757       in
4758       let r = loop2 0 in
4759       if r = -1 then loop (i+1) else r
4760     ) else
4761       -1 (* not found *)
4762   in
4763   loop 0
4764
4765 let rec replace_str s s1 s2 =
4766   let len = String.length s in
4767   let sublen = String.length s1 in
4768   let i = find s s1 in
4769   if i = -1 then s
4770   else (
4771     let s' = String.sub s 0 i in
4772     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4773     s' ^ s2 ^ replace_str s'' s1 s2
4774   )
4775
4776 let rec string_split sep str =
4777   let len = String.length str in
4778   let seplen = String.length sep in
4779   let i = find str sep in
4780   if i = -1 then [str]
4781   else (
4782     let s' = String.sub str 0 i in
4783     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4784     s' :: string_split sep s''
4785   )
4786
4787 let files_equal n1 n2 =
4788   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4789   match Sys.command cmd with
4790   | 0 -> true
4791   | 1 -> false
4792   | i -> failwithf "%s: failed with error code %d" cmd i
4793
4794 let rec filter_map f = function
4795   | [] -> []
4796   | x :: xs ->
4797       match f x with
4798       | Some y -> y :: filter_map f xs
4799       | None -> filter_map f xs
4800
4801 let rec find_map f = function
4802   | [] -> raise Not_found
4803   | x :: xs ->
4804       match f x with
4805       | Some y -> y
4806       | None -> find_map f xs
4807
4808 let iteri f xs =
4809   let rec loop i = function
4810     | [] -> ()
4811     | x :: xs -> f i x; loop (i+1) xs
4812   in
4813   loop 0 xs
4814
4815 let mapi f xs =
4816   let rec loop i = function
4817     | [] -> []
4818     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4819   in
4820   loop 0 xs
4821
4822 let count_chars c str =
4823   let count = ref 0 in
4824   for i = 0 to String.length str - 1 do
4825     if c = String.unsafe_get str i then incr count
4826   done;
4827   !count
4828
4829 let name_of_argt = function
4830   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4831   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4832   | FileIn n | FileOut n -> n
4833
4834 let java_name_of_struct typ =
4835   try List.assoc typ java_structs
4836   with Not_found ->
4837     failwithf
4838       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4839
4840 let cols_of_struct typ =
4841   try List.assoc typ structs
4842   with Not_found ->
4843     failwithf "cols_of_struct: unknown struct %s" typ
4844
4845 let seq_of_test = function
4846   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4847   | TestOutputListOfDevices (s, _)
4848   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4849   | TestOutputTrue s | TestOutputFalse s
4850   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4851   | TestOutputStruct (s, _)
4852   | TestLastFail s -> s
4853
4854 (* Handling for function flags. *)
4855 let protocol_limit_warning =
4856   "Because of the message protocol, there is a transfer limit
4857 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4858
4859 let danger_will_robinson =
4860   "B<This command is dangerous.  Without careful use you
4861 can easily destroy all your data>."
4862
4863 let deprecation_notice flags =
4864   try
4865     let alt =
4866       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4867     let txt =
4868       sprintf "This function is deprecated.
4869 In new code, use the C<%s> call instead.
4870
4871 Deprecated functions will not be removed from the API, but the
4872 fact that they are deprecated indicates that there are problems
4873 with correct use of these functions." alt in
4874     Some txt
4875   with
4876     Not_found -> None
4877
4878 (* Create list of optional groups. *)
4879 let optgroups =
4880   let h = Hashtbl.create 13 in
4881   List.iter (
4882     fun (name, _, _, flags, _, _, _) ->
4883       List.iter (
4884         function
4885         | Optional group ->
4886             let names = try Hashtbl.find h group with Not_found -> [] in
4887             Hashtbl.replace h group (name :: names)
4888         | _ -> ()
4889       ) flags
4890   ) daemon_functions;
4891   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4892   let groups =
4893     List.map (
4894       fun group -> group, List.sort compare (Hashtbl.find h group)
4895     ) groups in
4896   List.sort (fun x y -> compare (fst x) (fst y)) groups
4897
4898 (* Check function names etc. for consistency. *)
4899 let check_functions () =
4900   let contains_uppercase str =
4901     let len = String.length str in
4902     let rec loop i =
4903       if i >= len then false
4904       else (
4905         let c = str.[i] in
4906         if c >= 'A' && c <= 'Z' then true
4907         else loop (i+1)
4908       )
4909     in
4910     loop 0
4911   in
4912
4913   (* Check function names. *)
4914   List.iter (
4915     fun (name, _, _, _, _, _, _) ->
4916       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4917         failwithf "function name %s does not need 'guestfs' prefix" name;
4918       if name = "" then
4919         failwithf "function name is empty";
4920       if name.[0] < 'a' || name.[0] > 'z' then
4921         failwithf "function name %s must start with lowercase a-z" name;
4922       if String.contains name '-' then
4923         failwithf "function name %s should not contain '-', use '_' instead."
4924           name
4925   ) all_functions;
4926
4927   (* Check function parameter/return names. *)
4928   List.iter (
4929     fun (name, style, _, _, _, _, _) ->
4930       let check_arg_ret_name n =
4931         if contains_uppercase n then
4932           failwithf "%s param/ret %s should not contain uppercase chars"
4933             name n;
4934         if String.contains n '-' || String.contains n '_' then
4935           failwithf "%s param/ret %s should not contain '-' or '_'"
4936             name n;
4937         if n = "value" then
4938           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;
4939         if n = "int" || n = "char" || n = "short" || n = "long" then
4940           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
4941         if n = "i" || n = "n" then
4942           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
4943         if n = "argv" || n = "args" then
4944           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
4945
4946         (* List Haskell, OCaml and C keywords here.
4947          * http://www.haskell.org/haskellwiki/Keywords
4948          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
4949          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
4950          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
4951          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
4952          * Omitting _-containing words, since they're handled above.
4953          * Omitting the OCaml reserved word, "val", is ok,
4954          * and saves us from renaming several parameters.
4955          *)
4956         let reserved = [
4957           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
4958           "char"; "class"; "const"; "constraint"; "continue"; "data";
4959           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
4960           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
4961           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
4962           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
4963           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
4964           "interface";
4965           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
4966           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
4967           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
4968           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
4969           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
4970           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
4971           "volatile"; "when"; "where"; "while";
4972           ] in
4973         if List.mem n reserved then
4974           failwithf "%s has param/ret using reserved word %s" name n;
4975       in
4976
4977       (match fst style with
4978        | RErr -> ()
4979        | RInt n | RInt64 n | RBool n
4980        | RConstString n | RConstOptString n | RString n
4981        | RStringList n | RStruct (n, _) | RStructList (n, _)
4982        | RHashtable n | RBufferOut n ->
4983            check_arg_ret_name n
4984       );
4985       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
4986   ) all_functions;
4987
4988   (* Check short descriptions. *)
4989   List.iter (
4990     fun (name, _, _, _, _, shortdesc, _) ->
4991       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
4992         failwithf "short description of %s should begin with lowercase." name;
4993       let c = shortdesc.[String.length shortdesc-1] in
4994       if c = '\n' || c = '.' then
4995         failwithf "short description of %s should not end with . or \\n." name
4996   ) all_functions;
4997
4998   (* Check long descriptions. *)
4999   List.iter (
5000     fun (name, _, _, _, _, _, longdesc) ->
5001       if longdesc.[String.length longdesc-1] = '\n' then
5002         failwithf "long description of %s should not end with \\n." name
5003   ) all_functions;
5004
5005   (* Check proc_nrs. *)
5006   List.iter (
5007     fun (name, _, proc_nr, _, _, _, _) ->
5008       if proc_nr <= 0 then
5009         failwithf "daemon function %s should have proc_nr > 0" name
5010   ) daemon_functions;
5011
5012   List.iter (
5013     fun (name, _, proc_nr, _, _, _, _) ->
5014       if proc_nr <> -1 then
5015         failwithf "non-daemon function %s should have proc_nr -1" name
5016   ) non_daemon_functions;
5017
5018   let proc_nrs =
5019     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5020       daemon_functions in
5021   let proc_nrs =
5022     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5023   let rec loop = function
5024     | [] -> ()
5025     | [_] -> ()
5026     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5027         loop rest
5028     | (name1,nr1) :: (name2,nr2) :: _ ->
5029         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5030           name1 name2 nr1 nr2
5031   in
5032   loop proc_nrs;
5033
5034   (* Check tests. *)
5035   List.iter (
5036     function
5037       (* Ignore functions that have no tests.  We generate a
5038        * warning when the user does 'make check' instead.
5039        *)
5040     | name, _, _, _, [], _, _ -> ()
5041     | name, _, _, _, tests, _, _ ->
5042         let funcs =
5043           List.map (
5044             fun (_, _, test) ->
5045               match seq_of_test test with
5046               | [] ->
5047                   failwithf "%s has a test containing an empty sequence" name
5048               | cmds -> List.map List.hd cmds
5049           ) tests in
5050         let funcs = List.flatten funcs in
5051
5052         let tested = List.mem name funcs in
5053
5054         if not tested then
5055           failwithf "function %s has tests but does not test itself" name
5056   ) all_functions
5057
5058 (* 'pr' prints to the current output file. *)
5059 let chan = ref Pervasives.stdout
5060 let lines = ref 0
5061 let pr fs =
5062   ksprintf
5063     (fun str ->
5064        let i = count_chars '\n' str in
5065        lines := !lines + i;
5066        output_string !chan str
5067     ) fs
5068
5069 let copyright_years =
5070   let this_year = 1900 + (localtime (time ())).tm_year in
5071   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5072
5073 (* Generate a header block in a number of standard styles. *)
5074 type comment_style =
5075     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5076 type license = GPLv2plus | LGPLv2plus
5077
5078 let generate_header ?(extra_inputs = []) comment license =
5079   let inputs = "src/generator.ml" :: extra_inputs in
5080   let c = match comment with
5081     | CStyle ->         pr "/* "; " *"
5082     | CPlusPlusStyle -> pr "// "; "//"
5083     | HashStyle ->      pr "# ";  "#"
5084     | OCamlStyle ->     pr "(* "; " *"
5085     | HaskellStyle ->   pr "{- "; "  " in
5086   pr "libguestfs generated file\n";
5087   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5088   List.iter (pr "%s   %s\n" c) inputs;
5089   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5090   pr "%s\n" c;
5091   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5092   pr "%s\n" c;
5093   (match license with
5094    | GPLv2plus ->
5095        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5096        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5097        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5098        pr "%s (at your option) any later version.\n" c;
5099        pr "%s\n" c;
5100        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5101        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5102        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5103        pr "%s GNU General Public License for more details.\n" c;
5104        pr "%s\n" c;
5105        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5106        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5107        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5108
5109    | LGPLv2plus ->
5110        pr "%s This library is free software; you can redistribute it and/or\n" c;
5111        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5112        pr "%s License as published by the Free Software Foundation; either\n" c;
5113        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5114        pr "%s\n" c;
5115        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5116        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5117        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5118        pr "%s Lesser General Public License for more details.\n" c;
5119        pr "%s\n" c;
5120        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5121        pr "%s License along with this library; if not, write to the Free Software\n" c;
5122        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5123   );
5124   (match comment with
5125    | CStyle -> pr " */\n"
5126    | CPlusPlusStyle
5127    | HashStyle -> ()
5128    | OCamlStyle -> pr " *)\n"
5129    | HaskellStyle -> pr "-}\n"
5130   );
5131   pr "\n"
5132
5133 (* Start of main code generation functions below this line. *)
5134
5135 (* Generate the pod documentation for the C API. *)
5136 let rec generate_actions_pod () =
5137   List.iter (
5138     fun (shortname, style, _, flags, _, _, longdesc) ->
5139       if not (List.mem NotInDocs flags) then (
5140         let name = "guestfs_" ^ shortname in
5141         pr "=head2 %s\n\n" name;
5142         pr " ";
5143         generate_prototype ~extern:false ~handle:"g" name style;
5144         pr "\n\n";
5145         pr "%s\n\n" longdesc;
5146         (match fst style with
5147          | RErr ->
5148              pr "This function returns 0 on success or -1 on error.\n\n"
5149          | RInt _ ->
5150              pr "On error this function returns -1.\n\n"
5151          | RInt64 _ ->
5152              pr "On error this function returns -1.\n\n"
5153          | RBool _ ->
5154              pr "This function returns a C truth value on success or -1 on error.\n\n"
5155          | RConstString _ ->
5156              pr "This function returns a string, or NULL on error.
5157 The string is owned by the guest handle and must I<not> be freed.\n\n"
5158          | RConstOptString _ ->
5159              pr "This function returns a string which may be NULL.
5160 There is way to return an error from this function.
5161 The string is owned by the guest handle and must I<not> be freed.\n\n"
5162          | RString _ ->
5163              pr "This function returns a string, or NULL on error.
5164 I<The caller must free the returned string after use>.\n\n"
5165          | RStringList _ ->
5166              pr "This function returns a NULL-terminated array of strings
5167 (like L<environ(3)>), or NULL if there was an error.
5168 I<The caller must free the strings and the array after use>.\n\n"
5169          | RStruct (_, typ) ->
5170              pr "This function returns a C<struct guestfs_%s *>,
5171 or NULL if there was an error.
5172 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5173          | RStructList (_, typ) ->
5174              pr "This function returns a C<struct guestfs_%s_list *>
5175 (see E<lt>guestfs-structs.hE<gt>),
5176 or NULL if there was an error.
5177 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5178          | RHashtable _ ->
5179              pr "This function returns a NULL-terminated array of
5180 strings, or NULL if there was an error.
5181 The array of strings will always have length C<2n+1>, where
5182 C<n> keys and values alternate, followed by the trailing NULL entry.
5183 I<The caller must free the strings and the array after use>.\n\n"
5184          | RBufferOut _ ->
5185              pr "This function returns a buffer, or NULL on error.
5186 The size of the returned buffer is written to C<*size_r>.
5187 I<The caller must free the returned buffer after use>.\n\n"
5188         );
5189         if List.mem ProtocolLimitWarning flags then
5190           pr "%s\n\n" protocol_limit_warning;
5191         if List.mem DangerWillRobinson flags then
5192           pr "%s\n\n" danger_will_robinson;
5193         match deprecation_notice flags with
5194         | None -> ()
5195         | Some txt -> pr "%s\n\n" txt
5196       )
5197   ) all_functions_sorted
5198
5199 and generate_structs_pod () =
5200   (* Structs documentation. *)
5201   List.iter (
5202     fun (typ, cols) ->
5203       pr "=head2 guestfs_%s\n" typ;
5204       pr "\n";
5205       pr " struct guestfs_%s {\n" typ;
5206       List.iter (
5207         function
5208         | name, FChar -> pr "   char %s;\n" name
5209         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5210         | name, FInt32 -> pr "   int32_t %s;\n" name
5211         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5212         | name, FInt64 -> pr "   int64_t %s;\n" name
5213         | name, FString -> pr "   char *%s;\n" name
5214         | name, FBuffer ->
5215             pr "   /* The next two fields describe a byte array. */\n";
5216             pr "   uint32_t %s_len;\n" name;
5217             pr "   char *%s;\n" name
5218         | name, FUUID ->
5219             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5220             pr "   char %s[32];\n" name
5221         | name, FOptPercent ->
5222             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5223             pr "   float %s;\n" name
5224       ) cols;
5225       pr " };\n";
5226       pr " \n";
5227       pr " struct guestfs_%s_list {\n" typ;
5228       pr "   uint32_t len; /* Number of elements in list. */\n";
5229       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5230       pr " };\n";
5231       pr " \n";
5232       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5233       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5234         typ typ;
5235       pr "\n"
5236   ) structs
5237
5238 and generate_availability_pod () =
5239   (* Availability documentation. *)
5240   pr "=over 4\n";
5241   pr "\n";
5242   List.iter (
5243     fun (group, functions) ->
5244       pr "=item B<%s>\n" group;
5245       pr "\n";
5246       pr "The following functions:\n";
5247       List.iter (pr "L</guestfs_%s>\n") functions;
5248       pr "\n"
5249   ) optgroups;
5250   pr "=back\n";
5251   pr "\n"
5252
5253 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5254  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5255  *
5256  * We have to use an underscore instead of a dash because otherwise
5257  * rpcgen generates incorrect code.
5258  *
5259  * This header is NOT exported to clients, but see also generate_structs_h.
5260  *)
5261 and generate_xdr () =
5262   generate_header CStyle LGPLv2plus;
5263
5264   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5265   pr "typedef string str<>;\n";
5266   pr "\n";
5267
5268   (* Internal structures. *)
5269   List.iter (
5270     function
5271     | typ, cols ->
5272         pr "struct guestfs_int_%s {\n" typ;
5273         List.iter (function
5274                    | name, FChar -> pr "  char %s;\n" name
5275                    | name, FString -> pr "  string %s<>;\n" name
5276                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5277                    | name, FUUID -> pr "  opaque %s[32];\n" name
5278                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5279                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5280                    | name, FOptPercent -> pr "  float %s;\n" name
5281                   ) cols;
5282         pr "};\n";
5283         pr "\n";
5284         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5285         pr "\n";
5286   ) structs;
5287
5288   List.iter (
5289     fun (shortname, style, _, _, _, _, _) ->
5290       let name = "guestfs_" ^ shortname in
5291
5292       (match snd style with
5293        | [] -> ()
5294        | args ->
5295            pr "struct %s_args {\n" name;
5296            List.iter (
5297              function
5298              | Pathname n | Device n | Dev_or_Path n | String n ->
5299                  pr "  string %s<>;\n" n
5300              | OptString n -> pr "  str *%s;\n" n
5301              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5302              | Bool n -> pr "  bool %s;\n" n
5303              | Int n -> pr "  int %s;\n" n
5304              | Int64 n -> pr "  hyper %s;\n" n
5305              | FileIn _ | FileOut _ -> ()
5306            ) args;
5307            pr "};\n\n"
5308       );
5309       (match fst style with
5310        | RErr -> ()
5311        | RInt n ->
5312            pr "struct %s_ret {\n" name;
5313            pr "  int %s;\n" n;
5314            pr "};\n\n"
5315        | RInt64 n ->
5316            pr "struct %s_ret {\n" name;
5317            pr "  hyper %s;\n" n;
5318            pr "};\n\n"
5319        | RBool n ->
5320            pr "struct %s_ret {\n" name;
5321            pr "  bool %s;\n" n;
5322            pr "};\n\n"
5323        | RConstString _ | RConstOptString _ ->
5324            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5325        | RString n ->
5326            pr "struct %s_ret {\n" name;
5327            pr "  string %s<>;\n" n;
5328            pr "};\n\n"
5329        | RStringList n ->
5330            pr "struct %s_ret {\n" name;
5331            pr "  str %s<>;\n" n;
5332            pr "};\n\n"
5333        | RStruct (n, typ) ->
5334            pr "struct %s_ret {\n" name;
5335            pr "  guestfs_int_%s %s;\n" typ n;
5336            pr "};\n\n"
5337        | RStructList (n, typ) ->
5338            pr "struct %s_ret {\n" name;
5339            pr "  guestfs_int_%s_list %s;\n" typ n;
5340            pr "};\n\n"
5341        | RHashtable n ->
5342            pr "struct %s_ret {\n" name;
5343            pr "  str %s<>;\n" n;
5344            pr "};\n\n"
5345        | RBufferOut n ->
5346            pr "struct %s_ret {\n" name;
5347            pr "  opaque %s<>;\n" n;
5348            pr "};\n\n"
5349       );
5350   ) daemon_functions;
5351
5352   (* Table of procedure numbers. *)
5353   pr "enum guestfs_procedure {\n";
5354   List.iter (
5355     fun (shortname, _, proc_nr, _, _, _, _) ->
5356       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5357   ) daemon_functions;
5358   pr "  GUESTFS_PROC_NR_PROCS\n";
5359   pr "};\n";
5360   pr "\n";
5361
5362   (* Having to choose a maximum message size is annoying for several
5363    * reasons (it limits what we can do in the API), but it (a) makes
5364    * the protocol a lot simpler, and (b) provides a bound on the size
5365    * of the daemon which operates in limited memory space.
5366    *)
5367   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5368   pr "\n";
5369
5370   (* Message header, etc. *)
5371   pr "\
5372 /* The communication protocol is now documented in the guestfs(3)
5373  * manpage.
5374  */
5375
5376 const GUESTFS_PROGRAM = 0x2000F5F5;
5377 const GUESTFS_PROTOCOL_VERSION = 1;
5378
5379 /* These constants must be larger than any possible message length. */
5380 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5381 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5382
5383 enum guestfs_message_direction {
5384   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5385   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5386 };
5387
5388 enum guestfs_message_status {
5389   GUESTFS_STATUS_OK = 0,
5390   GUESTFS_STATUS_ERROR = 1
5391 };
5392
5393 const GUESTFS_ERROR_LEN = 256;
5394
5395 struct guestfs_message_error {
5396   string error_message<GUESTFS_ERROR_LEN>;
5397 };
5398
5399 struct guestfs_message_header {
5400   unsigned prog;                     /* GUESTFS_PROGRAM */
5401   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5402   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5403   guestfs_message_direction direction;
5404   unsigned serial;                   /* message serial number */
5405   guestfs_message_status status;
5406 };
5407
5408 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5409
5410 struct guestfs_chunk {
5411   int cancel;                        /* if non-zero, transfer is cancelled */
5412   /* data size is 0 bytes if the transfer has finished successfully */
5413   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5414 };
5415 "
5416
5417 (* Generate the guestfs-structs.h file. *)
5418 and generate_structs_h () =
5419   generate_header CStyle LGPLv2plus;
5420
5421   (* This is a public exported header file containing various
5422    * structures.  The structures are carefully written to have
5423    * exactly the same in-memory format as the XDR structures that
5424    * we use on the wire to the daemon.  The reason for creating
5425    * copies of these structures here is just so we don't have to
5426    * export the whole of guestfs_protocol.h (which includes much
5427    * unrelated and XDR-dependent stuff that we don't want to be
5428    * public, or required by clients).
5429    *
5430    * To reiterate, we will pass these structures to and from the
5431    * client with a simple assignment or memcpy, so the format
5432    * must be identical to what rpcgen / the RFC defines.
5433    *)
5434
5435   (* Public structures. *)
5436   List.iter (
5437     fun (typ, cols) ->
5438       pr "struct guestfs_%s {\n" typ;
5439       List.iter (
5440         function
5441         | name, FChar -> pr "  char %s;\n" name
5442         | name, FString -> pr "  char *%s;\n" name
5443         | name, FBuffer ->
5444             pr "  uint32_t %s_len;\n" name;
5445             pr "  char *%s;\n" name
5446         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5447         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5448         | name, FInt32 -> pr "  int32_t %s;\n" name
5449         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5450         | name, FInt64 -> pr "  int64_t %s;\n" name
5451         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5452       ) cols;
5453       pr "};\n";
5454       pr "\n";
5455       pr "struct guestfs_%s_list {\n" typ;
5456       pr "  uint32_t len;\n";
5457       pr "  struct guestfs_%s *val;\n" typ;
5458       pr "};\n";
5459       pr "\n";
5460       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5461       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5462       pr "\n"
5463   ) structs
5464
5465 (* Generate the guestfs-actions.h file. *)
5466 and generate_actions_h () =
5467   generate_header CStyle LGPLv2plus;
5468   List.iter (
5469     fun (shortname, style, _, _, _, _, _) ->
5470       let name = "guestfs_" ^ shortname in
5471       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5472         name style
5473   ) all_functions
5474
5475 (* Generate the guestfs-internal-actions.h file. *)
5476 and generate_internal_actions_h () =
5477   generate_header CStyle LGPLv2plus;
5478   List.iter (
5479     fun (shortname, style, _, _, _, _, _) ->
5480       let name = "guestfs__" ^ shortname in
5481       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5482         name style
5483   ) non_daemon_functions
5484
5485 (* Generate the client-side dispatch stubs. *)
5486 and generate_client_actions () =
5487   generate_header CStyle LGPLv2plus;
5488
5489   pr "\
5490 #include <stdio.h>
5491 #include <stdlib.h>
5492 #include <stdint.h>
5493 #include <string.h>
5494 #include <inttypes.h>
5495
5496 #include \"guestfs.h\"
5497 #include \"guestfs-internal.h\"
5498 #include \"guestfs-internal-actions.h\"
5499 #include \"guestfs_protocol.h\"
5500
5501 #define error guestfs_error
5502 //#define perrorf guestfs_perrorf
5503 #define safe_malloc guestfs_safe_malloc
5504 #define safe_realloc guestfs_safe_realloc
5505 //#define safe_strdup guestfs_safe_strdup
5506 #define safe_memdup guestfs_safe_memdup
5507
5508 /* Check the return message from a call for validity. */
5509 static int
5510 check_reply_header (guestfs_h *g,
5511                     const struct guestfs_message_header *hdr,
5512                     unsigned int proc_nr, unsigned int serial)
5513 {
5514   if (hdr->prog != GUESTFS_PROGRAM) {
5515     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5516     return -1;
5517   }
5518   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5519     error (g, \"wrong protocol version (%%d/%%d)\",
5520            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5521     return -1;
5522   }
5523   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5524     error (g, \"unexpected message direction (%%d/%%d)\",
5525            hdr->direction, GUESTFS_DIRECTION_REPLY);
5526     return -1;
5527   }
5528   if (hdr->proc != proc_nr) {
5529     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5530     return -1;
5531   }
5532   if (hdr->serial != serial) {
5533     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5534     return -1;
5535   }
5536
5537   return 0;
5538 }
5539
5540 /* Check we are in the right state to run a high-level action. */
5541 static int
5542 check_state (guestfs_h *g, const char *caller)
5543 {
5544   if (!guestfs__is_ready (g)) {
5545     if (guestfs__is_config (g) || guestfs__is_launching (g))
5546       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5547         caller);
5548     else
5549       error (g, \"%%s called from the wrong state, %%d != READY\",
5550         caller, guestfs__get_state (g));
5551     return -1;
5552   }
5553   return 0;
5554 }
5555
5556 ";
5557
5558   (* Generate code to generate guestfish call traces. *)
5559   let trace_call shortname style =
5560     pr "  if (guestfs__get_trace (g)) {\n";
5561
5562     let needs_i =
5563       List.exists (function
5564                    | StringList _ | DeviceList _ -> true
5565                    | _ -> false) (snd style) in
5566     if needs_i then (
5567       pr "    int i;\n";
5568       pr "\n"
5569     );
5570
5571     pr "    printf (\"%s\");\n" shortname;
5572     List.iter (
5573       function
5574       | String n                        (* strings *)
5575       | Device n
5576       | Pathname n
5577       | Dev_or_Path n
5578       | FileIn n
5579       | FileOut n ->
5580           (* guestfish doesn't support string escaping, so neither do we *)
5581           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5582       | OptString n ->                  (* string option *)
5583           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5584           pr "    else printf (\" null\");\n"
5585       | StringList n
5586       | DeviceList n ->                 (* string list *)
5587           pr "    putchar (' ');\n";
5588           pr "    putchar ('\"');\n";
5589           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5590           pr "      if (i > 0) putchar (' ');\n";
5591           pr "      fputs (%s[i], stdout);\n" n;
5592           pr "    }\n";
5593           pr "    putchar ('\"');\n";
5594       | Bool n ->                       (* boolean *)
5595           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5596       | Int n ->                        (* int *)
5597           pr "    printf (\" %%d\", %s);\n" n
5598       | Int64 n ->
5599           pr "    printf (\" %%\" PRIi64, %s);\n" n
5600     ) (snd style);
5601     pr "    putchar ('\\n');\n";
5602     pr "  }\n";
5603     pr "\n";
5604   in
5605
5606   (* For non-daemon functions, generate a wrapper around each function. *)
5607   List.iter (
5608     fun (shortname, style, _, _, _, _, _) ->
5609       let name = "guestfs_" ^ shortname in
5610
5611       generate_prototype ~extern:false ~semicolon:false ~newline:true
5612         ~handle:"g" name style;
5613       pr "{\n";
5614       trace_call shortname style;
5615       pr "  return guestfs__%s " shortname;
5616       generate_c_call_args ~handle:"g" style;
5617       pr ";\n";
5618       pr "}\n";
5619       pr "\n"
5620   ) non_daemon_functions;
5621
5622   (* Client-side stubs for each function. *)
5623   List.iter (
5624     fun (shortname, style, _, _, _, _, _) ->
5625       let name = "guestfs_" ^ shortname in
5626
5627       (* Generate the action stub. *)
5628       generate_prototype ~extern:false ~semicolon:false ~newline:true
5629         ~handle:"g" name style;
5630
5631       let error_code =
5632         match fst style with
5633         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5634         | RConstString _ | RConstOptString _ ->
5635             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5636         | RString _ | RStringList _
5637         | RStruct _ | RStructList _
5638         | RHashtable _ | RBufferOut _ ->
5639             "NULL" in
5640
5641       pr "{\n";
5642
5643       (match snd style with
5644        | [] -> ()
5645        | _ -> pr "  struct %s_args args;\n" name
5646       );
5647
5648       pr "  guestfs_message_header hdr;\n";
5649       pr "  guestfs_message_error err;\n";
5650       let has_ret =
5651         match fst style with
5652         | RErr -> false
5653         | RConstString _ | RConstOptString _ ->
5654             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5655         | RInt _ | RInt64 _
5656         | RBool _ | RString _ | RStringList _
5657         | RStruct _ | RStructList _
5658         | RHashtable _ | RBufferOut _ ->
5659             pr "  struct %s_ret ret;\n" name;
5660             true in
5661
5662       pr "  int serial;\n";
5663       pr "  int r;\n";
5664       pr "\n";
5665       trace_call shortname style;
5666       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5667       pr "  guestfs___set_busy (g);\n";
5668       pr "\n";
5669
5670       (* Send the main header and arguments. *)
5671       (match snd style with
5672        | [] ->
5673            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5674              (String.uppercase shortname)
5675        | args ->
5676            List.iter (
5677              function
5678              | Pathname n | Device n | Dev_or_Path n | String n ->
5679                  pr "  args.%s = (char *) %s;\n" n n
5680              | OptString n ->
5681                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5682              | StringList n | DeviceList n ->
5683                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5684                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5685              | Bool n ->
5686                  pr "  args.%s = %s;\n" n n
5687              | Int n ->
5688                  pr "  args.%s = %s;\n" n n
5689              | Int64 n ->
5690                  pr "  args.%s = %s;\n" n n
5691              | FileIn _ | FileOut _ -> ()
5692            ) args;
5693            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5694              (String.uppercase shortname);
5695            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5696              name;
5697       );
5698       pr "  if (serial == -1) {\n";
5699       pr "    guestfs___end_busy (g);\n";
5700       pr "    return %s;\n" error_code;
5701       pr "  }\n";
5702       pr "\n";
5703
5704       (* Send any additional files (FileIn) requested. *)
5705       let need_read_reply_label = ref false in
5706       List.iter (
5707         function
5708         | FileIn n ->
5709             pr "  r = guestfs___send_file (g, %s);\n" n;
5710             pr "  if (r == -1) {\n";
5711             pr "    guestfs___end_busy (g);\n";
5712             pr "    return %s;\n" error_code;
5713             pr "  }\n";
5714             pr "  if (r == -2) /* daemon cancelled */\n";
5715             pr "    goto read_reply;\n";
5716             need_read_reply_label := true;
5717             pr "\n";
5718         | _ -> ()
5719       ) (snd style);
5720
5721       (* Wait for the reply from the remote end. *)
5722       if !need_read_reply_label then pr " read_reply:\n";
5723       pr "  memset (&hdr, 0, sizeof hdr);\n";
5724       pr "  memset (&err, 0, sizeof err);\n";
5725       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5726       pr "\n";
5727       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5728       if not has_ret then
5729         pr "NULL, NULL"
5730       else
5731         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5732       pr ");\n";
5733
5734       pr "  if (r == -1) {\n";
5735       pr "    guestfs___end_busy (g);\n";
5736       pr "    return %s;\n" error_code;
5737       pr "  }\n";
5738       pr "\n";
5739
5740       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5741         (String.uppercase shortname);
5742       pr "    guestfs___end_busy (g);\n";
5743       pr "    return %s;\n" error_code;
5744       pr "  }\n";
5745       pr "\n";
5746
5747       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5748       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5749       pr "    free (err.error_message);\n";
5750       pr "    guestfs___end_busy (g);\n";
5751       pr "    return %s;\n" error_code;
5752       pr "  }\n";
5753       pr "\n";
5754
5755       (* Expecting to receive further files (FileOut)? *)
5756       List.iter (
5757         function
5758         | FileOut n ->
5759             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5760             pr "    guestfs___end_busy (g);\n";
5761             pr "    return %s;\n" error_code;
5762             pr "  }\n";
5763             pr "\n";
5764         | _ -> ()
5765       ) (snd style);
5766
5767       pr "  guestfs___end_busy (g);\n";
5768
5769       (match fst style with
5770        | RErr -> pr "  return 0;\n"
5771        | RInt n | RInt64 n | RBool n ->
5772            pr "  return ret.%s;\n" n
5773        | RConstString _ | RConstOptString _ ->
5774            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5775        | RString n ->
5776            pr "  return ret.%s; /* caller will free */\n" n
5777        | RStringList n | RHashtable n ->
5778            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5779            pr "  ret.%s.%s_val =\n" n n;
5780            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5781            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5782              n n;
5783            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5784            pr "  return ret.%s.%s_val;\n" n n
5785        | RStruct (n, _) ->
5786            pr "  /* caller will free this */\n";
5787            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5788        | RStructList (n, _) ->
5789            pr "  /* caller will free this */\n";
5790            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5791        | RBufferOut n ->
5792            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5793            pr "   * _val might be NULL here.  To make the API saner for\n";
5794            pr "   * callers, we turn this case into a unique pointer (using\n";
5795            pr "   * malloc(1)).\n";
5796            pr "   */\n";
5797            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5798            pr "    *size_r = ret.%s.%s_len;\n" n n;
5799            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5800            pr "  } else {\n";
5801            pr "    free (ret.%s.%s_val);\n" n n;
5802            pr "    char *p = safe_malloc (g, 1);\n";
5803            pr "    *size_r = ret.%s.%s_len;\n" n n;
5804            pr "    return p;\n";
5805            pr "  }\n";
5806       );
5807
5808       pr "}\n\n"
5809   ) daemon_functions;
5810
5811   (* Functions to free structures. *)
5812   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5813   pr " * structure format is identical to the XDR format.  See note in\n";
5814   pr " * generator.ml.\n";
5815   pr " */\n";
5816   pr "\n";
5817
5818   List.iter (
5819     fun (typ, _) ->
5820       pr "void\n";
5821       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5822       pr "{\n";
5823       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5824       pr "  free (x);\n";
5825       pr "}\n";
5826       pr "\n";
5827
5828       pr "void\n";
5829       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5830       pr "{\n";
5831       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5832       pr "  free (x);\n";
5833       pr "}\n";
5834       pr "\n";
5835
5836   ) structs;
5837
5838 (* Generate daemon/actions.h. *)
5839 and generate_daemon_actions_h () =
5840   generate_header CStyle GPLv2plus;
5841
5842   pr "#include \"../src/guestfs_protocol.h\"\n";
5843   pr "\n";
5844
5845   List.iter (
5846     fun (name, style, _, _, _, _, _) ->
5847       generate_prototype
5848         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5849         name style;
5850   ) daemon_functions
5851
5852 (* Generate the linker script which controls the visibility of
5853  * symbols in the public ABI and ensures no other symbols get
5854  * exported accidentally.
5855  *)
5856 and generate_linker_script () =
5857   generate_header HashStyle GPLv2plus;
5858
5859   let globals = [
5860     "guestfs_create";
5861     "guestfs_close";
5862     "guestfs_get_error_handler";
5863     "guestfs_get_out_of_memory_handler";
5864     "guestfs_last_error";
5865     "guestfs_set_error_handler";
5866     "guestfs_set_launch_done_callback";
5867     "guestfs_set_log_message_callback";
5868     "guestfs_set_out_of_memory_handler";
5869     "guestfs_set_subprocess_quit_callback";
5870
5871     (* Unofficial parts of the API: the bindings code use these
5872      * functions, so it is useful to export them.
5873      *)
5874     "guestfs_safe_calloc";
5875     "guestfs_safe_malloc";
5876   ] in
5877   let functions =
5878     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5879       all_functions in
5880   let structs =
5881     List.concat (
5882       List.map (fun (typ, _) ->
5883                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5884         structs
5885     ) in
5886   let globals = List.sort compare (globals @ functions @ structs) in
5887
5888   pr "{\n";
5889   pr "    global:\n";
5890   List.iter (pr "        %s;\n") globals;
5891   pr "\n";
5892
5893   pr "    local:\n";
5894   pr "        *;\n";
5895   pr "};\n"
5896
5897 (* Generate the server-side stubs. *)
5898 and generate_daemon_actions () =
5899   generate_header CStyle GPLv2plus;
5900
5901   pr "#include <config.h>\n";
5902   pr "\n";
5903   pr "#include <stdio.h>\n";
5904   pr "#include <stdlib.h>\n";
5905   pr "#include <string.h>\n";
5906   pr "#include <inttypes.h>\n";
5907   pr "#include <rpc/types.h>\n";
5908   pr "#include <rpc/xdr.h>\n";
5909   pr "\n";
5910   pr "#include \"daemon.h\"\n";
5911   pr "#include \"c-ctype.h\"\n";
5912   pr "#include \"../src/guestfs_protocol.h\"\n";
5913   pr "#include \"actions.h\"\n";
5914   pr "\n";
5915
5916   List.iter (
5917     fun (name, style, _, _, _, _, _) ->
5918       (* Generate server-side stubs. *)
5919       pr "static void %s_stub (XDR *xdr_in)\n" name;
5920       pr "{\n";
5921       let error_code =
5922         match fst style with
5923         | RErr | RInt _ -> pr "  int r;\n"; "-1"
5924         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
5925         | RBool _ -> pr "  int r;\n"; "-1"
5926         | RConstString _ | RConstOptString _ ->
5927             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5928         | RString _ -> pr "  char *r;\n"; "NULL"
5929         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
5930         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
5931         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
5932         | RBufferOut _ ->
5933             pr "  size_t size = 1;\n";
5934             pr "  char *r;\n";
5935             "NULL" in
5936
5937       (match snd style with
5938        | [] -> ()
5939        | args ->
5940            pr "  struct guestfs_%s_args args;\n" name;
5941            List.iter (
5942              function
5943              | Device n | Dev_or_Path n
5944              | Pathname n
5945              | String n -> ()
5946              | OptString n -> pr "  char *%s;\n" n
5947              | StringList n | DeviceList n -> pr "  char **%s;\n" n
5948              | Bool n -> pr "  int %s;\n" n
5949              | Int n -> pr "  int %s;\n" n
5950              | Int64 n -> pr "  int64_t %s;\n" n
5951              | FileIn _ | FileOut _ -> ()
5952            ) args
5953       );
5954       pr "\n";
5955
5956       (match snd style with
5957        | [] -> ()
5958        | args ->
5959            pr "  memset (&args, 0, sizeof args);\n";
5960            pr "\n";
5961            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
5962            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
5963            pr "    return;\n";
5964            pr "  }\n";
5965            let pr_args n =
5966              pr "  char *%s = args.%s;\n" n n
5967            in
5968            let pr_list_handling_code n =
5969              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
5970              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
5971              pr "  if (%s == NULL) {\n" n;
5972              pr "    reply_with_perror (\"realloc\");\n";
5973              pr "    goto done;\n";
5974              pr "  }\n";
5975              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
5976              pr "  args.%s.%s_val = %s;\n" n n n;
5977            in
5978            List.iter (
5979              function
5980              | Pathname n ->
5981                  pr_args n;
5982                  pr "  ABS_PATH (%s, goto done);\n" n;
5983              | Device n ->
5984                  pr_args n;
5985                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
5986              | Dev_or_Path n ->
5987                  pr_args n;
5988                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
5989              | String n -> pr_args n
5990              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
5991              | StringList n ->
5992                  pr_list_handling_code n;
5993              | DeviceList n ->
5994                  pr_list_handling_code n;
5995                  pr "  /* Ensure that each is a device,\n";
5996                  pr "   * and perform device name translation. */\n";
5997                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
5998                  pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
5999                  pr "  }\n";
6000              | Bool n -> pr "  %s = args.%s;\n" n n
6001              | Int n -> pr "  %s = args.%s;\n" n n
6002              | Int64 n -> pr "  %s = args.%s;\n" n n
6003              | FileIn _ | FileOut _ -> ()
6004            ) args;
6005            pr "\n"
6006       );
6007
6008
6009       (* this is used at least for do_equal *)
6010       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6011         (* Emit NEED_ROOT just once, even when there are two or
6012            more Pathname args *)
6013         pr "  NEED_ROOT (goto done);\n";
6014       );
6015
6016       (* Don't want to call the impl with any FileIn or FileOut
6017        * parameters, since these go "outside" the RPC protocol.
6018        *)
6019       let args' =
6020         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6021           (snd style) in
6022       pr "  r = do_%s " name;
6023       generate_c_call_args (fst style, args');
6024       pr ";\n";
6025
6026       (match fst style with
6027        | RErr | RInt _ | RInt64 _ | RBool _
6028        | RConstString _ | RConstOptString _
6029        | RString _ | RStringList _ | RHashtable _
6030        | RStruct (_, _) | RStructList (_, _) ->
6031            pr "  if (r == %s)\n" error_code;
6032            pr "    /* do_%s has already called reply_with_error */\n" name;
6033            pr "    goto done;\n";
6034            pr "\n"
6035        | RBufferOut _ ->
6036            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6037            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6038            pr "   */\n";
6039            pr "  if (size == 1 && r == %s)\n" error_code;
6040            pr "    /* do_%s has already called reply_with_error */\n" name;
6041            pr "    goto done;\n";
6042            pr "\n"
6043       );
6044
6045       (* If there are any FileOut parameters, then the impl must
6046        * send its own reply.
6047        *)
6048       let no_reply =
6049         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6050       if no_reply then
6051         pr "  /* do_%s has already sent a reply */\n" name
6052       else (
6053         match fst style with
6054         | RErr -> pr "  reply (NULL, NULL);\n"
6055         | RInt n | RInt64 n | RBool n ->
6056             pr "  struct guestfs_%s_ret ret;\n" name;
6057             pr "  ret.%s = r;\n" n;
6058             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6059               name
6060         | RConstString _ | RConstOptString _ ->
6061             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6062         | RString n ->
6063             pr "  struct guestfs_%s_ret ret;\n" name;
6064             pr "  ret.%s = r;\n" n;
6065             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6066               name;
6067             pr "  free (r);\n"
6068         | RStringList n | RHashtable n ->
6069             pr "  struct guestfs_%s_ret ret;\n" name;
6070             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6071             pr "  ret.%s.%s_val = r;\n" n n;
6072             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6073               name;
6074             pr "  free_strings (r);\n"
6075         | RStruct (n, _) ->
6076             pr "  struct guestfs_%s_ret ret;\n" name;
6077             pr "  ret.%s = *r;\n" n;
6078             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6079               name;
6080             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6081               name
6082         | RStructList (n, _) ->
6083             pr "  struct guestfs_%s_ret ret;\n" name;
6084             pr "  ret.%s = *r;\n" n;
6085             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6086               name;
6087             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6088               name
6089         | RBufferOut n ->
6090             pr "  struct guestfs_%s_ret ret;\n" name;
6091             pr "  ret.%s.%s_val = r;\n" n n;
6092             pr "  ret.%s.%s_len = size;\n" n n;
6093             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6094               name;
6095             pr "  free (r);\n"
6096       );
6097
6098       (* Free the args. *)
6099       (match snd style with
6100        | [] ->
6101            pr "done: ;\n";
6102        | _ ->
6103            pr "done:\n";
6104            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6105              name
6106       );
6107
6108       pr "}\n\n";
6109   ) daemon_functions;
6110
6111   (* Dispatch function. *)
6112   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6113   pr "{\n";
6114   pr "  switch (proc_nr) {\n";
6115
6116   List.iter (
6117     fun (name, style, _, _, _, _, _) ->
6118       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6119       pr "      %s_stub (xdr_in);\n" name;
6120       pr "      break;\n"
6121   ) daemon_functions;
6122
6123   pr "    default:\n";
6124   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";
6125   pr "  }\n";
6126   pr "}\n";
6127   pr "\n";
6128
6129   (* LVM columns and tokenization functions. *)
6130   (* XXX This generates crap code.  We should rethink how we
6131    * do this parsing.
6132    *)
6133   List.iter (
6134     function
6135     | typ, cols ->
6136         pr "static const char *lvm_%s_cols = \"%s\";\n"
6137           typ (String.concat "," (List.map fst cols));
6138         pr "\n";
6139
6140         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6141         pr "{\n";
6142         pr "  char *tok, *p, *next;\n";
6143         pr "  int i, j;\n";
6144         pr "\n";
6145         (*
6146           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6147           pr "\n";
6148         *)
6149         pr "  if (!str) {\n";
6150         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6151         pr "    return -1;\n";
6152         pr "  }\n";
6153         pr "  if (!*str || c_isspace (*str)) {\n";
6154         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6155         pr "    return -1;\n";
6156         pr "  }\n";
6157         pr "  tok = str;\n";
6158         List.iter (
6159           fun (name, coltype) ->
6160             pr "  if (!tok) {\n";
6161             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6162             pr "    return -1;\n";
6163             pr "  }\n";
6164             pr "  p = strchrnul (tok, ',');\n";
6165             pr "  if (*p) next = p+1; else next = NULL;\n";
6166             pr "  *p = '\\0';\n";
6167             (match coltype with
6168              | FString ->
6169                  pr "  r->%s = strdup (tok);\n" name;
6170                  pr "  if (r->%s == NULL) {\n" name;
6171                  pr "    perror (\"strdup\");\n";
6172                  pr "    return -1;\n";
6173                  pr "  }\n"
6174              | FUUID ->
6175                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6176                  pr "    if (tok[j] == '\\0') {\n";
6177                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6178                  pr "      return -1;\n";
6179                  pr "    } else if (tok[j] != '-')\n";
6180                  pr "      r->%s[i++] = tok[j];\n" name;
6181                  pr "  }\n";
6182              | FBytes ->
6183                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6184                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6185                  pr "    return -1;\n";
6186                  pr "  }\n";
6187              | FInt64 ->
6188                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6189                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6190                  pr "    return -1;\n";
6191                  pr "  }\n";
6192              | FOptPercent ->
6193                  pr "  if (tok[0] == '\\0')\n";
6194                  pr "    r->%s = -1;\n" name;
6195                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6196                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6197                  pr "    return -1;\n";
6198                  pr "  }\n";
6199              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6200                  assert false (* can never be an LVM column *)
6201             );
6202             pr "  tok = next;\n";
6203         ) cols;
6204
6205         pr "  if (tok != NULL) {\n";
6206         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6207         pr "    return -1;\n";
6208         pr "  }\n";
6209         pr "  return 0;\n";
6210         pr "}\n";
6211         pr "\n";
6212
6213         pr "guestfs_int_lvm_%s_list *\n" typ;
6214         pr "parse_command_line_%ss (void)\n" typ;
6215         pr "{\n";
6216         pr "  char *out, *err;\n";
6217         pr "  char *p, *pend;\n";
6218         pr "  int r, i;\n";
6219         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6220         pr "  void *newp;\n";
6221         pr "\n";
6222         pr "  ret = malloc (sizeof *ret);\n";
6223         pr "  if (!ret) {\n";
6224         pr "    reply_with_perror (\"malloc\");\n";
6225         pr "    return NULL;\n";
6226         pr "  }\n";
6227         pr "\n";
6228         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6229         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6230         pr "\n";
6231         pr "  r = command (&out, &err,\n";
6232         pr "           \"lvm\", \"%ss\",\n" typ;
6233         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6234         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6235         pr "  if (r == -1) {\n";
6236         pr "    reply_with_error (\"%%s\", err);\n";
6237         pr "    free (out);\n";
6238         pr "    free (err);\n";
6239         pr "    free (ret);\n";
6240         pr "    return NULL;\n";
6241         pr "  }\n";
6242         pr "\n";
6243         pr "  free (err);\n";
6244         pr "\n";
6245         pr "  /* Tokenize each line of the output. */\n";
6246         pr "  p = out;\n";
6247         pr "  i = 0;\n";
6248         pr "  while (p) {\n";
6249         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6250         pr "    if (pend) {\n";
6251         pr "      *pend = '\\0';\n";
6252         pr "      pend++;\n";
6253         pr "    }\n";
6254         pr "\n";
6255         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6256         pr "      p++;\n";
6257         pr "\n";
6258         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6259         pr "      p = pend;\n";
6260         pr "      continue;\n";
6261         pr "    }\n";
6262         pr "\n";
6263         pr "    /* Allocate some space to store this next entry. */\n";
6264         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6265         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6266         pr "    if (newp == NULL) {\n";
6267         pr "      reply_with_perror (\"realloc\");\n";
6268         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6269         pr "      free (ret);\n";
6270         pr "      free (out);\n";
6271         pr "      return NULL;\n";
6272         pr "    }\n";
6273         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6274         pr "\n";
6275         pr "    /* Tokenize the next entry. */\n";
6276         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6277         pr "    if (r == -1) {\n";
6278         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6279         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6280         pr "      free (ret);\n";
6281         pr "      free (out);\n";
6282         pr "      return NULL;\n";
6283         pr "    }\n";
6284         pr "\n";
6285         pr "    ++i;\n";
6286         pr "    p = pend;\n";
6287         pr "  }\n";
6288         pr "\n";
6289         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6290         pr "\n";
6291         pr "  free (out);\n";
6292         pr "  return ret;\n";
6293         pr "}\n"
6294
6295   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6296
6297 (* Generate a list of function names, for debugging in the daemon.. *)
6298 and generate_daemon_names () =
6299   generate_header CStyle GPLv2plus;
6300
6301   pr "#include <config.h>\n";
6302   pr "\n";
6303   pr "#include \"daemon.h\"\n";
6304   pr "\n";
6305
6306   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6307   pr "const char *function_names[] = {\n";
6308   List.iter (
6309     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6310   ) daemon_functions;
6311   pr "};\n";
6312
6313 (* Generate the optional groups for the daemon to implement
6314  * guestfs_available.
6315  *)
6316 and generate_daemon_optgroups_c () =
6317   generate_header CStyle GPLv2plus;
6318
6319   pr "#include <config.h>\n";
6320   pr "\n";
6321   pr "#include \"daemon.h\"\n";
6322   pr "#include \"optgroups.h\"\n";
6323   pr "\n";
6324
6325   pr "struct optgroup optgroups[] = {\n";
6326   List.iter (
6327     fun (group, _) ->
6328       pr "  { \"%s\", optgroup_%s_available },\n" group group
6329   ) optgroups;
6330   pr "  { NULL, NULL }\n";
6331   pr "};\n"
6332
6333 and generate_daemon_optgroups_h () =
6334   generate_header CStyle GPLv2plus;
6335
6336   List.iter (
6337     fun (group, _) ->
6338       pr "extern int optgroup_%s_available (void);\n" group
6339   ) optgroups
6340
6341 (* Generate the tests. *)
6342 and generate_tests () =
6343   generate_header CStyle GPLv2plus;
6344
6345   pr "\
6346 #include <stdio.h>
6347 #include <stdlib.h>
6348 #include <string.h>
6349 #include <unistd.h>
6350 #include <sys/types.h>
6351 #include <fcntl.h>
6352
6353 #include \"guestfs.h\"
6354 #include \"guestfs-internal.h\"
6355
6356 static guestfs_h *g;
6357 static int suppress_error = 0;
6358
6359 static void print_error (guestfs_h *g, void *data, const char *msg)
6360 {
6361   if (!suppress_error)
6362     fprintf (stderr, \"%%s\\n\", msg);
6363 }
6364
6365 /* FIXME: nearly identical code appears in fish.c */
6366 static void print_strings (char *const *argv)
6367 {
6368   int argc;
6369
6370   for (argc = 0; argv[argc] != NULL; ++argc)
6371     printf (\"\\t%%s\\n\", argv[argc]);
6372 }
6373
6374 /*
6375 static void print_table (char const *const *argv)
6376 {
6377   int i;
6378
6379   for (i = 0; argv[i] != NULL; i += 2)
6380     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6381 }
6382 */
6383
6384 ";
6385
6386   (* Generate a list of commands which are not tested anywhere. *)
6387   pr "static void no_test_warnings (void)\n";
6388   pr "{\n";
6389
6390   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6391   List.iter (
6392     fun (_, _, _, _, tests, _, _) ->
6393       let tests = filter_map (
6394         function
6395         | (_, (Always|If _|Unless _), test) -> Some test
6396         | (_, Disabled, _) -> None
6397       ) tests in
6398       let seq = List.concat (List.map seq_of_test tests) in
6399       let cmds_tested = List.map List.hd seq in
6400       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6401   ) all_functions;
6402
6403   List.iter (
6404     fun (name, _, _, _, _, _, _) ->
6405       if not (Hashtbl.mem hash name) then
6406         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6407   ) all_functions;
6408
6409   pr "}\n";
6410   pr "\n";
6411
6412   (* Generate the actual tests.  Note that we generate the tests
6413    * in reverse order, deliberately, so that (in general) the
6414    * newest tests run first.  This makes it quicker and easier to
6415    * debug them.
6416    *)
6417   let test_names =
6418     List.map (
6419       fun (name, _, _, flags, tests, _, _) ->
6420         mapi (generate_one_test name flags) tests
6421     ) (List.rev all_functions) in
6422   let test_names = List.concat test_names in
6423   let nr_tests = List.length test_names in
6424
6425   pr "\
6426 int main (int argc, char *argv[])
6427 {
6428   char c = 0;
6429   unsigned long int n_failed = 0;
6430   const char *filename;
6431   int fd;
6432   int nr_tests, test_num = 0;
6433
6434   setbuf (stdout, NULL);
6435
6436   no_test_warnings ();
6437
6438   g = guestfs_create ();
6439   if (g == NULL) {
6440     printf (\"guestfs_create FAILED\\n\");
6441     exit (EXIT_FAILURE);
6442   }
6443
6444   guestfs_set_error_handler (g, print_error, NULL);
6445
6446   guestfs_set_path (g, \"../appliance\");
6447
6448   filename = \"test1.img\";
6449   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6450   if (fd == -1) {
6451     perror (filename);
6452     exit (EXIT_FAILURE);
6453   }
6454   if (lseek (fd, %d, SEEK_SET) == -1) {
6455     perror (\"lseek\");
6456     close (fd);
6457     unlink (filename);
6458     exit (EXIT_FAILURE);
6459   }
6460   if (write (fd, &c, 1) == -1) {
6461     perror (\"write\");
6462     close (fd);
6463     unlink (filename);
6464     exit (EXIT_FAILURE);
6465   }
6466   if (close (fd) == -1) {
6467     perror (filename);
6468     unlink (filename);
6469     exit (EXIT_FAILURE);
6470   }
6471   if (guestfs_add_drive (g, filename) == -1) {
6472     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6473     exit (EXIT_FAILURE);
6474   }
6475
6476   filename = \"test2.img\";
6477   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6478   if (fd == -1) {
6479     perror (filename);
6480     exit (EXIT_FAILURE);
6481   }
6482   if (lseek (fd, %d, SEEK_SET) == -1) {
6483     perror (\"lseek\");
6484     close (fd);
6485     unlink (filename);
6486     exit (EXIT_FAILURE);
6487   }
6488   if (write (fd, &c, 1) == -1) {
6489     perror (\"write\");
6490     close (fd);
6491     unlink (filename);
6492     exit (EXIT_FAILURE);
6493   }
6494   if (close (fd) == -1) {
6495     perror (filename);
6496     unlink (filename);
6497     exit (EXIT_FAILURE);
6498   }
6499   if (guestfs_add_drive (g, filename) == -1) {
6500     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6501     exit (EXIT_FAILURE);
6502   }
6503
6504   filename = \"test3.img\";
6505   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6506   if (fd == -1) {
6507     perror (filename);
6508     exit (EXIT_FAILURE);
6509   }
6510   if (lseek (fd, %d, SEEK_SET) == -1) {
6511     perror (\"lseek\");
6512     close (fd);
6513     unlink (filename);
6514     exit (EXIT_FAILURE);
6515   }
6516   if (write (fd, &c, 1) == -1) {
6517     perror (\"write\");
6518     close (fd);
6519     unlink (filename);
6520     exit (EXIT_FAILURE);
6521   }
6522   if (close (fd) == -1) {
6523     perror (filename);
6524     unlink (filename);
6525     exit (EXIT_FAILURE);
6526   }
6527   if (guestfs_add_drive (g, filename) == -1) {
6528     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6529     exit (EXIT_FAILURE);
6530   }
6531
6532   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6533     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6534     exit (EXIT_FAILURE);
6535   }
6536
6537   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6538   alarm (600);
6539
6540   if (guestfs_launch (g) == -1) {
6541     printf (\"guestfs_launch FAILED\\n\");
6542     exit (EXIT_FAILURE);
6543   }
6544
6545   /* Cancel previous alarm. */
6546   alarm (0);
6547
6548   nr_tests = %d;
6549
6550 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6551
6552   iteri (
6553     fun i test_name ->
6554       pr "  test_num++;\n";
6555       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6556       pr "  if (%s () == -1) {\n" test_name;
6557       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6558       pr "    n_failed++;\n";
6559       pr "  }\n";
6560   ) test_names;
6561   pr "\n";
6562
6563   pr "  guestfs_close (g);\n";
6564   pr "  unlink (\"test1.img\");\n";
6565   pr "  unlink (\"test2.img\");\n";
6566   pr "  unlink (\"test3.img\");\n";
6567   pr "\n";
6568
6569   pr "  if (n_failed > 0) {\n";
6570   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6571   pr "    exit (EXIT_FAILURE);\n";
6572   pr "  }\n";
6573   pr "\n";
6574
6575   pr "  exit (EXIT_SUCCESS);\n";
6576   pr "}\n"
6577
6578 and generate_one_test name flags i (init, prereq, test) =
6579   let test_name = sprintf "test_%s_%d" name i in
6580
6581   pr "\
6582 static int %s_skip (void)
6583 {
6584   const char *str;
6585
6586   str = getenv (\"TEST_ONLY\");
6587   if (str)
6588     return strstr (str, \"%s\") == NULL;
6589   str = getenv (\"SKIP_%s\");
6590   if (str && STREQ (str, \"1\")) return 1;
6591   str = getenv (\"SKIP_TEST_%s\");
6592   if (str && STREQ (str, \"1\")) return 1;
6593   return 0;
6594 }
6595
6596 " test_name name (String.uppercase test_name) (String.uppercase name);
6597
6598   (match prereq with
6599    | Disabled | Always -> ()
6600    | If code | Unless code ->
6601        pr "static int %s_prereq (void)\n" test_name;
6602        pr "{\n";
6603        pr "  %s\n" code;
6604        pr "}\n";
6605        pr "\n";
6606   );
6607
6608   pr "\
6609 static int %s (void)
6610 {
6611   if (%s_skip ()) {
6612     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6613     return 0;
6614   }
6615
6616 " test_name test_name test_name;
6617
6618   (* Optional functions should only be tested if the relevant
6619    * support is available in the daemon.
6620    *)
6621   List.iter (
6622     function
6623     | Optional group ->
6624         pr "  {\n";
6625         pr "    const char *groups[] = { \"%s\", NULL };\n" group;
6626         pr "    int r;\n";
6627         pr "    suppress_error = 1;\n";
6628         pr "    r = guestfs_available (g, (char **) groups);\n";
6629         pr "    suppress_error = 0;\n";
6630         pr "    if (r == -1) {\n";
6631         pr "      printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
6632         pr "      return 0;\n";
6633         pr "    }\n";
6634         pr "  }\n";
6635     | _ -> ()
6636   ) flags;
6637
6638   (match prereq with
6639    | Disabled ->
6640        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6641    | If _ ->
6642        pr "  if (! %s_prereq ()) {\n" test_name;
6643        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6644        pr "    return 0;\n";
6645        pr "  }\n";
6646        pr "\n";
6647        generate_one_test_body name i test_name init test;
6648    | Unless _ ->
6649        pr "  if (%s_prereq ()) {\n" test_name;
6650        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6651        pr "    return 0;\n";
6652        pr "  }\n";
6653        pr "\n";
6654        generate_one_test_body name i test_name init test;
6655    | Always ->
6656        generate_one_test_body name i test_name init test
6657   );
6658
6659   pr "  return 0;\n";
6660   pr "}\n";
6661   pr "\n";
6662   test_name
6663
6664 and generate_one_test_body name i test_name init test =
6665   (match init with
6666    | InitNone (* XXX at some point, InitNone and InitEmpty became
6667                * folded together as the same thing.  Really we should
6668                * make InitNone do nothing at all, but the tests may
6669                * need to be checked to make sure this is OK.
6670                *)
6671    | InitEmpty ->
6672        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6673        List.iter (generate_test_command_call test_name)
6674          [["blockdev_setrw"; "/dev/sda"];
6675           ["umount_all"];
6676           ["lvm_remove_all"]]
6677    | InitPartition ->
6678        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6679        List.iter (generate_test_command_call test_name)
6680          [["blockdev_setrw"; "/dev/sda"];
6681           ["umount_all"];
6682           ["lvm_remove_all"];
6683           ["part_disk"; "/dev/sda"; "mbr"]]
6684    | InitBasicFS ->
6685        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6686        List.iter (generate_test_command_call test_name)
6687          [["blockdev_setrw"; "/dev/sda"];
6688           ["umount_all"];
6689           ["lvm_remove_all"];
6690           ["part_disk"; "/dev/sda"; "mbr"];
6691           ["mkfs"; "ext2"; "/dev/sda1"];
6692           ["mount_options"; ""; "/dev/sda1"; "/"]]
6693    | InitBasicFSonLVM ->
6694        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6695          test_name;
6696        List.iter (generate_test_command_call test_name)
6697          [["blockdev_setrw"; "/dev/sda"];
6698           ["umount_all"];
6699           ["lvm_remove_all"];
6700           ["part_disk"; "/dev/sda"; "mbr"];
6701           ["pvcreate"; "/dev/sda1"];
6702           ["vgcreate"; "VG"; "/dev/sda1"];
6703           ["lvcreate"; "LV"; "VG"; "8"];
6704           ["mkfs"; "ext2"; "/dev/VG/LV"];
6705           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6706    | InitISOFS ->
6707        pr "  /* InitISOFS for %s */\n" test_name;
6708        List.iter (generate_test_command_call test_name)
6709          [["blockdev_setrw"; "/dev/sda"];
6710           ["umount_all"];
6711           ["lvm_remove_all"];
6712           ["mount_ro"; "/dev/sdd"; "/"]]
6713   );
6714
6715   let get_seq_last = function
6716     | [] ->
6717         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6718           test_name
6719     | seq ->
6720         let seq = List.rev seq in
6721         List.rev (List.tl seq), List.hd seq
6722   in
6723
6724   match test with
6725   | TestRun seq ->
6726       pr "  /* TestRun for %s (%d) */\n" name i;
6727       List.iter (generate_test_command_call test_name) seq
6728   | TestOutput (seq, expected) ->
6729       pr "  /* TestOutput for %s (%d) */\n" name i;
6730       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6731       let seq, last = get_seq_last seq in
6732       let test () =
6733         pr "    if (STRNEQ (r, expected)) {\n";
6734         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6735         pr "      return -1;\n";
6736         pr "    }\n"
6737       in
6738       List.iter (generate_test_command_call test_name) seq;
6739       generate_test_command_call ~test test_name last
6740   | TestOutputList (seq, expected) ->
6741       pr "  /* TestOutputList for %s (%d) */\n" name i;
6742       let seq, last = get_seq_last seq in
6743       let test () =
6744         iteri (
6745           fun i str ->
6746             pr "    if (!r[%d]) {\n" i;
6747             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6748             pr "      print_strings (r);\n";
6749             pr "      return -1;\n";
6750             pr "    }\n";
6751             pr "    {\n";
6752             pr "      const char *expected = \"%s\";\n" (c_quote str);
6753             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6754             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6755             pr "        return -1;\n";
6756             pr "      }\n";
6757             pr "    }\n"
6758         ) expected;
6759         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6760         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6761           test_name;
6762         pr "      print_strings (r);\n";
6763         pr "      return -1;\n";
6764         pr "    }\n"
6765       in
6766       List.iter (generate_test_command_call test_name) seq;
6767       generate_test_command_call ~test test_name last
6768   | TestOutputListOfDevices (seq, expected) ->
6769       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6770       let seq, last = get_seq_last seq in
6771       let test () =
6772         iteri (
6773           fun i str ->
6774             pr "    if (!r[%d]) {\n" i;
6775             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6776             pr "      print_strings (r);\n";
6777             pr "      return -1;\n";
6778             pr "    }\n";
6779             pr "    {\n";
6780             pr "      const char *expected = \"%s\";\n" (c_quote str);
6781             pr "      r[%d][5] = 's';\n" i;
6782             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6783             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6784             pr "        return -1;\n";
6785             pr "      }\n";
6786             pr "    }\n"
6787         ) expected;
6788         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6789         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6790           test_name;
6791         pr "      print_strings (r);\n";
6792         pr "      return -1;\n";
6793         pr "    }\n"
6794       in
6795       List.iter (generate_test_command_call test_name) seq;
6796       generate_test_command_call ~test test_name last
6797   | TestOutputInt (seq, expected) ->
6798       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6799       let seq, last = get_seq_last seq in
6800       let test () =
6801         pr "    if (r != %d) {\n" expected;
6802         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6803           test_name expected;
6804         pr "               (int) r);\n";
6805         pr "      return -1;\n";
6806         pr "    }\n"
6807       in
6808       List.iter (generate_test_command_call test_name) seq;
6809       generate_test_command_call ~test test_name last
6810   | TestOutputIntOp (seq, op, expected) ->
6811       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6812       let seq, last = get_seq_last seq in
6813       let test () =
6814         pr "    if (! (r %s %d)) {\n" op expected;
6815         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6816           test_name op expected;
6817         pr "               (int) r);\n";
6818         pr "      return -1;\n";
6819         pr "    }\n"
6820       in
6821       List.iter (generate_test_command_call test_name) seq;
6822       generate_test_command_call ~test test_name last
6823   | TestOutputTrue seq ->
6824       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6825       let seq, last = get_seq_last seq in
6826       let test () =
6827         pr "    if (!r) {\n";
6828         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6829           test_name;
6830         pr "      return -1;\n";
6831         pr "    }\n"
6832       in
6833       List.iter (generate_test_command_call test_name) seq;
6834       generate_test_command_call ~test test_name last
6835   | TestOutputFalse seq ->
6836       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6837       let seq, last = get_seq_last seq in
6838       let test () =
6839         pr "    if (r) {\n";
6840         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6841           test_name;
6842         pr "      return -1;\n";
6843         pr "    }\n"
6844       in
6845       List.iter (generate_test_command_call test_name) seq;
6846       generate_test_command_call ~test test_name last
6847   | TestOutputLength (seq, expected) ->
6848       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6849       let seq, last = get_seq_last seq in
6850       let test () =
6851         pr "    int j;\n";
6852         pr "    for (j = 0; j < %d; ++j)\n" expected;
6853         pr "      if (r[j] == NULL) {\n";
6854         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6855           test_name;
6856         pr "        print_strings (r);\n";
6857         pr "        return -1;\n";
6858         pr "      }\n";
6859         pr "    if (r[j] != NULL) {\n";
6860         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6861           test_name;
6862         pr "      print_strings (r);\n";
6863         pr "      return -1;\n";
6864         pr "    }\n"
6865       in
6866       List.iter (generate_test_command_call test_name) seq;
6867       generate_test_command_call ~test test_name last
6868   | TestOutputBuffer (seq, expected) ->
6869       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6870       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6871       let seq, last = get_seq_last seq in
6872       let len = String.length expected in
6873       let test () =
6874         pr "    if (size != %d) {\n" len;
6875         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6876         pr "      return -1;\n";
6877         pr "    }\n";
6878         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6879         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6880         pr "      return -1;\n";
6881         pr "    }\n"
6882       in
6883       List.iter (generate_test_command_call test_name) seq;
6884       generate_test_command_call ~test test_name last
6885   | TestOutputStruct (seq, checks) ->
6886       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6887       let seq, last = get_seq_last seq in
6888       let test () =
6889         List.iter (
6890           function
6891           | CompareWithInt (field, expected) ->
6892               pr "    if (r->%s != %d) {\n" field expected;
6893               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6894                 test_name field expected;
6895               pr "               (int) r->%s);\n" field;
6896               pr "      return -1;\n";
6897               pr "    }\n"
6898           | CompareWithIntOp (field, op, expected) ->
6899               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6900               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
6901                 test_name field op expected;
6902               pr "               (int) r->%s);\n" field;
6903               pr "      return -1;\n";
6904               pr "    }\n"
6905           | CompareWithString (field, expected) ->
6906               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
6907               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
6908                 test_name field expected;
6909               pr "               r->%s);\n" field;
6910               pr "      return -1;\n";
6911               pr "    }\n"
6912           | CompareFieldsIntEq (field1, field2) ->
6913               pr "    if (r->%s != r->%s) {\n" field1 field2;
6914               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
6915                 test_name field1 field2;
6916               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
6917               pr "      return -1;\n";
6918               pr "    }\n"
6919           | CompareFieldsStrEq (field1, field2) ->
6920               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
6921               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
6922                 test_name field1 field2;
6923               pr "               r->%s, r->%s);\n" field1 field2;
6924               pr "      return -1;\n";
6925               pr "    }\n"
6926         ) checks
6927       in
6928       List.iter (generate_test_command_call test_name) seq;
6929       generate_test_command_call ~test test_name last
6930   | TestLastFail seq ->
6931       pr "  /* TestLastFail for %s (%d) */\n" name i;
6932       let seq, last = get_seq_last seq in
6933       List.iter (generate_test_command_call test_name) seq;
6934       generate_test_command_call test_name ~expect_error:true last
6935
6936 (* Generate the code to run a command, leaving the result in 'r'.
6937  * If you expect to get an error then you should set expect_error:true.
6938  *)
6939 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
6940   match cmd with
6941   | [] -> assert false
6942   | name :: args ->
6943       (* Look up the command to find out what args/ret it has. *)
6944       let style =
6945         try
6946           let _, style, _, _, _, _, _ =
6947             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
6948           style
6949         with Not_found ->
6950           failwithf "%s: in test, command %s was not found" test_name name in
6951
6952       if List.length (snd style) <> List.length args then
6953         failwithf "%s: in test, wrong number of args given to %s"
6954           test_name name;
6955
6956       pr "  {\n";
6957
6958       List.iter (
6959         function
6960         | OptString n, "NULL" -> ()
6961         | Pathname n, arg
6962         | Device n, arg
6963         | Dev_or_Path n, arg
6964         | String n, arg
6965         | OptString n, arg ->
6966             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
6967         | Int _, _
6968         | Int64 _, _
6969         | Bool _, _
6970         | FileIn _, _ | FileOut _, _ -> ()
6971         | StringList n, "" | DeviceList n, "" ->
6972             pr "    const char *const %s[1] = { NULL };\n" n
6973         | StringList n, arg | DeviceList n, arg ->
6974             let strs = string_split " " arg in
6975             iteri (
6976               fun i str ->
6977                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
6978             ) strs;
6979             pr "    const char *const %s[] = {\n" n;
6980             iteri (
6981               fun i _ -> pr "      %s_%d,\n" n i
6982             ) strs;
6983             pr "      NULL\n";
6984             pr "    };\n";
6985       ) (List.combine (snd style) args);
6986
6987       let error_code =
6988         match fst style with
6989         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
6990         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
6991         | RConstString _ | RConstOptString _ ->
6992             pr "    const char *r;\n"; "NULL"
6993         | RString _ -> pr "    char *r;\n"; "NULL"
6994         | RStringList _ | RHashtable _ ->
6995             pr "    char **r;\n";
6996             pr "    int i;\n";
6997             "NULL"
6998         | RStruct (_, typ) ->
6999             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7000         | RStructList (_, typ) ->
7001             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7002         | RBufferOut _ ->
7003             pr "    char *r;\n";
7004             pr "    size_t size;\n";
7005             "NULL" in
7006
7007       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7008       pr "    r = guestfs_%s (g" name;
7009
7010       (* Generate the parameters. *)
7011       List.iter (
7012         function
7013         | OptString _, "NULL" -> pr ", NULL"
7014         | Pathname n, _
7015         | Device n, _ | Dev_or_Path n, _
7016         | String n, _
7017         | OptString n, _ ->
7018             pr ", %s" n
7019         | FileIn _, arg | FileOut _, arg ->
7020             pr ", \"%s\"" (c_quote arg)
7021         | StringList n, _ | DeviceList n, _ ->
7022             pr ", (char **) %s" n
7023         | Int _, arg ->
7024             let i =
7025               try int_of_string arg
7026               with Failure "int_of_string" ->
7027                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7028             pr ", %d" i
7029         | Int64 _, arg ->
7030             let i =
7031               try Int64.of_string arg
7032               with Failure "int_of_string" ->
7033                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7034             pr ", %Ld" i
7035         | Bool _, arg ->
7036             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7037       ) (List.combine (snd style) args);
7038
7039       (match fst style with
7040        | RBufferOut _ -> pr ", &size"
7041        | _ -> ()
7042       );
7043
7044       pr ");\n";
7045
7046       if not expect_error then
7047         pr "    if (r == %s)\n" error_code
7048       else
7049         pr "    if (r != %s)\n" error_code;
7050       pr "      return -1;\n";
7051
7052       (* Insert the test code. *)
7053       (match test with
7054        | None -> ()
7055        | Some f -> f ()
7056       );
7057
7058       (match fst style with
7059        | RErr | RInt _ | RInt64 _ | RBool _
7060        | RConstString _ | RConstOptString _ -> ()
7061        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7062        | RStringList _ | RHashtable _ ->
7063            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7064            pr "      free (r[i]);\n";
7065            pr "    free (r);\n"
7066        | RStruct (_, typ) ->
7067            pr "    guestfs_free_%s (r);\n" typ
7068        | RStructList (_, typ) ->
7069            pr "    guestfs_free_%s_list (r);\n" typ
7070       );
7071
7072       pr "  }\n"
7073
7074 and c_quote str =
7075   let str = replace_str str "\r" "\\r" in
7076   let str = replace_str str "\n" "\\n" in
7077   let str = replace_str str "\t" "\\t" in
7078   let str = replace_str str "\000" "\\0" in
7079   str
7080
7081 (* Generate a lot of different functions for guestfish. *)
7082 and generate_fish_cmds () =
7083   generate_header CStyle GPLv2plus;
7084
7085   let all_functions =
7086     List.filter (
7087       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7088     ) all_functions in
7089   let all_functions_sorted =
7090     List.filter (
7091       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7092     ) all_functions_sorted in
7093
7094   pr "#include <config.h>\n";
7095   pr "\n";
7096   pr "#include <stdio.h>\n";
7097   pr "#include <stdlib.h>\n";
7098   pr "#include <string.h>\n";
7099   pr "#include <inttypes.h>\n";
7100   pr "\n";
7101   pr "#include <guestfs.h>\n";
7102   pr "#include \"c-ctype.h\"\n";
7103   pr "#include \"full-write.h\"\n";
7104   pr "#include \"xstrtol.h\"\n";
7105   pr "#include \"fish.h\"\n";
7106   pr "\n";
7107
7108   (* list_commands function, which implements guestfish -h *)
7109   pr "void list_commands (void)\n";
7110   pr "{\n";
7111   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7112   pr "  list_builtin_commands ();\n";
7113   List.iter (
7114     fun (name, _, _, flags, _, shortdesc, _) ->
7115       let name = replace_char name '_' '-' in
7116       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7117         name shortdesc
7118   ) all_functions_sorted;
7119   pr "  printf (\"    %%s\\n\",";
7120   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7121   pr "}\n";
7122   pr "\n";
7123
7124   (* display_command function, which implements guestfish -h cmd *)
7125   pr "void display_command (const char *cmd)\n";
7126   pr "{\n";
7127   List.iter (
7128     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7129       let name2 = replace_char name '_' '-' in
7130       let alias =
7131         try find_map (function FishAlias n -> Some n | _ -> None) flags
7132         with Not_found -> name in
7133       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7134       let synopsis =
7135         match snd style with
7136         | [] -> name2
7137         | args ->
7138             sprintf "%s %s"
7139               name2 (String.concat " " (List.map name_of_argt args)) in
7140
7141       let warnings =
7142         if List.mem ProtocolLimitWarning flags then
7143           ("\n\n" ^ protocol_limit_warning)
7144         else "" in
7145
7146       (* For DangerWillRobinson commands, we should probably have
7147        * guestfish prompt before allowing you to use them (especially
7148        * in interactive mode). XXX
7149        *)
7150       let warnings =
7151         warnings ^
7152           if List.mem DangerWillRobinson flags then
7153             ("\n\n" ^ danger_will_robinson)
7154           else "" in
7155
7156       let warnings =
7157         warnings ^
7158           match deprecation_notice flags with
7159           | None -> ""
7160           | Some txt -> "\n\n" ^ txt in
7161
7162       let describe_alias =
7163         if name <> alias then
7164           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7165         else "" in
7166
7167       pr "  if (";
7168       pr "STRCASEEQ (cmd, \"%s\")" name;
7169       if name <> name2 then
7170         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7171       if name <> alias then
7172         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7173       pr ")\n";
7174       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7175         name2 shortdesc
7176         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7177          "=head1 DESCRIPTION\n\n" ^
7178          longdesc ^ warnings ^ describe_alias);
7179       pr "  else\n"
7180   ) all_functions;
7181   pr "    display_builtin_command (cmd);\n";
7182   pr "}\n";
7183   pr "\n";
7184
7185   let emit_print_list_function typ =
7186     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7187       typ typ typ;
7188     pr "{\n";
7189     pr "  unsigned int i;\n";
7190     pr "\n";
7191     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7192     pr "    printf (\"[%%d] = {\\n\", i);\n";
7193     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7194     pr "    printf (\"}\\n\");\n";
7195     pr "  }\n";
7196     pr "}\n";
7197     pr "\n";
7198   in
7199
7200   (* print_* functions *)
7201   List.iter (
7202     fun (typ, cols) ->
7203       let needs_i =
7204         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7205
7206       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7207       pr "{\n";
7208       if needs_i then (
7209         pr "  unsigned int i;\n";
7210         pr "\n"
7211       );
7212       List.iter (
7213         function
7214         | name, FString ->
7215             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7216         | name, FUUID ->
7217             pr "  printf (\"%%s%s: \", indent);\n" name;
7218             pr "  for (i = 0; i < 32; ++i)\n";
7219             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7220             pr "  printf (\"\\n\");\n"
7221         | name, FBuffer ->
7222             pr "  printf (\"%%s%s: \", indent);\n" name;
7223             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7224             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7225             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7226             pr "    else\n";
7227             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7228             pr "  printf (\"\\n\");\n"
7229         | name, (FUInt64|FBytes) ->
7230             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7231               name typ name
7232         | name, FInt64 ->
7233             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7234               name typ name
7235         | name, FUInt32 ->
7236             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7237               name typ name
7238         | name, FInt32 ->
7239             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7240               name typ name
7241         | name, FChar ->
7242             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7243               name typ name
7244         | name, FOptPercent ->
7245             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7246               typ name name typ name;
7247             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7248       ) cols;
7249       pr "}\n";
7250       pr "\n";
7251   ) structs;
7252
7253   (* Emit a print_TYPE_list function definition only if that function is used. *)
7254   List.iter (
7255     function
7256     | typ, (RStructListOnly | RStructAndList) ->
7257         (* generate the function for typ *)
7258         emit_print_list_function typ
7259     | typ, _ -> () (* empty *)
7260   ) (rstructs_used_by all_functions);
7261
7262   (* Emit a print_TYPE function definition only if that function is used. *)
7263   List.iter (
7264     function
7265     | typ, (RStructOnly | RStructAndList) ->
7266         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7267         pr "{\n";
7268         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7269         pr "}\n";
7270         pr "\n";
7271     | typ, _ -> () (* empty *)
7272   ) (rstructs_used_by all_functions);
7273
7274   (* run_<action> actions *)
7275   List.iter (
7276     fun (name, style, _, flags, _, _, _) ->
7277       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7278       pr "{\n";
7279       (match fst style with
7280        | RErr
7281        | RInt _
7282        | RBool _ -> pr "  int r;\n"
7283        | RInt64 _ -> pr "  int64_t r;\n"
7284        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7285        | RString _ -> pr "  char *r;\n"
7286        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7287        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7288        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7289        | RBufferOut _ ->
7290            pr "  char *r;\n";
7291            pr "  size_t size;\n";
7292       );
7293       List.iter (
7294         function
7295         | Device n
7296         | String n
7297         | OptString n
7298         | FileIn n
7299         | FileOut n -> pr "  const char *%s;\n" n
7300         | Pathname n
7301         | Dev_or_Path n -> pr "  char *%s;\n" n
7302         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7303         | Bool n -> pr "  int %s;\n" n
7304         | Int n -> pr "  int %s;\n" n
7305         | Int64 n -> pr "  int64_t %s;\n" n
7306       ) (snd style);
7307
7308       (* Check and convert parameters. *)
7309       let argc_expected = List.length (snd style) in
7310       pr "  if (argc != %d) {\n" argc_expected;
7311       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7312         argc_expected;
7313       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7314       pr "    return -1;\n";
7315       pr "  }\n";
7316
7317       let parse_integer fn fntyp rtyp range name i =
7318         pr "  {\n";
7319         pr "    strtol_error xerr;\n";
7320         pr "    %s r;\n" fntyp;
7321         pr "\n";
7322         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7323         pr "    if (xerr != LONGINT_OK) {\n";
7324         pr "      fprintf (stderr,\n";
7325         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7326         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7327         pr "      return -1;\n";
7328         pr "    }\n";
7329         (match range with
7330          | None -> ()
7331          | Some (min, max, comment) ->
7332              pr "    /* %s */\n" comment;
7333              pr "    if (r < %s || r > %s) {\n" min max;
7334              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7335                name;
7336              pr "      return -1;\n";
7337              pr "    }\n";
7338              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7339         );
7340         pr "    %s = r;\n" name;
7341         pr "  }\n";
7342       in
7343
7344       iteri (
7345         fun i ->
7346           function
7347           | Device name
7348           | String name ->
7349               pr "  %s = argv[%d];\n" name i
7350           | Pathname name
7351           | Dev_or_Path name ->
7352               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7353               pr "  if (%s == NULL) return -1;\n" name
7354           | OptString name ->
7355               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7356                 name i i
7357           | FileIn name ->
7358               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7359                 name i i
7360           | FileOut name ->
7361               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7362                 name i i
7363           | StringList name | DeviceList name ->
7364               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7365               pr "  if (%s == NULL) return -1;\n" name;
7366           | Bool name ->
7367               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7368           | Int name ->
7369               let range =
7370                 let min = "(-(2LL<<30))"
7371                 and max = "((2LL<<30)-1)"
7372                 and comment =
7373                   "The Int type in the generator is a signed 31 bit int." in
7374                 Some (min, max, comment) in
7375               parse_integer "xstrtoll" "long long" "int" range name i
7376           | Int64 name ->
7377               parse_integer "xstrtoll" "long long" "int64_t" None name i
7378       ) (snd style);
7379
7380       (* Call C API function. *)
7381       let fn =
7382         try find_map (function FishAction n -> Some n | _ -> None) flags
7383         with Not_found -> sprintf "guestfs_%s" name in
7384       pr "  r = %s " fn;
7385       generate_c_call_args ~handle:"g" style;
7386       pr ";\n";
7387
7388       List.iter (
7389         function
7390         | Device name | String name
7391         | OptString name | FileIn name | FileOut name | Bool name
7392         | Int name | Int64 name -> ()
7393         | Pathname name | Dev_or_Path name ->
7394             pr "  free (%s);\n" name
7395         | StringList name | DeviceList name ->
7396             pr "  free_strings (%s);\n" name
7397       ) (snd style);
7398
7399       (* Check return value for errors and display command results. *)
7400       (match fst style with
7401        | RErr -> pr "  return r;\n"
7402        | RInt _ ->
7403            pr "  if (r == -1) return -1;\n";
7404            pr "  printf (\"%%d\\n\", r);\n";
7405            pr "  return 0;\n"
7406        | RInt64 _ ->
7407            pr "  if (r == -1) return -1;\n";
7408            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7409            pr "  return 0;\n"
7410        | RBool _ ->
7411            pr "  if (r == -1) return -1;\n";
7412            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7413            pr "  return 0;\n"
7414        | RConstString _ ->
7415            pr "  if (r == NULL) return -1;\n";
7416            pr "  printf (\"%%s\\n\", r);\n";
7417            pr "  return 0;\n"
7418        | RConstOptString _ ->
7419            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7420            pr "  return 0;\n"
7421        | RString _ ->
7422            pr "  if (r == NULL) return -1;\n";
7423            pr "  printf (\"%%s\\n\", r);\n";
7424            pr "  free (r);\n";
7425            pr "  return 0;\n"
7426        | RStringList _ ->
7427            pr "  if (r == NULL) return -1;\n";
7428            pr "  print_strings (r);\n";
7429            pr "  free_strings (r);\n";
7430            pr "  return 0;\n"
7431        | RStruct (_, typ) ->
7432            pr "  if (r == NULL) return -1;\n";
7433            pr "  print_%s (r);\n" typ;
7434            pr "  guestfs_free_%s (r);\n" typ;
7435            pr "  return 0;\n"
7436        | RStructList (_, typ) ->
7437            pr "  if (r == NULL) return -1;\n";
7438            pr "  print_%s_list (r);\n" typ;
7439            pr "  guestfs_free_%s_list (r);\n" typ;
7440            pr "  return 0;\n"
7441        | RHashtable _ ->
7442            pr "  if (r == NULL) return -1;\n";
7443            pr "  print_table (r);\n";
7444            pr "  free_strings (r);\n";
7445            pr "  return 0;\n"
7446        | RBufferOut _ ->
7447            pr "  if (r == NULL) return -1;\n";
7448            pr "  if (full_write (1, r, size) != size) {\n";
7449            pr "    perror (\"write\");\n";
7450            pr "    free (r);\n";
7451            pr "    return -1;\n";
7452            pr "  }\n";
7453            pr "  free (r);\n";
7454            pr "  return 0;\n"
7455       );
7456       pr "}\n";
7457       pr "\n"
7458   ) all_functions;
7459
7460   (* run_action function *)
7461   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7462   pr "{\n";
7463   List.iter (
7464     fun (name, _, _, flags, _, _, _) ->
7465       let name2 = replace_char name '_' '-' in
7466       let alias =
7467         try find_map (function FishAlias n -> Some n | _ -> None) flags
7468         with Not_found -> name in
7469       pr "  if (";
7470       pr "STRCASEEQ (cmd, \"%s\")" name;
7471       if name <> name2 then
7472         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7473       if name <> alias then
7474         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7475       pr ")\n";
7476       pr "    return run_%s (cmd, argc, argv);\n" name;
7477       pr "  else\n";
7478   ) all_functions;
7479   pr "    {\n";
7480   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7481   pr "      if (command_num == 1)\n";
7482   pr "        extended_help_message ();\n";
7483   pr "      return -1;\n";
7484   pr "    }\n";
7485   pr "  return 0;\n";
7486   pr "}\n";
7487   pr "\n"
7488
7489 (* Readline completion for guestfish. *)
7490 and generate_fish_completion () =
7491   generate_header CStyle GPLv2plus;
7492
7493   let all_functions =
7494     List.filter (
7495       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7496     ) all_functions in
7497
7498   pr "\
7499 #include <config.h>
7500
7501 #include <stdio.h>
7502 #include <stdlib.h>
7503 #include <string.h>
7504
7505 #ifdef HAVE_LIBREADLINE
7506 #include <readline/readline.h>
7507 #endif
7508
7509 #include \"fish.h\"
7510
7511 #ifdef HAVE_LIBREADLINE
7512
7513 static const char *const commands[] = {
7514   BUILTIN_COMMANDS_FOR_COMPLETION,
7515 ";
7516
7517   (* Get the commands, including the aliases.  They don't need to be
7518    * sorted - the generator() function just does a dumb linear search.
7519    *)
7520   let commands =
7521     List.map (
7522       fun (name, _, _, flags, _, _, _) ->
7523         let name2 = replace_char name '_' '-' in
7524         let alias =
7525           try find_map (function FishAlias n -> Some n | _ -> None) flags
7526           with Not_found -> name in
7527
7528         if name <> alias then [name2; alias] else [name2]
7529     ) all_functions in
7530   let commands = List.flatten commands in
7531
7532   List.iter (pr "  \"%s\",\n") commands;
7533
7534   pr "  NULL
7535 };
7536
7537 static char *
7538 generator (const char *text, int state)
7539 {
7540   static int index, len;
7541   const char *name;
7542
7543   if (!state) {
7544     index = 0;
7545     len = strlen (text);
7546   }
7547
7548   rl_attempted_completion_over = 1;
7549
7550   while ((name = commands[index]) != NULL) {
7551     index++;
7552     if (STRCASEEQLEN (name, text, len))
7553       return strdup (name);
7554   }
7555
7556   return NULL;
7557 }
7558
7559 #endif /* HAVE_LIBREADLINE */
7560
7561 #ifdef HAVE_RL_COMPLETION_MATCHES
7562 #define RL_COMPLETION_MATCHES rl_completion_matches
7563 #else
7564 #ifdef HAVE_COMPLETION_MATCHES
7565 #define RL_COMPLETION_MATCHES completion_matches
7566 #endif
7567 #endif /* else just fail if we don't have either symbol */
7568
7569 char **
7570 do_completion (const char *text, int start, int end)
7571 {
7572   char **matches = NULL;
7573
7574 #ifdef HAVE_LIBREADLINE
7575   rl_completion_append_character = ' ';
7576
7577   if (start == 0)
7578     matches = RL_COMPLETION_MATCHES (text, generator);
7579   else if (complete_dest_paths)
7580     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7581 #endif
7582
7583   return matches;
7584 }
7585 ";
7586
7587 (* Generate the POD documentation for guestfish. *)
7588 and generate_fish_actions_pod () =
7589   let all_functions_sorted =
7590     List.filter (
7591       fun (_, _, _, flags, _, _, _) ->
7592         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7593     ) all_functions_sorted in
7594
7595   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7596
7597   List.iter (
7598     fun (name, style, _, flags, _, _, longdesc) ->
7599       let longdesc =
7600         Str.global_substitute rex (
7601           fun s ->
7602             let sub =
7603               try Str.matched_group 1 s
7604               with Not_found ->
7605                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7606             "C<" ^ replace_char sub '_' '-' ^ ">"
7607         ) longdesc in
7608       let name = replace_char name '_' '-' in
7609       let alias =
7610         try find_map (function FishAlias n -> Some n | _ -> None) flags
7611         with Not_found -> name in
7612
7613       pr "=head2 %s" name;
7614       if name <> alias then
7615         pr " | %s" alias;
7616       pr "\n";
7617       pr "\n";
7618       pr " %s" name;
7619       List.iter (
7620         function
7621         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7622         | OptString n -> pr " %s" n
7623         | StringList n | DeviceList n -> pr " '%s ...'" n
7624         | Bool _ -> pr " true|false"
7625         | Int n -> pr " %s" n
7626         | Int64 n -> pr " %s" n
7627         | FileIn n | FileOut n -> pr " (%s|-)" n
7628       ) (snd style);
7629       pr "\n";
7630       pr "\n";
7631       pr "%s\n\n" longdesc;
7632
7633       if List.exists (function FileIn _ | FileOut _ -> true
7634                       | _ -> false) (snd style) then
7635         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7636
7637       if List.mem ProtocolLimitWarning flags then
7638         pr "%s\n\n" protocol_limit_warning;
7639
7640       if List.mem DangerWillRobinson flags then
7641         pr "%s\n\n" danger_will_robinson;
7642
7643       match deprecation_notice flags with
7644       | None -> ()
7645       | Some txt -> pr "%s\n\n" txt
7646   ) all_functions_sorted
7647
7648 (* Generate a C function prototype. *)
7649 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7650     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7651     ?(prefix = "")
7652     ?handle name style =
7653   if extern then pr "extern ";
7654   if static then pr "static ";
7655   (match fst style with
7656    | RErr -> pr "int "
7657    | RInt _ -> pr "int "
7658    | RInt64 _ -> pr "int64_t "
7659    | RBool _ -> pr "int "
7660    | RConstString _ | RConstOptString _ -> pr "const char *"
7661    | RString _ | RBufferOut _ -> pr "char *"
7662    | RStringList _ | RHashtable _ -> pr "char **"
7663    | RStruct (_, typ) ->
7664        if not in_daemon then pr "struct guestfs_%s *" typ
7665        else pr "guestfs_int_%s *" typ
7666    | RStructList (_, typ) ->
7667        if not in_daemon then pr "struct guestfs_%s_list *" typ
7668        else pr "guestfs_int_%s_list *" typ
7669   );
7670   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7671   pr "%s%s (" prefix name;
7672   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7673     pr "void"
7674   else (
7675     let comma = ref false in
7676     (match handle with
7677      | None -> ()
7678      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7679     );
7680     let next () =
7681       if !comma then (
7682         if single_line then pr ", " else pr ",\n\t\t"
7683       );
7684       comma := true
7685     in
7686     List.iter (
7687       function
7688       | Pathname n
7689       | Device n | Dev_or_Path n
7690       | String n
7691       | OptString n ->
7692           next ();
7693           pr "const char *%s" n
7694       | StringList n | DeviceList n ->
7695           next ();
7696           pr "char *const *%s" n
7697       | Bool n -> next (); pr "int %s" n
7698       | Int n -> next (); pr "int %s" n
7699       | Int64 n -> next (); pr "int64_t %s" n
7700       | FileIn n
7701       | FileOut n ->
7702           if not in_daemon then (next (); pr "const char *%s" n)
7703     ) (snd style);
7704     if is_RBufferOut then (next (); pr "size_t *size_r");
7705   );
7706   pr ")";
7707   if semicolon then pr ";";
7708   if newline then pr "\n"
7709
7710 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7711 and generate_c_call_args ?handle ?(decl = false) style =
7712   pr "(";
7713   let comma = ref false in
7714   let next () =
7715     if !comma then pr ", ";
7716     comma := true
7717   in
7718   (match handle with
7719    | None -> ()
7720    | Some handle -> pr "%s" handle; comma := true
7721   );
7722   List.iter (
7723     fun arg ->
7724       next ();
7725       pr "%s" (name_of_argt arg)
7726   ) (snd style);
7727   (* For RBufferOut calls, add implicit &size parameter. *)
7728   if not decl then (
7729     match fst style with
7730     | RBufferOut _ ->
7731         next ();
7732         pr "&size"
7733     | _ -> ()
7734   );
7735   pr ")"
7736
7737 (* Generate the OCaml bindings interface. *)
7738 and generate_ocaml_mli () =
7739   generate_header OCamlStyle LGPLv2plus;
7740
7741   pr "\
7742 (** For API documentation you should refer to the C API
7743     in the guestfs(3) manual page.  The OCaml API uses almost
7744     exactly the same calls. *)
7745
7746 type t
7747 (** A [guestfs_h] handle. *)
7748
7749 exception Error of string
7750 (** This exception is raised when there is an error. *)
7751
7752 exception Handle_closed of string
7753 (** This exception is raised if you use a {!Guestfs.t} handle
7754     after calling {!close} on it.  The string is the name of
7755     the function. *)
7756
7757 val create : unit -> t
7758 (** Create a {!Guestfs.t} handle. *)
7759
7760 val close : t -> unit
7761 (** Close the {!Guestfs.t} handle and free up all resources used
7762     by it immediately.
7763
7764     Handles are closed by the garbage collector when they become
7765     unreferenced, but callers can call this in order to provide
7766     predictable cleanup. *)
7767
7768 ";
7769   generate_ocaml_structure_decls ();
7770
7771   (* The actions. *)
7772   List.iter (
7773     fun (name, style, _, _, _, shortdesc, _) ->
7774       generate_ocaml_prototype name style;
7775       pr "(** %s *)\n" shortdesc;
7776       pr "\n"
7777   ) all_functions_sorted
7778
7779 (* Generate the OCaml bindings implementation. *)
7780 and generate_ocaml_ml () =
7781   generate_header OCamlStyle LGPLv2plus;
7782
7783   pr "\
7784 type t
7785
7786 exception Error of string
7787 exception Handle_closed of string
7788
7789 external create : unit -> t = \"ocaml_guestfs_create\"
7790 external close : t -> unit = \"ocaml_guestfs_close\"
7791
7792 (* Give the exceptions names, so they can be raised from the C code. *)
7793 let () =
7794   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7795   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7796
7797 ";
7798
7799   generate_ocaml_structure_decls ();
7800
7801   (* The actions. *)
7802   List.iter (
7803     fun (name, style, _, _, _, shortdesc, _) ->
7804       generate_ocaml_prototype ~is_external:true name style;
7805   ) all_functions_sorted
7806
7807 (* Generate the OCaml bindings C implementation. *)
7808 and generate_ocaml_c () =
7809   generate_header CStyle LGPLv2plus;
7810
7811   pr "\
7812 #include <stdio.h>
7813 #include <stdlib.h>
7814 #include <string.h>
7815
7816 #include <caml/config.h>
7817 #include <caml/alloc.h>
7818 #include <caml/callback.h>
7819 #include <caml/fail.h>
7820 #include <caml/memory.h>
7821 #include <caml/mlvalues.h>
7822 #include <caml/signals.h>
7823
7824 #include <guestfs.h>
7825
7826 #include \"guestfs_c.h\"
7827
7828 /* Copy a hashtable of string pairs into an assoc-list.  We return
7829  * the list in reverse order, but hashtables aren't supposed to be
7830  * ordered anyway.
7831  */
7832 static CAMLprim value
7833 copy_table (char * const * argv)
7834 {
7835   CAMLparam0 ();
7836   CAMLlocal5 (rv, pairv, kv, vv, cons);
7837   int i;
7838
7839   rv = Val_int (0);
7840   for (i = 0; argv[i] != NULL; i += 2) {
7841     kv = caml_copy_string (argv[i]);
7842     vv = caml_copy_string (argv[i+1]);
7843     pairv = caml_alloc (2, 0);
7844     Store_field (pairv, 0, kv);
7845     Store_field (pairv, 1, vv);
7846     cons = caml_alloc (2, 0);
7847     Store_field (cons, 1, rv);
7848     rv = cons;
7849     Store_field (cons, 0, pairv);
7850   }
7851
7852   CAMLreturn (rv);
7853 }
7854
7855 ";
7856
7857   (* Struct copy functions. *)
7858
7859   let emit_ocaml_copy_list_function typ =
7860     pr "static CAMLprim value\n";
7861     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7862     pr "{\n";
7863     pr "  CAMLparam0 ();\n";
7864     pr "  CAMLlocal2 (rv, v);\n";
7865     pr "  unsigned int i;\n";
7866     pr "\n";
7867     pr "  if (%ss->len == 0)\n" typ;
7868     pr "    CAMLreturn (Atom (0));\n";
7869     pr "  else {\n";
7870     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7871     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7872     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7873     pr "      caml_modify (&Field (rv, i), v);\n";
7874     pr "    }\n";
7875     pr "    CAMLreturn (rv);\n";
7876     pr "  }\n";
7877     pr "}\n";
7878     pr "\n";
7879   in
7880
7881   List.iter (
7882     fun (typ, cols) ->
7883       let has_optpercent_col =
7884         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7885
7886       pr "static CAMLprim value\n";
7887       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7888       pr "{\n";
7889       pr "  CAMLparam0 ();\n";
7890       if has_optpercent_col then
7891         pr "  CAMLlocal3 (rv, v, v2);\n"
7892       else
7893         pr "  CAMLlocal2 (rv, v);\n";
7894       pr "\n";
7895       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7896       iteri (
7897         fun i col ->
7898           (match col with
7899            | name, FString ->
7900                pr "  v = caml_copy_string (%s->%s);\n" typ name
7901            | name, FBuffer ->
7902                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
7903                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
7904                  typ name typ name
7905            | name, FUUID ->
7906                pr "  v = caml_alloc_string (32);\n";
7907                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
7908            | name, (FBytes|FInt64|FUInt64) ->
7909                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
7910            | name, (FInt32|FUInt32) ->
7911                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
7912            | name, FOptPercent ->
7913                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
7914                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
7915                pr "    v = caml_alloc (1, 0);\n";
7916                pr "    Store_field (v, 0, v2);\n";
7917                pr "  } else /* None */\n";
7918                pr "    v = Val_int (0);\n";
7919            | name, FChar ->
7920                pr "  v = Val_int (%s->%s);\n" typ name
7921           );
7922           pr "  Store_field (rv, %d, v);\n" i
7923       ) cols;
7924       pr "  CAMLreturn (rv);\n";
7925       pr "}\n";
7926       pr "\n";
7927   ) structs;
7928
7929   (* Emit a copy_TYPE_list function definition only if that function is used. *)
7930   List.iter (
7931     function
7932     | typ, (RStructListOnly | RStructAndList) ->
7933         (* generate the function for typ *)
7934         emit_ocaml_copy_list_function typ
7935     | typ, _ -> () (* empty *)
7936   ) (rstructs_used_by all_functions);
7937
7938   (* The wrappers. *)
7939   List.iter (
7940     fun (name, style, _, _, _, _, _) ->
7941       pr "/* Automatically generated wrapper for function\n";
7942       pr " * ";
7943       generate_ocaml_prototype name style;
7944       pr " */\n";
7945       pr "\n";
7946
7947       let params =
7948         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
7949
7950       let needs_extra_vs =
7951         match fst style with RConstOptString _ -> true | _ -> false in
7952
7953       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
7954       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
7955       List.iter (pr ", value %s") (List.tl params); pr ");\n";
7956       pr "\n";
7957
7958       pr "CAMLprim value\n";
7959       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
7960       List.iter (pr ", value %s") (List.tl params);
7961       pr ")\n";
7962       pr "{\n";
7963
7964       (match params with
7965        | [p1; p2; p3; p4; p5] ->
7966            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
7967        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
7968            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
7969            pr "  CAMLxparam%d (%s);\n"
7970              (List.length rest) (String.concat ", " rest)
7971        | ps ->
7972            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
7973       );
7974       if not needs_extra_vs then
7975         pr "  CAMLlocal1 (rv);\n"
7976       else
7977         pr "  CAMLlocal3 (rv, v, v2);\n";
7978       pr "\n";
7979
7980       pr "  guestfs_h *g = Guestfs_val (gv);\n";
7981       pr "  if (g == NULL)\n";
7982       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
7983       pr "\n";
7984
7985       List.iter (
7986         function
7987         | Pathname n
7988         | Device n | Dev_or_Path n
7989         | String n
7990         | FileIn n
7991         | FileOut n ->
7992             pr "  const char *%s = String_val (%sv);\n" n n
7993         | OptString n ->
7994             pr "  const char *%s =\n" n;
7995             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
7996               n n
7997         | StringList n | DeviceList n ->
7998             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
7999         | Bool n ->
8000             pr "  int %s = Bool_val (%sv);\n" n n
8001         | Int n ->
8002             pr "  int %s = Int_val (%sv);\n" n n
8003         | Int64 n ->
8004             pr "  int64_t %s = Int64_val (%sv);\n" n n
8005       ) (snd style);
8006       let error_code =
8007         match fst style with
8008         | RErr -> pr "  int r;\n"; "-1"
8009         | RInt _ -> pr "  int r;\n"; "-1"
8010         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8011         | RBool _ -> pr "  int r;\n"; "-1"
8012         | RConstString _ | RConstOptString _ ->
8013             pr "  const char *r;\n"; "NULL"
8014         | RString _ -> pr "  char *r;\n"; "NULL"
8015         | RStringList _ ->
8016             pr "  int i;\n";
8017             pr "  char **r;\n";
8018             "NULL"
8019         | RStruct (_, typ) ->
8020             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8021         | RStructList (_, typ) ->
8022             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8023         | RHashtable _ ->
8024             pr "  int i;\n";
8025             pr "  char **r;\n";
8026             "NULL"
8027         | RBufferOut _ ->
8028             pr "  char *r;\n";
8029             pr "  size_t size;\n";
8030             "NULL" in
8031       pr "\n";
8032
8033       pr "  caml_enter_blocking_section ();\n";
8034       pr "  r = guestfs_%s " name;
8035       generate_c_call_args ~handle:"g" style;
8036       pr ";\n";
8037       pr "  caml_leave_blocking_section ();\n";
8038
8039       List.iter (
8040         function
8041         | StringList n | DeviceList n ->
8042             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8043         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8044         | Bool _ | Int _ | Int64 _
8045         | FileIn _ | FileOut _ -> ()
8046       ) (snd style);
8047
8048       pr "  if (r == %s)\n" error_code;
8049       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8050       pr "\n";
8051
8052       (match fst style with
8053        | RErr -> pr "  rv = Val_unit;\n"
8054        | RInt _ -> pr "  rv = Val_int (r);\n"
8055        | RInt64 _ ->
8056            pr "  rv = caml_copy_int64 (r);\n"
8057        | RBool _ -> pr "  rv = Val_bool (r);\n"
8058        | RConstString _ ->
8059            pr "  rv = caml_copy_string (r);\n"
8060        | RConstOptString _ ->
8061            pr "  if (r) { /* Some string */\n";
8062            pr "    v = caml_alloc (1, 0);\n";
8063            pr "    v2 = caml_copy_string (r);\n";
8064            pr "    Store_field (v, 0, v2);\n";
8065            pr "  } else /* None */\n";
8066            pr "    v = Val_int (0);\n";
8067        | RString _ ->
8068            pr "  rv = caml_copy_string (r);\n";
8069            pr "  free (r);\n"
8070        | RStringList _ ->
8071            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8072            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8073            pr "  free (r);\n"
8074        | RStruct (_, typ) ->
8075            pr "  rv = copy_%s (r);\n" typ;
8076            pr "  guestfs_free_%s (r);\n" typ;
8077        | RStructList (_, typ) ->
8078            pr "  rv = copy_%s_list (r);\n" typ;
8079            pr "  guestfs_free_%s_list (r);\n" typ;
8080        | RHashtable _ ->
8081            pr "  rv = copy_table (r);\n";
8082            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8083            pr "  free (r);\n";
8084        | RBufferOut _ ->
8085            pr "  rv = caml_alloc_string (size);\n";
8086            pr "  memcpy (String_val (rv), r, size);\n";
8087       );
8088
8089       pr "  CAMLreturn (rv);\n";
8090       pr "}\n";
8091       pr "\n";
8092
8093       if List.length params > 5 then (
8094         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8095         pr "CAMLprim value ";
8096         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8097         pr "CAMLprim value\n";
8098         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8099         pr "{\n";
8100         pr "  return ocaml_guestfs_%s (argv[0]" name;
8101         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8102         pr ");\n";
8103         pr "}\n";
8104         pr "\n"
8105       )
8106   ) all_functions_sorted
8107
8108 and generate_ocaml_structure_decls () =
8109   List.iter (
8110     fun (typ, cols) ->
8111       pr "type %s = {\n" typ;
8112       List.iter (
8113         function
8114         | name, FString -> pr "  %s : string;\n" name
8115         | name, FBuffer -> pr "  %s : string;\n" name
8116         | name, FUUID -> pr "  %s : string;\n" name
8117         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8118         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8119         | name, FChar -> pr "  %s : char;\n" name
8120         | name, FOptPercent -> pr "  %s : float option;\n" name
8121       ) cols;
8122       pr "}\n";
8123       pr "\n"
8124   ) structs
8125
8126 and generate_ocaml_prototype ?(is_external = false) name style =
8127   if is_external then pr "external " else pr "val ";
8128   pr "%s : t -> " name;
8129   List.iter (
8130     function
8131     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8132     | OptString _ -> pr "string option -> "
8133     | StringList _ | DeviceList _ -> pr "string array -> "
8134     | Bool _ -> pr "bool -> "
8135     | Int _ -> pr "int -> "
8136     | Int64 _ -> pr "int64 -> "
8137   ) (snd style);
8138   (match fst style with
8139    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8140    | RInt _ -> pr "int"
8141    | RInt64 _ -> pr "int64"
8142    | RBool _ -> pr "bool"
8143    | RConstString _ -> pr "string"
8144    | RConstOptString _ -> pr "string option"
8145    | RString _ | RBufferOut _ -> pr "string"
8146    | RStringList _ -> pr "string array"
8147    | RStruct (_, typ) -> pr "%s" typ
8148    | RStructList (_, typ) -> pr "%s array" typ
8149    | RHashtable _ -> pr "(string * string) list"
8150   );
8151   if is_external then (
8152     pr " = ";
8153     if List.length (snd style) + 1 > 5 then
8154       pr "\"ocaml_guestfs_%s_byte\" " name;
8155     pr "\"ocaml_guestfs_%s\"" name
8156   );
8157   pr "\n"
8158
8159 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8160 and generate_perl_xs () =
8161   generate_header CStyle LGPLv2plus;
8162
8163   pr "\
8164 #include \"EXTERN.h\"
8165 #include \"perl.h\"
8166 #include \"XSUB.h\"
8167
8168 #include <guestfs.h>
8169
8170 #ifndef PRId64
8171 #define PRId64 \"lld\"
8172 #endif
8173
8174 static SV *
8175 my_newSVll(long long val) {
8176 #ifdef USE_64_BIT_ALL
8177   return newSViv(val);
8178 #else
8179   char buf[100];
8180   int len;
8181   len = snprintf(buf, 100, \"%%\" PRId64, val);
8182   return newSVpv(buf, len);
8183 #endif
8184 }
8185
8186 #ifndef PRIu64
8187 #define PRIu64 \"llu\"
8188 #endif
8189
8190 static SV *
8191 my_newSVull(unsigned long long val) {
8192 #ifdef USE_64_BIT_ALL
8193   return newSVuv(val);
8194 #else
8195   char buf[100];
8196   int len;
8197   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8198   return newSVpv(buf, len);
8199 #endif
8200 }
8201
8202 /* http://www.perlmonks.org/?node_id=680842 */
8203 static char **
8204 XS_unpack_charPtrPtr (SV *arg) {
8205   char **ret;
8206   AV *av;
8207   I32 i;
8208
8209   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8210     croak (\"array reference expected\");
8211
8212   av = (AV *)SvRV (arg);
8213   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8214   if (!ret)
8215     croak (\"malloc failed\");
8216
8217   for (i = 0; i <= av_len (av); i++) {
8218     SV **elem = av_fetch (av, i, 0);
8219
8220     if (!elem || !*elem)
8221       croak (\"missing element in list\");
8222
8223     ret[i] = SvPV_nolen (*elem);
8224   }
8225
8226   ret[i] = NULL;
8227
8228   return ret;
8229 }
8230
8231 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8232
8233 PROTOTYPES: ENABLE
8234
8235 guestfs_h *
8236 _create ()
8237    CODE:
8238       RETVAL = guestfs_create ();
8239       if (!RETVAL)
8240         croak (\"could not create guestfs handle\");
8241       guestfs_set_error_handler (RETVAL, NULL, NULL);
8242  OUTPUT:
8243       RETVAL
8244
8245 void
8246 DESTROY (g)
8247       guestfs_h *g;
8248  PPCODE:
8249       guestfs_close (g);
8250
8251 ";
8252
8253   List.iter (
8254     fun (name, style, _, _, _, _, _) ->
8255       (match fst style with
8256        | RErr -> pr "void\n"
8257        | RInt _ -> pr "SV *\n"
8258        | RInt64 _ -> pr "SV *\n"
8259        | RBool _ -> pr "SV *\n"
8260        | RConstString _ -> pr "SV *\n"
8261        | RConstOptString _ -> pr "SV *\n"
8262        | RString _ -> pr "SV *\n"
8263        | RBufferOut _ -> pr "SV *\n"
8264        | RStringList _
8265        | RStruct _ | RStructList _
8266        | RHashtable _ ->
8267            pr "void\n" (* all lists returned implictly on the stack *)
8268       );
8269       (* Call and arguments. *)
8270       pr "%s " name;
8271       generate_c_call_args ~handle:"g" ~decl:true style;
8272       pr "\n";
8273       pr "      guestfs_h *g;\n";
8274       iteri (
8275         fun i ->
8276           function
8277           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8278               pr "      char *%s;\n" n
8279           | OptString n ->
8280               (* http://www.perlmonks.org/?node_id=554277
8281                * Note that the implicit handle argument means we have
8282                * to add 1 to the ST(x) operator.
8283                *)
8284               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8285           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8286           | Bool n -> pr "      int %s;\n" n
8287           | Int n -> pr "      int %s;\n" n
8288           | Int64 n -> pr "      int64_t %s;\n" n
8289       ) (snd style);
8290
8291       let do_cleanups () =
8292         List.iter (
8293           function
8294           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8295           | Bool _ | Int _ | Int64 _
8296           | FileIn _ | FileOut _ -> ()
8297           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8298         ) (snd style)
8299       in
8300
8301       (* Code. *)
8302       (match fst style with
8303        | RErr ->
8304            pr "PREINIT:\n";
8305            pr "      int r;\n";
8306            pr " PPCODE:\n";
8307            pr "      r = guestfs_%s " name;
8308            generate_c_call_args ~handle:"g" style;
8309            pr ";\n";
8310            do_cleanups ();
8311            pr "      if (r == -1)\n";
8312            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8313        | RInt n
8314        | RBool n ->
8315            pr "PREINIT:\n";
8316            pr "      int %s;\n" n;
8317            pr "   CODE:\n";
8318            pr "      %s = guestfs_%s " n name;
8319            generate_c_call_args ~handle:"g" style;
8320            pr ";\n";
8321            do_cleanups ();
8322            pr "      if (%s == -1)\n" n;
8323            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8324            pr "      RETVAL = newSViv (%s);\n" n;
8325            pr " OUTPUT:\n";
8326            pr "      RETVAL\n"
8327        | RInt64 n ->
8328            pr "PREINIT:\n";
8329            pr "      int64_t %s;\n" n;
8330            pr "   CODE:\n";
8331            pr "      %s = guestfs_%s " n name;
8332            generate_c_call_args ~handle:"g" style;
8333            pr ";\n";
8334            do_cleanups ();
8335            pr "      if (%s == -1)\n" n;
8336            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8337            pr "      RETVAL = my_newSVll (%s);\n" n;
8338            pr " OUTPUT:\n";
8339            pr "      RETVAL\n"
8340        | RConstString n ->
8341            pr "PREINIT:\n";
8342            pr "      const char *%s;\n" n;
8343            pr "   CODE:\n";
8344            pr "      %s = guestfs_%s " n name;
8345            generate_c_call_args ~handle:"g" style;
8346            pr ";\n";
8347            do_cleanups ();
8348            pr "      if (%s == NULL)\n" n;
8349            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8350            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8351            pr " OUTPUT:\n";
8352            pr "      RETVAL\n"
8353        | RConstOptString n ->
8354            pr "PREINIT:\n";
8355            pr "      const char *%s;\n" n;
8356            pr "   CODE:\n";
8357            pr "      %s = guestfs_%s " n name;
8358            generate_c_call_args ~handle:"g" style;
8359            pr ";\n";
8360            do_cleanups ();
8361            pr "      if (%s == NULL)\n" n;
8362            pr "        RETVAL = &PL_sv_undef;\n";
8363            pr "      else\n";
8364            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8365            pr " OUTPUT:\n";
8366            pr "      RETVAL\n"
8367        | RString n ->
8368            pr "PREINIT:\n";
8369            pr "      char *%s;\n" n;
8370            pr "   CODE:\n";
8371            pr "      %s = guestfs_%s " n name;
8372            generate_c_call_args ~handle:"g" style;
8373            pr ";\n";
8374            do_cleanups ();
8375            pr "      if (%s == NULL)\n" n;
8376            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8377            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8378            pr "      free (%s);\n" n;
8379            pr " OUTPUT:\n";
8380            pr "      RETVAL\n"
8381        | RStringList n | RHashtable n ->
8382            pr "PREINIT:\n";
8383            pr "      char **%s;\n" n;
8384            pr "      int i, n;\n";
8385            pr " PPCODE:\n";
8386            pr "      %s = guestfs_%s " n name;
8387            generate_c_call_args ~handle:"g" style;
8388            pr ";\n";
8389            do_cleanups ();
8390            pr "      if (%s == NULL)\n" n;
8391            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8392            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8393            pr "      EXTEND (SP, n);\n";
8394            pr "      for (i = 0; i < n; ++i) {\n";
8395            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8396            pr "        free (%s[i]);\n" n;
8397            pr "      }\n";
8398            pr "      free (%s);\n" n;
8399        | RStruct (n, typ) ->
8400            let cols = cols_of_struct typ in
8401            generate_perl_struct_code typ cols name style n do_cleanups
8402        | RStructList (n, typ) ->
8403            let cols = cols_of_struct typ in
8404            generate_perl_struct_list_code typ cols name style n do_cleanups
8405        | RBufferOut n ->
8406            pr "PREINIT:\n";
8407            pr "      char *%s;\n" n;
8408            pr "      size_t size;\n";
8409            pr "   CODE:\n";
8410            pr "      %s = guestfs_%s " n name;
8411            generate_c_call_args ~handle:"g" style;
8412            pr ";\n";
8413            do_cleanups ();
8414            pr "      if (%s == NULL)\n" n;
8415            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8416            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8417            pr "      free (%s);\n" n;
8418            pr " OUTPUT:\n";
8419            pr "      RETVAL\n"
8420       );
8421
8422       pr "\n"
8423   ) all_functions
8424
8425 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8426   pr "PREINIT:\n";
8427   pr "      struct guestfs_%s_list *%s;\n" typ n;
8428   pr "      int i;\n";
8429   pr "      HV *hv;\n";
8430   pr " PPCODE:\n";
8431   pr "      %s = guestfs_%s " n name;
8432   generate_c_call_args ~handle:"g" style;
8433   pr ";\n";
8434   do_cleanups ();
8435   pr "      if (%s == NULL)\n" n;
8436   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8437   pr "      EXTEND (SP, %s->len);\n" n;
8438   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8439   pr "        hv = newHV ();\n";
8440   List.iter (
8441     function
8442     | name, FString ->
8443         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8444           name (String.length name) n name
8445     | name, FUUID ->
8446         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8447           name (String.length name) n name
8448     | name, FBuffer ->
8449         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8450           name (String.length name) n name n name
8451     | name, (FBytes|FUInt64) ->
8452         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8453           name (String.length name) n name
8454     | name, FInt64 ->
8455         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8456           name (String.length name) n name
8457     | name, (FInt32|FUInt32) ->
8458         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8459           name (String.length name) n name
8460     | name, FChar ->
8461         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8462           name (String.length name) n name
8463     | name, FOptPercent ->
8464         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8465           name (String.length name) n name
8466   ) cols;
8467   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8468   pr "      }\n";
8469   pr "      guestfs_free_%s_list (%s);\n" typ n
8470
8471 and generate_perl_struct_code typ cols name style n do_cleanups =
8472   pr "PREINIT:\n";
8473   pr "      struct guestfs_%s *%s;\n" typ n;
8474   pr " PPCODE:\n";
8475   pr "      %s = guestfs_%s " n name;
8476   generate_c_call_args ~handle:"g" style;
8477   pr ";\n";
8478   do_cleanups ();
8479   pr "      if (%s == NULL)\n" n;
8480   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8481   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8482   List.iter (
8483     fun ((name, _) as col) ->
8484       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8485
8486       match col with
8487       | name, FString ->
8488           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8489             n name
8490       | name, FBuffer ->
8491           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8492             n name n name
8493       | name, FUUID ->
8494           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8495             n name
8496       | name, (FBytes|FUInt64) ->
8497           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8498             n name
8499       | name, FInt64 ->
8500           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8501             n name
8502       | name, (FInt32|FUInt32) ->
8503           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8504             n name
8505       | name, FChar ->
8506           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8507             n name
8508       | name, FOptPercent ->
8509           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8510             n name
8511   ) cols;
8512   pr "      free (%s);\n" n
8513
8514 (* Generate Sys/Guestfs.pm. *)
8515 and generate_perl_pm () =
8516   generate_header HashStyle LGPLv2plus;
8517
8518   pr "\
8519 =pod
8520
8521 =head1 NAME
8522
8523 Sys::Guestfs - Perl bindings for libguestfs
8524
8525 =head1 SYNOPSIS
8526
8527  use Sys::Guestfs;
8528
8529  my $h = Sys::Guestfs->new ();
8530  $h->add_drive ('guest.img');
8531  $h->launch ();
8532  $h->mount ('/dev/sda1', '/');
8533  $h->touch ('/hello');
8534  $h->sync ();
8535
8536 =head1 DESCRIPTION
8537
8538 The C<Sys::Guestfs> module provides a Perl XS binding to the
8539 libguestfs API for examining and modifying virtual machine
8540 disk images.
8541
8542 Amongst the things this is good for: making batch configuration
8543 changes to guests, getting disk used/free statistics (see also:
8544 virt-df), migrating between virtualization systems (see also:
8545 virt-p2v), performing partial backups, performing partial guest
8546 clones, cloning guests and changing registry/UUID/hostname info, and
8547 much else besides.
8548
8549 Libguestfs uses Linux kernel and qemu code, and can access any type of
8550 guest filesystem that Linux and qemu can, including but not limited
8551 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8552 schemes, qcow, qcow2, vmdk.
8553
8554 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8555 LVs, what filesystem is in each LV, etc.).  It can also run commands
8556 in the context of the guest.  Also you can access filesystems over
8557 FUSE.
8558
8559 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8560 functions for using libguestfs from Perl, including integration
8561 with libvirt.
8562
8563 =head1 ERRORS
8564
8565 All errors turn into calls to C<croak> (see L<Carp(3)>).
8566
8567 =head1 METHODS
8568
8569 =over 4
8570
8571 =cut
8572
8573 package Sys::Guestfs;
8574
8575 use strict;
8576 use warnings;
8577
8578 require XSLoader;
8579 XSLoader::load ('Sys::Guestfs');
8580
8581 =item $h = Sys::Guestfs->new ();
8582
8583 Create a new guestfs handle.
8584
8585 =cut
8586
8587 sub new {
8588   my $proto = shift;
8589   my $class = ref ($proto) || $proto;
8590
8591   my $self = Sys::Guestfs::_create ();
8592   bless $self, $class;
8593   return $self;
8594 }
8595
8596 ";
8597
8598   (* Actions.  We only need to print documentation for these as
8599    * they are pulled in from the XS code automatically.
8600    *)
8601   List.iter (
8602     fun (name, style, _, flags, _, _, longdesc) ->
8603       if not (List.mem NotInDocs flags) then (
8604         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8605         pr "=item ";
8606         generate_perl_prototype name style;
8607         pr "\n\n";
8608         pr "%s\n\n" longdesc;
8609         if List.mem ProtocolLimitWarning flags then
8610           pr "%s\n\n" protocol_limit_warning;
8611         if List.mem DangerWillRobinson flags then
8612           pr "%s\n\n" danger_will_robinson;
8613         match deprecation_notice flags with
8614         | None -> ()
8615         | Some txt -> pr "%s\n\n" txt
8616       )
8617   ) all_functions_sorted;
8618
8619   (* End of file. *)
8620   pr "\
8621 =cut
8622
8623 1;
8624
8625 =back
8626
8627 =head1 COPYRIGHT
8628
8629 Copyright (C) %s Red Hat Inc.
8630
8631 =head1 LICENSE
8632
8633 Please see the file COPYING.LIB for the full license.
8634
8635 =head1 SEE ALSO
8636
8637 L<guestfs(3)>,
8638 L<guestfish(1)>,
8639 L<http://libguestfs.org>,
8640 L<Sys::Guestfs::Lib(3)>.
8641
8642 =cut
8643 " copyright_years
8644
8645 and generate_perl_prototype name style =
8646   (match fst style with
8647    | RErr -> ()
8648    | RBool n
8649    | RInt n
8650    | RInt64 n
8651    | RConstString n
8652    | RConstOptString n
8653    | RString n
8654    | RBufferOut n -> pr "$%s = " n
8655    | RStruct (n,_)
8656    | RHashtable n -> pr "%%%s = " n
8657    | RStringList n
8658    | RStructList (n,_) -> pr "@%s = " n
8659   );
8660   pr "$h->%s (" name;
8661   let comma = ref false in
8662   List.iter (
8663     fun arg ->
8664       if !comma then pr ", ";
8665       comma := true;
8666       match arg with
8667       | Pathname n | Device n | Dev_or_Path n | String n
8668       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8669           pr "$%s" n
8670       | StringList n | DeviceList n ->
8671           pr "\\@%s" n
8672   ) (snd style);
8673   pr ");"
8674
8675 (* Generate Python C module. *)
8676 and generate_python_c () =
8677   generate_header CStyle LGPLv2plus;
8678
8679   pr "\
8680 #include <Python.h>
8681
8682 #include <stdio.h>
8683 #include <stdlib.h>
8684 #include <assert.h>
8685
8686 #include \"guestfs.h\"
8687
8688 typedef struct {
8689   PyObject_HEAD
8690   guestfs_h *g;
8691 } Pyguestfs_Object;
8692
8693 static guestfs_h *
8694 get_handle (PyObject *obj)
8695 {
8696   assert (obj);
8697   assert (obj != Py_None);
8698   return ((Pyguestfs_Object *) obj)->g;
8699 }
8700
8701 static PyObject *
8702 put_handle (guestfs_h *g)
8703 {
8704   assert (g);
8705   return
8706     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8707 }
8708
8709 /* This list should be freed (but not the strings) after use. */
8710 static char **
8711 get_string_list (PyObject *obj)
8712 {
8713   int i, len;
8714   char **r;
8715
8716   assert (obj);
8717
8718   if (!PyList_Check (obj)) {
8719     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8720     return NULL;
8721   }
8722
8723   len = PyList_Size (obj);
8724   r = malloc (sizeof (char *) * (len+1));
8725   if (r == NULL) {
8726     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8727     return NULL;
8728   }
8729
8730   for (i = 0; i < len; ++i)
8731     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8732   r[len] = NULL;
8733
8734   return r;
8735 }
8736
8737 static PyObject *
8738 put_string_list (char * const * const argv)
8739 {
8740   PyObject *list;
8741   int argc, i;
8742
8743   for (argc = 0; argv[argc] != NULL; ++argc)
8744     ;
8745
8746   list = PyList_New (argc);
8747   for (i = 0; i < argc; ++i)
8748     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8749
8750   return list;
8751 }
8752
8753 static PyObject *
8754 put_table (char * const * const argv)
8755 {
8756   PyObject *list, *item;
8757   int argc, i;
8758
8759   for (argc = 0; argv[argc] != NULL; ++argc)
8760     ;
8761
8762   list = PyList_New (argc >> 1);
8763   for (i = 0; i < argc; i += 2) {
8764     item = PyTuple_New (2);
8765     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8766     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8767     PyList_SetItem (list, i >> 1, item);
8768   }
8769
8770   return list;
8771 }
8772
8773 static void
8774 free_strings (char **argv)
8775 {
8776   int argc;
8777
8778   for (argc = 0; argv[argc] != NULL; ++argc)
8779     free (argv[argc]);
8780   free (argv);
8781 }
8782
8783 static PyObject *
8784 py_guestfs_create (PyObject *self, PyObject *args)
8785 {
8786   guestfs_h *g;
8787
8788   g = guestfs_create ();
8789   if (g == NULL) {
8790     PyErr_SetString (PyExc_RuntimeError,
8791                      \"guestfs.create: failed to allocate handle\");
8792     return NULL;
8793   }
8794   guestfs_set_error_handler (g, NULL, NULL);
8795   return put_handle (g);
8796 }
8797
8798 static PyObject *
8799 py_guestfs_close (PyObject *self, PyObject *args)
8800 {
8801   PyObject *py_g;
8802   guestfs_h *g;
8803
8804   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8805     return NULL;
8806   g = get_handle (py_g);
8807
8808   guestfs_close (g);
8809
8810   Py_INCREF (Py_None);
8811   return Py_None;
8812 }
8813
8814 ";
8815
8816   let emit_put_list_function typ =
8817     pr "static PyObject *\n";
8818     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8819     pr "{\n";
8820     pr "  PyObject *list;\n";
8821     pr "  int i;\n";
8822     pr "\n";
8823     pr "  list = PyList_New (%ss->len);\n" typ;
8824     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8825     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8826     pr "  return list;\n";
8827     pr "};\n";
8828     pr "\n"
8829   in
8830
8831   (* Structures, turned into Python dictionaries. *)
8832   List.iter (
8833     fun (typ, cols) ->
8834       pr "static PyObject *\n";
8835       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8836       pr "{\n";
8837       pr "  PyObject *dict;\n";
8838       pr "\n";
8839       pr "  dict = PyDict_New ();\n";
8840       List.iter (
8841         function
8842         | name, FString ->
8843             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8844             pr "                        PyString_FromString (%s->%s));\n"
8845               typ name
8846         | name, FBuffer ->
8847             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8848             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8849               typ name typ name
8850         | name, FUUID ->
8851             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8852             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8853               typ name
8854         | name, (FBytes|FUInt64) ->
8855             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8856             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8857               typ name
8858         | name, FInt64 ->
8859             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8860             pr "                        PyLong_FromLongLong (%s->%s));\n"
8861               typ name
8862         | name, FUInt32 ->
8863             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8864             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8865               typ name
8866         | name, FInt32 ->
8867             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8868             pr "                        PyLong_FromLong (%s->%s));\n"
8869               typ name
8870         | name, FOptPercent ->
8871             pr "  if (%s->%s >= 0)\n" typ name;
8872             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8873             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8874               typ name;
8875             pr "  else {\n";
8876             pr "    Py_INCREF (Py_None);\n";
8877             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8878             pr "  }\n"
8879         | name, FChar ->
8880             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8881             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8882       ) cols;
8883       pr "  return dict;\n";
8884       pr "};\n";
8885       pr "\n";
8886
8887   ) structs;
8888
8889   (* Emit a put_TYPE_list function definition only if that function is used. *)
8890   List.iter (
8891     function
8892     | typ, (RStructListOnly | RStructAndList) ->
8893         (* generate the function for typ *)
8894         emit_put_list_function typ
8895     | typ, _ -> () (* empty *)
8896   ) (rstructs_used_by all_functions);
8897
8898   (* Python wrapper functions. *)
8899   List.iter (
8900     fun (name, style, _, _, _, _, _) ->
8901       pr "static PyObject *\n";
8902       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
8903       pr "{\n";
8904
8905       pr "  PyObject *py_g;\n";
8906       pr "  guestfs_h *g;\n";
8907       pr "  PyObject *py_r;\n";
8908
8909       let error_code =
8910         match fst style with
8911         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
8912         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8913         | RConstString _ | RConstOptString _ ->
8914             pr "  const char *r;\n"; "NULL"
8915         | RString _ -> pr "  char *r;\n"; "NULL"
8916         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
8917         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
8918         | RStructList (_, typ) ->
8919             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8920         | RBufferOut _ ->
8921             pr "  char *r;\n";
8922             pr "  size_t size;\n";
8923             "NULL" in
8924
8925       List.iter (
8926         function
8927         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8928             pr "  const char *%s;\n" n
8929         | OptString n -> pr "  const char *%s;\n" n
8930         | StringList n | DeviceList n ->
8931             pr "  PyObject *py_%s;\n" n;
8932             pr "  char **%s;\n" n
8933         | Bool n -> pr "  int %s;\n" n
8934         | Int n -> pr "  int %s;\n" n
8935         | Int64 n -> pr "  long long %s;\n" n
8936       ) (snd style);
8937
8938       pr "\n";
8939
8940       (* Convert the parameters. *)
8941       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
8942       List.iter (
8943         function
8944         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
8945         | OptString _ -> pr "z"
8946         | StringList _ | DeviceList _ -> pr "O"
8947         | Bool _ -> pr "i" (* XXX Python has booleans? *)
8948         | Int _ -> pr "i"
8949         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
8950                              * emulate C's int/long/long long in Python?
8951                              *)
8952       ) (snd style);
8953       pr ":guestfs_%s\",\n" name;
8954       pr "                         &py_g";
8955       List.iter (
8956         function
8957         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
8958         | OptString n -> pr ", &%s" n
8959         | StringList n | DeviceList n -> pr ", &py_%s" n
8960         | Bool n -> pr ", &%s" n
8961         | Int n -> pr ", &%s" n
8962         | Int64 n -> pr ", &%s" n
8963       ) (snd style);
8964
8965       pr "))\n";
8966       pr "    return NULL;\n";
8967
8968       pr "  g = get_handle (py_g);\n";
8969       List.iter (
8970         function
8971         | Pathname _ | Device _ | Dev_or_Path _ | String _
8972         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
8973         | StringList n | DeviceList n ->
8974             pr "  %s = get_string_list (py_%s);\n" n n;
8975             pr "  if (!%s) return NULL;\n" n
8976       ) (snd style);
8977
8978       pr "\n";
8979
8980       pr "  r = guestfs_%s " name;
8981       generate_c_call_args ~handle:"g" style;
8982       pr ";\n";
8983
8984       List.iter (
8985         function
8986         | Pathname _ | Device _ | Dev_or_Path _ | String _
8987         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
8988         | StringList n | DeviceList n ->
8989             pr "  free (%s);\n" n
8990       ) (snd style);
8991
8992       pr "  if (r == %s) {\n" error_code;
8993       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
8994       pr "    return NULL;\n";
8995       pr "  }\n";
8996       pr "\n";
8997
8998       (match fst style with
8999        | RErr ->
9000            pr "  Py_INCREF (Py_None);\n";
9001            pr "  py_r = Py_None;\n"
9002        | RInt _
9003        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9004        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9005        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9006        | RConstOptString _ ->
9007            pr "  if (r)\n";
9008            pr "    py_r = PyString_FromString (r);\n";
9009            pr "  else {\n";
9010            pr "    Py_INCREF (Py_None);\n";
9011            pr "    py_r = Py_None;\n";
9012            pr "  }\n"
9013        | RString _ ->
9014            pr "  py_r = PyString_FromString (r);\n";
9015            pr "  free (r);\n"
9016        | RStringList _ ->
9017            pr "  py_r = put_string_list (r);\n";
9018            pr "  free_strings (r);\n"
9019        | RStruct (_, typ) ->
9020            pr "  py_r = put_%s (r);\n" typ;
9021            pr "  guestfs_free_%s (r);\n" typ
9022        | RStructList (_, typ) ->
9023            pr "  py_r = put_%s_list (r);\n" typ;
9024            pr "  guestfs_free_%s_list (r);\n" typ
9025        | RHashtable n ->
9026            pr "  py_r = put_table (r);\n";
9027            pr "  free_strings (r);\n"
9028        | RBufferOut _ ->
9029            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9030            pr "  free (r);\n"
9031       );
9032
9033       pr "  return py_r;\n";
9034       pr "}\n";
9035       pr "\n"
9036   ) all_functions;
9037
9038   (* Table of functions. *)
9039   pr "static PyMethodDef methods[] = {\n";
9040   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9041   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9042   List.iter (
9043     fun (name, _, _, _, _, _, _) ->
9044       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9045         name name
9046   ) all_functions;
9047   pr "  { NULL, NULL, 0, NULL }\n";
9048   pr "};\n";
9049   pr "\n";
9050
9051   (* Init function. *)
9052   pr "\
9053 void
9054 initlibguestfsmod (void)
9055 {
9056   static int initialized = 0;
9057
9058   if (initialized) return;
9059   Py_InitModule ((char *) \"libguestfsmod\", methods);
9060   initialized = 1;
9061 }
9062 "
9063
9064 (* Generate Python module. *)
9065 and generate_python_py () =
9066   generate_header HashStyle LGPLv2plus;
9067
9068   pr "\
9069 u\"\"\"Python bindings for libguestfs
9070
9071 import guestfs
9072 g = guestfs.GuestFS ()
9073 g.add_drive (\"guest.img\")
9074 g.launch ()
9075 parts = g.list_partitions ()
9076
9077 The guestfs module provides a Python binding to the libguestfs API
9078 for examining and modifying virtual machine disk images.
9079
9080 Amongst the things this is good for: making batch configuration
9081 changes to guests, getting disk used/free statistics (see also:
9082 virt-df), migrating between virtualization systems (see also:
9083 virt-p2v), performing partial backups, performing partial guest
9084 clones, cloning guests and changing registry/UUID/hostname info, and
9085 much else besides.
9086
9087 Libguestfs uses Linux kernel and qemu code, and can access any type of
9088 guest filesystem that Linux and qemu can, including but not limited
9089 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9090 schemes, qcow, qcow2, vmdk.
9091
9092 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9093 LVs, what filesystem is in each LV, etc.).  It can also run commands
9094 in the context of the guest.  Also you can access filesystems over
9095 FUSE.
9096
9097 Errors which happen while using the API are turned into Python
9098 RuntimeError exceptions.
9099
9100 To create a guestfs handle you usually have to perform the following
9101 sequence of calls:
9102
9103 # Create the handle, call add_drive at least once, and possibly
9104 # several times if the guest has multiple block devices:
9105 g = guestfs.GuestFS ()
9106 g.add_drive (\"guest.img\")
9107
9108 # Launch the qemu subprocess and wait for it to become ready:
9109 g.launch ()
9110
9111 # Now you can issue commands, for example:
9112 logvols = g.lvs ()
9113
9114 \"\"\"
9115
9116 import libguestfsmod
9117
9118 class GuestFS:
9119     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9120
9121     def __init__ (self):
9122         \"\"\"Create a new libguestfs handle.\"\"\"
9123         self._o = libguestfsmod.create ()
9124
9125     def __del__ (self):
9126         libguestfsmod.close (self._o)
9127
9128 ";
9129
9130   List.iter (
9131     fun (name, style, _, flags, _, _, longdesc) ->
9132       pr "    def %s " name;
9133       generate_py_call_args ~handle:"self" (snd style);
9134       pr ":\n";
9135
9136       if not (List.mem NotInDocs flags) then (
9137         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9138         let doc =
9139           match fst style with
9140           | RErr | RInt _ | RInt64 _ | RBool _
9141           | RConstOptString _ | RConstString _
9142           | RString _ | RBufferOut _ -> doc
9143           | RStringList _ ->
9144               doc ^ "\n\nThis function returns a list of strings."
9145           | RStruct (_, typ) ->
9146               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9147           | RStructList (_, typ) ->
9148               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9149           | RHashtable _ ->
9150               doc ^ "\n\nThis function returns a dictionary." in
9151         let doc =
9152           if List.mem ProtocolLimitWarning flags then
9153             doc ^ "\n\n" ^ protocol_limit_warning
9154           else doc in
9155         let doc =
9156           if List.mem DangerWillRobinson flags then
9157             doc ^ "\n\n" ^ danger_will_robinson
9158           else doc in
9159         let doc =
9160           match deprecation_notice flags with
9161           | None -> doc
9162           | Some txt -> doc ^ "\n\n" ^ txt in
9163         let doc = pod2text ~width:60 name doc in
9164         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9165         let doc = String.concat "\n        " doc in
9166         pr "        u\"\"\"%s\"\"\"\n" doc;
9167       );
9168       pr "        return libguestfsmod.%s " name;
9169       generate_py_call_args ~handle:"self._o" (snd style);
9170       pr "\n";
9171       pr "\n";
9172   ) all_functions
9173
9174 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9175 and generate_py_call_args ~handle args =
9176   pr "(%s" handle;
9177   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9178   pr ")"
9179
9180 (* Useful if you need the longdesc POD text as plain text.  Returns a
9181  * list of lines.
9182  *
9183  * Because this is very slow (the slowest part of autogeneration),
9184  * we memoize the results.
9185  *)
9186 and pod2text ~width name longdesc =
9187   let key = width, name, longdesc in
9188   try Hashtbl.find pod2text_memo key
9189   with Not_found ->
9190     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9191     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9192     close_out chan;
9193     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9194     let chan = open_process_in cmd in
9195     let lines = ref [] in
9196     let rec loop i =
9197       let line = input_line chan in
9198       if i = 1 then             (* discard the first line of output *)
9199         loop (i+1)
9200       else (
9201         let line = triml line in
9202         lines := line :: !lines;
9203         loop (i+1)
9204       ) in
9205     let lines = try loop 1 with End_of_file -> List.rev !lines in
9206     unlink filename;
9207     (match close_process_in chan with
9208      | WEXITED 0 -> ()
9209      | WEXITED i ->
9210          failwithf "pod2text: process exited with non-zero status (%d)" i
9211      | WSIGNALED i | WSTOPPED i ->
9212          failwithf "pod2text: process signalled or stopped by signal %d" i
9213     );
9214     Hashtbl.add pod2text_memo key lines;
9215     pod2text_memo_updated ();
9216     lines
9217
9218 (* Generate ruby bindings. *)
9219 and generate_ruby_c () =
9220   generate_header CStyle LGPLv2plus;
9221
9222   pr "\
9223 #include <stdio.h>
9224 #include <stdlib.h>
9225
9226 #include <ruby.h>
9227
9228 #include \"guestfs.h\"
9229
9230 #include \"extconf.h\"
9231
9232 /* For Ruby < 1.9 */
9233 #ifndef RARRAY_LEN
9234 #define RARRAY_LEN(r) (RARRAY((r))->len)
9235 #endif
9236
9237 static VALUE m_guestfs;                 /* guestfs module */
9238 static VALUE c_guestfs;                 /* guestfs_h handle */
9239 static VALUE e_Error;                   /* used for all errors */
9240
9241 static void ruby_guestfs_free (void *p)
9242 {
9243   if (!p) return;
9244   guestfs_close ((guestfs_h *) p);
9245 }
9246
9247 static VALUE ruby_guestfs_create (VALUE m)
9248 {
9249   guestfs_h *g;
9250
9251   g = guestfs_create ();
9252   if (!g)
9253     rb_raise (e_Error, \"failed to create guestfs handle\");
9254
9255   /* Don't print error messages to stderr by default. */
9256   guestfs_set_error_handler (g, NULL, NULL);
9257
9258   /* Wrap it, and make sure the close function is called when the
9259    * handle goes away.
9260    */
9261   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9262 }
9263
9264 static VALUE ruby_guestfs_close (VALUE gv)
9265 {
9266   guestfs_h *g;
9267   Data_Get_Struct (gv, guestfs_h, g);
9268
9269   ruby_guestfs_free (g);
9270   DATA_PTR (gv) = NULL;
9271
9272   return Qnil;
9273 }
9274
9275 ";
9276
9277   List.iter (
9278     fun (name, style, _, _, _, _, _) ->
9279       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9280       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9281       pr ")\n";
9282       pr "{\n";
9283       pr "  guestfs_h *g;\n";
9284       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9285       pr "  if (!g)\n";
9286       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9287         name;
9288       pr "\n";
9289
9290       List.iter (
9291         function
9292         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9293             pr "  Check_Type (%sv, T_STRING);\n" n;
9294             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9295             pr "  if (!%s)\n" n;
9296             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9297             pr "              \"%s\", \"%s\");\n" n name
9298         | OptString n ->
9299             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9300         | StringList n | DeviceList n ->
9301             pr "  char **%s;\n" n;
9302             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9303             pr "  {\n";
9304             pr "    int i, len;\n";
9305             pr "    len = RARRAY_LEN (%sv);\n" n;
9306             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9307               n;
9308             pr "    for (i = 0; i < len; ++i) {\n";
9309             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9310             pr "      %s[i] = StringValueCStr (v);\n" n;
9311             pr "    }\n";
9312             pr "    %s[len] = NULL;\n" n;
9313             pr "  }\n";
9314         | Bool n ->
9315             pr "  int %s = RTEST (%sv);\n" n n
9316         | Int n ->
9317             pr "  int %s = NUM2INT (%sv);\n" n n
9318         | Int64 n ->
9319             pr "  long long %s = NUM2LL (%sv);\n" n n
9320       ) (snd style);
9321       pr "\n";
9322
9323       let error_code =
9324         match fst style with
9325         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9326         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9327         | RConstString _ | RConstOptString _ ->
9328             pr "  const char *r;\n"; "NULL"
9329         | RString _ -> pr "  char *r;\n"; "NULL"
9330         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9331         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9332         | RStructList (_, typ) ->
9333             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9334         | RBufferOut _ ->
9335             pr "  char *r;\n";
9336             pr "  size_t size;\n";
9337             "NULL" in
9338       pr "\n";
9339
9340       pr "  r = guestfs_%s " name;
9341       generate_c_call_args ~handle:"g" style;
9342       pr ";\n";
9343
9344       List.iter (
9345         function
9346         | Pathname _ | Device _ | Dev_or_Path _ | String _
9347         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9348         | StringList n | DeviceList n ->
9349             pr "  free (%s);\n" n
9350       ) (snd style);
9351
9352       pr "  if (r == %s)\n" error_code;
9353       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9354       pr "\n";
9355
9356       (match fst style with
9357        | RErr ->
9358            pr "  return Qnil;\n"
9359        | RInt _ | RBool _ ->
9360            pr "  return INT2NUM (r);\n"
9361        | RInt64 _ ->
9362            pr "  return ULL2NUM (r);\n"
9363        | RConstString _ ->
9364            pr "  return rb_str_new2 (r);\n";
9365        | RConstOptString _ ->
9366            pr "  if (r)\n";
9367            pr "    return rb_str_new2 (r);\n";
9368            pr "  else\n";
9369            pr "    return Qnil;\n";
9370        | RString _ ->
9371            pr "  VALUE rv = rb_str_new2 (r);\n";
9372            pr "  free (r);\n";
9373            pr "  return rv;\n";
9374        | RStringList _ ->
9375            pr "  int i, len = 0;\n";
9376            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9377            pr "  VALUE rv = rb_ary_new2 (len);\n";
9378            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9379            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9380            pr "    free (r[i]);\n";
9381            pr "  }\n";
9382            pr "  free (r);\n";
9383            pr "  return rv;\n"
9384        | RStruct (_, typ) ->
9385            let cols = cols_of_struct typ in
9386            generate_ruby_struct_code typ cols
9387        | RStructList (_, typ) ->
9388            let cols = cols_of_struct typ in
9389            generate_ruby_struct_list_code typ cols
9390        | RHashtable _ ->
9391            pr "  VALUE rv = rb_hash_new ();\n";
9392            pr "  int i;\n";
9393            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9394            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9395            pr "    free (r[i]);\n";
9396            pr "    free (r[i+1]);\n";
9397            pr "  }\n";
9398            pr "  free (r);\n";
9399            pr "  return rv;\n"
9400        | RBufferOut _ ->
9401            pr "  VALUE rv = rb_str_new (r, size);\n";
9402            pr "  free (r);\n";
9403            pr "  return rv;\n";
9404       );
9405
9406       pr "}\n";
9407       pr "\n"
9408   ) all_functions;
9409
9410   pr "\
9411 /* Initialize the module. */
9412 void Init__guestfs ()
9413 {
9414   m_guestfs = rb_define_module (\"Guestfs\");
9415   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9416   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9417
9418   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9419   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9420
9421 ";
9422   (* Define the rest of the methods. *)
9423   List.iter (
9424     fun (name, style, _, _, _, _, _) ->
9425       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9426       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9427   ) all_functions;
9428
9429   pr "}\n"
9430
9431 (* Ruby code to return a struct. *)
9432 and generate_ruby_struct_code typ cols =
9433   pr "  VALUE rv = rb_hash_new ();\n";
9434   List.iter (
9435     function
9436     | name, FString ->
9437         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9438     | name, FBuffer ->
9439         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9440     | name, FUUID ->
9441         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9442     | name, (FBytes|FUInt64) ->
9443         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9444     | name, FInt64 ->
9445         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9446     | name, FUInt32 ->
9447         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9448     | name, FInt32 ->
9449         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9450     | name, FOptPercent ->
9451         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9452     | name, FChar -> (* XXX wrong? *)
9453         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9454   ) cols;
9455   pr "  guestfs_free_%s (r);\n" typ;
9456   pr "  return rv;\n"
9457
9458 (* Ruby code to return a struct list. *)
9459 and generate_ruby_struct_list_code typ cols =
9460   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9461   pr "  int i;\n";
9462   pr "  for (i = 0; i < r->len; ++i) {\n";
9463   pr "    VALUE hv = rb_hash_new ();\n";
9464   List.iter (
9465     function
9466     | name, FString ->
9467         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9468     | name, FBuffer ->
9469         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
9470     | name, FUUID ->
9471         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9472     | name, (FBytes|FUInt64) ->
9473         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9474     | name, FInt64 ->
9475         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9476     | name, FUInt32 ->
9477         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9478     | name, FInt32 ->
9479         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9480     | name, FOptPercent ->
9481         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9482     | name, FChar -> (* XXX wrong? *)
9483         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9484   ) cols;
9485   pr "    rb_ary_push (rv, hv);\n";
9486   pr "  }\n";
9487   pr "  guestfs_free_%s_list (r);\n" typ;
9488   pr "  return rv;\n"
9489
9490 (* Generate Java bindings GuestFS.java file. *)
9491 and generate_java_java () =
9492   generate_header CStyle LGPLv2plus;
9493
9494   pr "\
9495 package com.redhat.et.libguestfs;
9496
9497 import java.util.HashMap;
9498 import com.redhat.et.libguestfs.LibGuestFSException;
9499 import com.redhat.et.libguestfs.PV;
9500 import com.redhat.et.libguestfs.VG;
9501 import com.redhat.et.libguestfs.LV;
9502 import com.redhat.et.libguestfs.Stat;
9503 import com.redhat.et.libguestfs.StatVFS;
9504 import com.redhat.et.libguestfs.IntBool;
9505 import com.redhat.et.libguestfs.Dirent;
9506
9507 /**
9508  * The GuestFS object is a libguestfs handle.
9509  *
9510  * @author rjones
9511  */
9512 public class GuestFS {
9513   // Load the native code.
9514   static {
9515     System.loadLibrary (\"guestfs_jni\");
9516   }
9517
9518   /**
9519    * The native guestfs_h pointer.
9520    */
9521   long g;
9522
9523   /**
9524    * Create a libguestfs handle.
9525    *
9526    * @throws LibGuestFSException
9527    */
9528   public GuestFS () throws LibGuestFSException
9529   {
9530     g = _create ();
9531   }
9532   private native long _create () throws LibGuestFSException;
9533
9534   /**
9535    * Close a libguestfs handle.
9536    *
9537    * You can also leave handles to be collected by the garbage
9538    * collector, but this method ensures that the resources used
9539    * by the handle are freed up immediately.  If you call any
9540    * other methods after closing the handle, you will get an
9541    * exception.
9542    *
9543    * @throws LibGuestFSException
9544    */
9545   public void close () throws LibGuestFSException
9546   {
9547     if (g != 0)
9548       _close (g);
9549     g = 0;
9550   }
9551   private native void _close (long g) throws LibGuestFSException;
9552
9553   public void finalize () throws LibGuestFSException
9554   {
9555     close ();
9556   }
9557
9558 ";
9559
9560   List.iter (
9561     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9562       if not (List.mem NotInDocs flags); then (
9563         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9564         let doc =
9565           if List.mem ProtocolLimitWarning flags then
9566             doc ^ "\n\n" ^ protocol_limit_warning
9567           else doc in
9568         let doc =
9569           if List.mem DangerWillRobinson flags then
9570             doc ^ "\n\n" ^ danger_will_robinson
9571           else doc in
9572         let doc =
9573           match deprecation_notice flags with
9574           | None -> doc
9575           | Some txt -> doc ^ "\n\n" ^ txt in
9576         let doc = pod2text ~width:60 name doc in
9577         let doc = List.map (            (* RHBZ#501883 *)
9578           function
9579           | "" -> "<p>"
9580           | nonempty -> nonempty
9581         ) doc in
9582         let doc = String.concat "\n   * " doc in
9583
9584         pr "  /**\n";
9585         pr "   * %s\n" shortdesc;
9586         pr "   * <p>\n";
9587         pr "   * %s\n" doc;
9588         pr "   * @throws LibGuestFSException\n";
9589         pr "   */\n";
9590         pr "  ";
9591       );
9592       generate_java_prototype ~public:true ~semicolon:false name style;
9593       pr "\n";
9594       pr "  {\n";
9595       pr "    if (g == 0)\n";
9596       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9597         name;
9598       pr "    ";
9599       if fst style <> RErr then pr "return ";
9600       pr "_%s " name;
9601       generate_java_call_args ~handle:"g" (snd style);
9602       pr ";\n";
9603       pr "  }\n";
9604       pr "  ";
9605       generate_java_prototype ~privat:true ~native:true name style;
9606       pr "\n";
9607       pr "\n";
9608   ) all_functions;
9609
9610   pr "}\n"
9611
9612 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9613 and generate_java_call_args ~handle args =
9614   pr "(%s" handle;
9615   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9616   pr ")"
9617
9618 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9619     ?(semicolon=true) name style =
9620   if privat then pr "private ";
9621   if public then pr "public ";
9622   if native then pr "native ";
9623
9624   (* return type *)
9625   (match fst style with
9626    | RErr -> pr "void ";
9627    | RInt _ -> pr "int ";
9628    | RInt64 _ -> pr "long ";
9629    | RBool _ -> pr "boolean ";
9630    | RConstString _ | RConstOptString _ | RString _
9631    | RBufferOut _ -> pr "String ";
9632    | RStringList _ -> pr "String[] ";
9633    | RStruct (_, typ) ->
9634        let name = java_name_of_struct typ in
9635        pr "%s " name;
9636    | RStructList (_, typ) ->
9637        let name = java_name_of_struct typ in
9638        pr "%s[] " name;
9639    | RHashtable _ -> pr "HashMap<String,String> ";
9640   );
9641
9642   if native then pr "_%s " name else pr "%s " name;
9643   pr "(";
9644   let needs_comma = ref false in
9645   if native then (
9646     pr "long g";
9647     needs_comma := true
9648   );
9649
9650   (* args *)
9651   List.iter (
9652     fun arg ->
9653       if !needs_comma then pr ", ";
9654       needs_comma := true;
9655
9656       match arg with
9657       | Pathname n
9658       | Device n | Dev_or_Path n
9659       | String n
9660       | OptString n
9661       | FileIn n
9662       | FileOut n ->
9663           pr "String %s" n
9664       | StringList n | DeviceList n ->
9665           pr "String[] %s" n
9666       | Bool n ->
9667           pr "boolean %s" n
9668       | Int n ->
9669           pr "int %s" n
9670       | Int64 n ->
9671           pr "long %s" n
9672   ) (snd style);
9673
9674   pr ")\n";
9675   pr "    throws LibGuestFSException";
9676   if semicolon then pr ";"
9677
9678 and generate_java_struct jtyp cols () =
9679   generate_header CStyle LGPLv2plus;
9680
9681   pr "\
9682 package com.redhat.et.libguestfs;
9683
9684 /**
9685  * Libguestfs %s structure.
9686  *
9687  * @author rjones
9688  * @see GuestFS
9689  */
9690 public class %s {
9691 " jtyp jtyp;
9692
9693   List.iter (
9694     function
9695     | name, FString
9696     | name, FUUID
9697     | name, FBuffer -> pr "  public String %s;\n" name
9698     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9699     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9700     | name, FChar -> pr "  public char %s;\n" name
9701     | name, FOptPercent ->
9702         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9703         pr "  public float %s;\n" name
9704   ) cols;
9705
9706   pr "}\n"
9707
9708 and generate_java_c () =
9709   generate_header CStyle LGPLv2plus;
9710
9711   pr "\
9712 #include <stdio.h>
9713 #include <stdlib.h>
9714 #include <string.h>
9715
9716 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9717 #include \"guestfs.h\"
9718
9719 /* Note that this function returns.  The exception is not thrown
9720  * until after the wrapper function returns.
9721  */
9722 static void
9723 throw_exception (JNIEnv *env, const char *msg)
9724 {
9725   jclass cl;
9726   cl = (*env)->FindClass (env,
9727                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9728   (*env)->ThrowNew (env, cl, msg);
9729 }
9730
9731 JNIEXPORT jlong JNICALL
9732 Java_com_redhat_et_libguestfs_GuestFS__1create
9733   (JNIEnv *env, jobject obj)
9734 {
9735   guestfs_h *g;
9736
9737   g = guestfs_create ();
9738   if (g == NULL) {
9739     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9740     return 0;
9741   }
9742   guestfs_set_error_handler (g, NULL, NULL);
9743   return (jlong) (long) g;
9744 }
9745
9746 JNIEXPORT void JNICALL
9747 Java_com_redhat_et_libguestfs_GuestFS__1close
9748   (JNIEnv *env, jobject obj, jlong jg)
9749 {
9750   guestfs_h *g = (guestfs_h *) (long) jg;
9751   guestfs_close (g);
9752 }
9753
9754 ";
9755
9756   List.iter (
9757     fun (name, style, _, _, _, _, _) ->
9758       pr "JNIEXPORT ";
9759       (match fst style with
9760        | RErr -> pr "void ";
9761        | RInt _ -> pr "jint ";
9762        | RInt64 _ -> pr "jlong ";
9763        | RBool _ -> pr "jboolean ";
9764        | RConstString _ | RConstOptString _ | RString _
9765        | RBufferOut _ -> pr "jstring ";
9766        | RStruct _ | RHashtable _ ->
9767            pr "jobject ";
9768        | RStringList _ | RStructList _ ->
9769            pr "jobjectArray ";
9770       );
9771       pr "JNICALL\n";
9772       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9773       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9774       pr "\n";
9775       pr "  (JNIEnv *env, jobject obj, jlong jg";
9776       List.iter (
9777         function
9778         | Pathname n
9779         | Device n | Dev_or_Path n
9780         | String n
9781         | OptString n
9782         | FileIn n
9783         | FileOut n ->
9784             pr ", jstring j%s" n
9785         | StringList n | DeviceList n ->
9786             pr ", jobjectArray j%s" n
9787         | Bool n ->
9788             pr ", jboolean j%s" n
9789         | Int n ->
9790             pr ", jint j%s" n
9791         | Int64 n ->
9792             pr ", jlong j%s" n
9793       ) (snd style);
9794       pr ")\n";
9795       pr "{\n";
9796       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9797       let error_code, no_ret =
9798         match fst style with
9799         | RErr -> pr "  int r;\n"; "-1", ""
9800         | RBool _
9801         | RInt _ -> pr "  int r;\n"; "-1", "0"
9802         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9803         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9804         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9805         | RString _ ->
9806             pr "  jstring jr;\n";
9807             pr "  char *r;\n"; "NULL", "NULL"
9808         | RStringList _ ->
9809             pr "  jobjectArray jr;\n";
9810             pr "  int r_len;\n";
9811             pr "  jclass cl;\n";
9812             pr "  jstring jstr;\n";
9813             pr "  char **r;\n"; "NULL", "NULL"
9814         | RStruct (_, typ) ->
9815             pr "  jobject jr;\n";
9816             pr "  jclass cl;\n";
9817             pr "  jfieldID fl;\n";
9818             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9819         | RStructList (_, typ) ->
9820             pr "  jobjectArray jr;\n";
9821             pr "  jclass cl;\n";
9822             pr "  jfieldID fl;\n";
9823             pr "  jobject jfl;\n";
9824             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9825         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9826         | RBufferOut _ ->
9827             pr "  jstring jr;\n";
9828             pr "  char *r;\n";
9829             pr "  size_t size;\n";
9830             "NULL", "NULL" in
9831       List.iter (
9832         function
9833         | Pathname n
9834         | Device n | Dev_or_Path n
9835         | String n
9836         | OptString n
9837         | FileIn n
9838         | FileOut n ->
9839             pr "  const char *%s;\n" n
9840         | StringList n | DeviceList n ->
9841             pr "  int %s_len;\n" n;
9842             pr "  const char **%s;\n" n
9843         | Bool n
9844         | Int n ->
9845             pr "  int %s;\n" n
9846         | Int64 n ->
9847             pr "  int64_t %s;\n" n
9848       ) (snd style);
9849
9850       let needs_i =
9851         (match fst style with
9852          | RStringList _ | RStructList _ -> true
9853          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9854          | RConstOptString _
9855          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9856           List.exists (function
9857                        | StringList _ -> true
9858                        | DeviceList _ -> true
9859                        | _ -> false) (snd style) in
9860       if needs_i then
9861         pr "  int i;\n";
9862
9863       pr "\n";
9864
9865       (* Get the parameters. *)
9866       List.iter (
9867         function
9868         | Pathname n
9869         | Device n | Dev_or_Path n
9870         | String n
9871         | FileIn n
9872         | FileOut n ->
9873             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9874         | OptString n ->
9875             (* This is completely undocumented, but Java null becomes
9876              * a NULL parameter.
9877              *)
9878             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9879         | StringList n | DeviceList n ->
9880             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9881             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9882             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9883             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9884               n;
9885             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9886             pr "  }\n";
9887             pr "  %s[%s_len] = NULL;\n" n n;
9888         | Bool n
9889         | Int n
9890         | Int64 n ->
9891             pr "  %s = j%s;\n" n n
9892       ) (snd style);
9893
9894       (* Make the call. *)
9895       pr "  r = guestfs_%s " name;
9896       generate_c_call_args ~handle:"g" style;
9897       pr ";\n";
9898
9899       (* Release the parameters. *)
9900       List.iter (
9901         function
9902         | Pathname n
9903         | Device n | Dev_or_Path n
9904         | String n
9905         | FileIn n
9906         | FileOut n ->
9907             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9908         | OptString n ->
9909             pr "  if (j%s)\n" n;
9910             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9911         | StringList n | DeviceList n ->
9912             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9913             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9914               n;
9915             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
9916             pr "  }\n";
9917             pr "  free (%s);\n" n
9918         | Bool n
9919         | Int n
9920         | Int64 n -> ()
9921       ) (snd style);
9922
9923       (* Check for errors. *)
9924       pr "  if (r == %s) {\n" error_code;
9925       pr "    throw_exception (env, guestfs_last_error (g));\n";
9926       pr "    return %s;\n" no_ret;
9927       pr "  }\n";
9928
9929       (* Return value. *)
9930       (match fst style with
9931        | RErr -> ()
9932        | RInt _ -> pr "  return (jint) r;\n"
9933        | RBool _ -> pr "  return (jboolean) r;\n"
9934        | RInt64 _ -> pr "  return (jlong) r;\n"
9935        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
9936        | RConstOptString _ ->
9937            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
9938        | RString _ ->
9939            pr "  jr = (*env)->NewStringUTF (env, r);\n";
9940            pr "  free (r);\n";
9941            pr "  return jr;\n"
9942        | RStringList _ ->
9943            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
9944            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
9945            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
9946            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
9947            pr "  for (i = 0; i < r_len; ++i) {\n";
9948            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
9949            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
9950            pr "    free (r[i]);\n";
9951            pr "  }\n";
9952            pr "  free (r);\n";
9953            pr "  return jr;\n"
9954        | RStruct (_, typ) ->
9955            let jtyp = java_name_of_struct typ in
9956            let cols = cols_of_struct typ in
9957            generate_java_struct_return typ jtyp cols
9958        | RStructList (_, typ) ->
9959            let jtyp = java_name_of_struct typ in
9960            let cols = cols_of_struct typ in
9961            generate_java_struct_list_return typ jtyp cols
9962        | RHashtable _ ->
9963            (* XXX *)
9964            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
9965            pr "  return NULL;\n"
9966        | RBufferOut _ ->
9967            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
9968            pr "  free (r);\n";
9969            pr "  return jr;\n"
9970       );
9971
9972       pr "}\n";
9973       pr "\n"
9974   ) all_functions
9975
9976 and generate_java_struct_return typ jtyp cols =
9977   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
9978   pr "  jr = (*env)->AllocObject (env, cl);\n";
9979   List.iter (
9980     function
9981     | name, FString ->
9982         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
9983         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
9984     | name, FUUID ->
9985         pr "  {\n";
9986         pr "    char s[33];\n";
9987         pr "    memcpy (s, r->%s, 32);\n" name;
9988         pr "    s[32] = 0;\n";
9989         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
9990         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
9991         pr "  }\n";
9992     | name, FBuffer ->
9993         pr "  {\n";
9994         pr "    int len = r->%s_len;\n" name;
9995         pr "    char s[len+1];\n";
9996         pr "    memcpy (s, r->%s, len);\n" name;
9997         pr "    s[len] = 0;\n";
9998         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
9999         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10000         pr "  }\n";
10001     | name, (FBytes|FUInt64|FInt64) ->
10002         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10003         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10004     | name, (FUInt32|FInt32) ->
10005         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10006         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10007     | name, FOptPercent ->
10008         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10009         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10010     | name, FChar ->
10011         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10012         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10013   ) cols;
10014   pr "  free (r);\n";
10015   pr "  return jr;\n"
10016
10017 and generate_java_struct_list_return typ jtyp cols =
10018   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10019   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10020   pr "  for (i = 0; i < r->len; ++i) {\n";
10021   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10022   List.iter (
10023     function
10024     | name, FString ->
10025         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10026         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10027     | name, FUUID ->
10028         pr "    {\n";
10029         pr "      char s[33];\n";
10030         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10031         pr "      s[32] = 0;\n";
10032         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10033         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10034         pr "    }\n";
10035     | name, FBuffer ->
10036         pr "    {\n";
10037         pr "      int len = r->val[i].%s_len;\n" name;
10038         pr "      char s[len+1];\n";
10039         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10040         pr "      s[len] = 0;\n";
10041         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10042         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10043         pr "    }\n";
10044     | name, (FBytes|FUInt64|FInt64) ->
10045         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10046         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10047     | name, (FUInt32|FInt32) ->
10048         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10049         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10050     | name, FOptPercent ->
10051         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10052         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10053     | name, FChar ->
10054         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10055         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10056   ) cols;
10057   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10058   pr "  }\n";
10059   pr "  guestfs_free_%s_list (r);\n" typ;
10060   pr "  return jr;\n"
10061
10062 and generate_java_makefile_inc () =
10063   generate_header HashStyle GPLv2plus;
10064
10065   pr "java_built_sources = \\\n";
10066   List.iter (
10067     fun (typ, jtyp) ->
10068         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10069   ) java_structs;
10070   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10071
10072 and generate_haskell_hs () =
10073   generate_header HaskellStyle LGPLv2plus;
10074
10075   (* XXX We only know how to generate partial FFI for Haskell
10076    * at the moment.  Please help out!
10077    *)
10078   let can_generate style =
10079     match style with
10080     | RErr, _
10081     | RInt _, _
10082     | RInt64 _, _ -> true
10083     | RBool _, _
10084     | RConstString _, _
10085     | RConstOptString _, _
10086     | RString _, _
10087     | RStringList _, _
10088     | RStruct _, _
10089     | RStructList _, _
10090     | RHashtable _, _
10091     | RBufferOut _, _ -> false in
10092
10093   pr "\
10094 {-# INCLUDE <guestfs.h> #-}
10095 {-# LANGUAGE ForeignFunctionInterface #-}
10096
10097 module Guestfs (
10098   create";
10099
10100   (* List out the names of the actions we want to export. *)
10101   List.iter (
10102     fun (name, style, _, _, _, _, _) ->
10103       if can_generate style then pr ",\n  %s" name
10104   ) all_functions;
10105
10106   pr "
10107   ) where
10108
10109 -- Unfortunately some symbols duplicate ones already present
10110 -- in Prelude.  We don't know which, so we hard-code a list
10111 -- here.
10112 import Prelude hiding (truncate)
10113
10114 import Foreign
10115 import Foreign.C
10116 import Foreign.C.Types
10117 import IO
10118 import Control.Exception
10119 import Data.Typeable
10120
10121 data GuestfsS = GuestfsS            -- represents the opaque C struct
10122 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10123 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10124
10125 -- XXX define properly later XXX
10126 data PV = PV
10127 data VG = VG
10128 data LV = LV
10129 data IntBool = IntBool
10130 data Stat = Stat
10131 data StatVFS = StatVFS
10132 data Hashtable = Hashtable
10133
10134 foreign import ccall unsafe \"guestfs_create\" c_create
10135   :: IO GuestfsP
10136 foreign import ccall unsafe \"&guestfs_close\" c_close
10137   :: FunPtr (GuestfsP -> IO ())
10138 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10139   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10140
10141 create :: IO GuestfsH
10142 create = do
10143   p <- c_create
10144   c_set_error_handler p nullPtr nullPtr
10145   h <- newForeignPtr c_close p
10146   return h
10147
10148 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10149   :: GuestfsP -> IO CString
10150
10151 -- last_error :: GuestfsH -> IO (Maybe String)
10152 -- last_error h = do
10153 --   str <- withForeignPtr h (\\p -> c_last_error p)
10154 --   maybePeek peekCString str
10155
10156 last_error :: GuestfsH -> IO (String)
10157 last_error h = do
10158   str <- withForeignPtr h (\\p -> c_last_error p)
10159   if (str == nullPtr)
10160     then return \"no error\"
10161     else peekCString str
10162
10163 ";
10164
10165   (* Generate wrappers for each foreign function. *)
10166   List.iter (
10167     fun (name, style, _, _, _, _, _) ->
10168       if can_generate style then (
10169         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10170         pr "  :: ";
10171         generate_haskell_prototype ~handle:"GuestfsP" style;
10172         pr "\n";
10173         pr "\n";
10174         pr "%s :: " name;
10175         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10176         pr "\n";
10177         pr "%s %s = do\n" name
10178           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10179         pr "  r <- ";
10180         (* Convert pointer arguments using with* functions. *)
10181         List.iter (
10182           function
10183           | FileIn n
10184           | FileOut n
10185           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10186           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10187           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10188           | Bool _ | Int _ | Int64 _ -> ()
10189         ) (snd style);
10190         (* Convert integer arguments. *)
10191         let args =
10192           List.map (
10193             function
10194             | Bool n -> sprintf "(fromBool %s)" n
10195             | Int n -> sprintf "(fromIntegral %s)" n
10196             | Int64 n -> sprintf "(fromIntegral %s)" n
10197             | FileIn n | FileOut n
10198             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10199           ) (snd style) in
10200         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10201           (String.concat " " ("p" :: args));
10202         (match fst style with
10203          | RErr | RInt _ | RInt64 _ | RBool _ ->
10204              pr "  if (r == -1)\n";
10205              pr "    then do\n";
10206              pr "      err <- last_error h\n";
10207              pr "      fail err\n";
10208          | RConstString _ | RConstOptString _ | RString _
10209          | RStringList _ | RStruct _
10210          | RStructList _ | RHashtable _ | RBufferOut _ ->
10211              pr "  if (r == nullPtr)\n";
10212              pr "    then do\n";
10213              pr "      err <- last_error h\n";
10214              pr "      fail err\n";
10215         );
10216         (match fst style with
10217          | RErr ->
10218              pr "    else return ()\n"
10219          | RInt _ ->
10220              pr "    else return (fromIntegral r)\n"
10221          | RInt64 _ ->
10222              pr "    else return (fromIntegral r)\n"
10223          | RBool _ ->
10224              pr "    else return (toBool r)\n"
10225          | RConstString _
10226          | RConstOptString _
10227          | RString _
10228          | RStringList _
10229          | RStruct _
10230          | RStructList _
10231          | RHashtable _
10232          | RBufferOut _ ->
10233              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10234         );
10235         pr "\n";
10236       )
10237   ) all_functions
10238
10239 and generate_haskell_prototype ~handle ?(hs = false) style =
10240   pr "%s -> " handle;
10241   let string = if hs then "String" else "CString" in
10242   let int = if hs then "Int" else "CInt" in
10243   let bool = if hs then "Bool" else "CInt" in
10244   let int64 = if hs then "Integer" else "Int64" in
10245   List.iter (
10246     fun arg ->
10247       (match arg with
10248        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10249        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10250        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10251        | Bool _ -> pr "%s" bool
10252        | Int _ -> pr "%s" int
10253        | Int64 _ -> pr "%s" int
10254        | FileIn _ -> pr "%s" string
10255        | FileOut _ -> pr "%s" string
10256       );
10257       pr " -> ";
10258   ) (snd style);
10259   pr "IO (";
10260   (match fst style with
10261    | RErr -> if not hs then pr "CInt"
10262    | RInt _ -> pr "%s" int
10263    | RInt64 _ -> pr "%s" int64
10264    | RBool _ -> pr "%s" bool
10265    | RConstString _ -> pr "%s" string
10266    | RConstOptString _ -> pr "Maybe %s" string
10267    | RString _ -> pr "%s" string
10268    | RStringList _ -> pr "[%s]" string
10269    | RStruct (_, typ) ->
10270        let name = java_name_of_struct typ in
10271        pr "%s" name
10272    | RStructList (_, typ) ->
10273        let name = java_name_of_struct typ in
10274        pr "[%s]" name
10275    | RHashtable _ -> pr "Hashtable"
10276    | RBufferOut _ -> pr "%s" string
10277   );
10278   pr ")"
10279
10280 and generate_csharp () =
10281   generate_header CPlusPlusStyle LGPLv2plus;
10282
10283   (* XXX Make this configurable by the C# assembly users. *)
10284   let library = "libguestfs.so.0" in
10285
10286   pr "\
10287 // These C# bindings are highly experimental at present.
10288 //
10289 // Firstly they only work on Linux (ie. Mono).  In order to get them
10290 // to work on Windows (ie. .Net) you would need to port the library
10291 // itself to Windows first.
10292 //
10293 // The second issue is that some calls are known to be incorrect and
10294 // can cause Mono to segfault.  Particularly: calls which pass or
10295 // return string[], or return any structure value.  This is because
10296 // we haven't worked out the correct way to do this from C#.
10297 //
10298 // The third issue is that when compiling you get a lot of warnings.
10299 // We are not sure whether the warnings are important or not.
10300 //
10301 // Fourthly we do not routinely build or test these bindings as part
10302 // of the make && make check cycle, which means that regressions might
10303 // go unnoticed.
10304 //
10305 // Suggestions and patches are welcome.
10306
10307 // To compile:
10308 //
10309 // gmcs Libguestfs.cs
10310 // mono Libguestfs.exe
10311 //
10312 // (You'll probably want to add a Test class / static main function
10313 // otherwise this won't do anything useful).
10314
10315 using System;
10316 using System.IO;
10317 using System.Runtime.InteropServices;
10318 using System.Runtime.Serialization;
10319 using System.Collections;
10320
10321 namespace Guestfs
10322 {
10323   class Error : System.ApplicationException
10324   {
10325     public Error (string message) : base (message) {}
10326     protected Error (SerializationInfo info, StreamingContext context) {}
10327   }
10328
10329   class Guestfs
10330   {
10331     IntPtr _handle;
10332
10333     [DllImport (\"%s\")]
10334     static extern IntPtr guestfs_create ();
10335
10336     public Guestfs ()
10337     {
10338       _handle = guestfs_create ();
10339       if (_handle == IntPtr.Zero)
10340         throw new Error (\"could not create guestfs handle\");
10341     }
10342
10343     [DllImport (\"%s\")]
10344     static extern void guestfs_close (IntPtr h);
10345
10346     ~Guestfs ()
10347     {
10348       guestfs_close (_handle);
10349     }
10350
10351     [DllImport (\"%s\")]
10352     static extern string guestfs_last_error (IntPtr h);
10353
10354 " library library library;
10355
10356   (* Generate C# structure bindings.  We prefix struct names with
10357    * underscore because C# cannot have conflicting struct names and
10358    * method names (eg. "class stat" and "stat").
10359    *)
10360   List.iter (
10361     fun (typ, cols) ->
10362       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10363       pr "    public class _%s {\n" typ;
10364       List.iter (
10365         function
10366         | name, FChar -> pr "      char %s;\n" name
10367         | name, FString -> pr "      string %s;\n" name
10368         | name, FBuffer ->
10369             pr "      uint %s_len;\n" name;
10370             pr "      string %s;\n" name
10371         | name, FUUID ->
10372             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10373             pr "      string %s;\n" name
10374         | name, FUInt32 -> pr "      uint %s;\n" name
10375         | name, FInt32 -> pr "      int %s;\n" name
10376         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10377         | name, FInt64 -> pr "      long %s;\n" name
10378         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10379       ) cols;
10380       pr "    }\n";
10381       pr "\n"
10382   ) structs;
10383
10384   (* Generate C# function bindings. *)
10385   List.iter (
10386     fun (name, style, _, _, _, shortdesc, _) ->
10387       let rec csharp_return_type () =
10388         match fst style with
10389         | RErr -> "void"
10390         | RBool n -> "bool"
10391         | RInt n -> "int"
10392         | RInt64 n -> "long"
10393         | RConstString n
10394         | RConstOptString n
10395         | RString n
10396         | RBufferOut n -> "string"
10397         | RStruct (_,n) -> "_" ^ n
10398         | RHashtable n -> "Hashtable"
10399         | RStringList n -> "string[]"
10400         | RStructList (_,n) -> sprintf "_%s[]" n
10401
10402       and c_return_type () =
10403         match fst style with
10404         | RErr
10405         | RBool _
10406         | RInt _ -> "int"
10407         | RInt64 _ -> "long"
10408         | RConstString _
10409         | RConstOptString _
10410         | RString _
10411         | RBufferOut _ -> "string"
10412         | RStruct (_,n) -> "_" ^ n
10413         | RHashtable _
10414         | RStringList _ -> "string[]"
10415         | RStructList (_,n) -> sprintf "_%s[]" n
10416
10417       and c_error_comparison () =
10418         match fst style with
10419         | RErr
10420         | RBool _
10421         | RInt _
10422         | RInt64 _ -> "== -1"
10423         | RConstString _
10424         | RConstOptString _
10425         | RString _
10426         | RBufferOut _
10427         | RStruct (_,_)
10428         | RHashtable _
10429         | RStringList _
10430         | RStructList (_,_) -> "== null"
10431
10432       and generate_extern_prototype () =
10433         pr "    static extern %s guestfs_%s (IntPtr h"
10434           (c_return_type ()) name;
10435         List.iter (
10436           function
10437           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10438           | FileIn n | FileOut n ->
10439               pr ", [In] string %s" n
10440           | StringList n | DeviceList n ->
10441               pr ", [In] string[] %s" n
10442           | Bool n ->
10443               pr ", bool %s" n
10444           | Int n ->
10445               pr ", int %s" n
10446           | Int64 n ->
10447               pr ", long %s" n
10448         ) (snd style);
10449         pr ");\n"
10450
10451       and generate_public_prototype () =
10452         pr "    public %s %s (" (csharp_return_type ()) name;
10453         let comma = ref false in
10454         let next () =
10455           if !comma then pr ", ";
10456           comma := true
10457         in
10458         List.iter (
10459           function
10460           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10461           | FileIn n | FileOut n ->
10462               next (); pr "string %s" n
10463           | StringList n | DeviceList n ->
10464               next (); pr "string[] %s" n
10465           | Bool n ->
10466               next (); pr "bool %s" n
10467           | Int n ->
10468               next (); pr "int %s" n
10469           | Int64 n ->
10470               next (); pr "long %s" n
10471         ) (snd style);
10472         pr ")\n"
10473
10474       and generate_call () =
10475         pr "guestfs_%s (_handle" name;
10476         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10477         pr ");\n";
10478       in
10479
10480       pr "    [DllImport (\"%s\")]\n" library;
10481       generate_extern_prototype ();
10482       pr "\n";
10483       pr "    /// <summary>\n";
10484       pr "    /// %s\n" shortdesc;
10485       pr "    /// </summary>\n";
10486       generate_public_prototype ();
10487       pr "    {\n";
10488       pr "      %s r;\n" (c_return_type ());
10489       pr "      r = ";
10490       generate_call ();
10491       pr "      if (r %s)\n" (c_error_comparison ());
10492       pr "        throw new Error (guestfs_last_error (_handle));\n";
10493       (match fst style with
10494        | RErr -> ()
10495        | RBool _ ->
10496            pr "      return r != 0 ? true : false;\n"
10497        | RHashtable _ ->
10498            pr "      Hashtable rr = new Hashtable ();\n";
10499            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10500            pr "        rr.Add (r[i], r[i+1]);\n";
10501            pr "      return rr;\n"
10502        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10503        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10504        | RStructList _ ->
10505            pr "      return r;\n"
10506       );
10507       pr "    }\n";
10508       pr "\n";
10509   ) all_functions_sorted;
10510
10511   pr "  }
10512 }
10513 "
10514
10515 and generate_bindtests () =
10516   generate_header CStyle LGPLv2plus;
10517
10518   pr "\
10519 #include <stdio.h>
10520 #include <stdlib.h>
10521 #include <inttypes.h>
10522 #include <string.h>
10523
10524 #include \"guestfs.h\"
10525 #include \"guestfs-internal.h\"
10526 #include \"guestfs-internal-actions.h\"
10527 #include \"guestfs_protocol.h\"
10528
10529 #define error guestfs_error
10530 #define safe_calloc guestfs_safe_calloc
10531 #define safe_malloc guestfs_safe_malloc
10532
10533 static void
10534 print_strings (char *const *argv)
10535 {
10536   int argc;
10537
10538   printf (\"[\");
10539   for (argc = 0; argv[argc] != NULL; ++argc) {
10540     if (argc > 0) printf (\", \");
10541     printf (\"\\\"%%s\\\"\", argv[argc]);
10542   }
10543   printf (\"]\\n\");
10544 }
10545
10546 /* The test0 function prints its parameters to stdout. */
10547 ";
10548
10549   let test0, tests =
10550     match test_functions with
10551     | [] -> assert false
10552     | test0 :: tests -> test0, tests in
10553
10554   let () =
10555     let (name, style, _, _, _, _, _) = test0 in
10556     generate_prototype ~extern:false ~semicolon:false ~newline:true
10557       ~handle:"g" ~prefix:"guestfs__" name style;
10558     pr "{\n";
10559     List.iter (
10560       function
10561       | Pathname n
10562       | Device n | Dev_or_Path n
10563       | String n
10564       | FileIn n
10565       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10566       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10567       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10568       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10569       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10570       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10571     ) (snd style);
10572     pr "  /* Java changes stdout line buffering so we need this: */\n";
10573     pr "  fflush (stdout);\n";
10574     pr "  return 0;\n";
10575     pr "}\n";
10576     pr "\n" in
10577
10578   List.iter (
10579     fun (name, style, _, _, _, _, _) ->
10580       if String.sub name (String.length name - 3) 3 <> "err" then (
10581         pr "/* Test normal return. */\n";
10582         generate_prototype ~extern:false ~semicolon:false ~newline:true
10583           ~handle:"g" ~prefix:"guestfs__" name style;
10584         pr "{\n";
10585         (match fst style with
10586          | RErr ->
10587              pr "  return 0;\n"
10588          | RInt _ ->
10589              pr "  int r;\n";
10590              pr "  sscanf (val, \"%%d\", &r);\n";
10591              pr "  return r;\n"
10592          | RInt64 _ ->
10593              pr "  int64_t r;\n";
10594              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10595              pr "  return r;\n"
10596          | RBool _ ->
10597              pr "  return STREQ (val, \"true\");\n"
10598          | RConstString _
10599          | RConstOptString _ ->
10600              (* Can't return the input string here.  Return a static
10601               * string so we ensure we get a segfault if the caller
10602               * tries to free it.
10603               *)
10604              pr "  return \"static string\";\n"
10605          | RString _ ->
10606              pr "  return strdup (val);\n"
10607          | RStringList _ ->
10608              pr "  char **strs;\n";
10609              pr "  int n, i;\n";
10610              pr "  sscanf (val, \"%%d\", &n);\n";
10611              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10612              pr "  for (i = 0; i < n; ++i) {\n";
10613              pr "    strs[i] = safe_malloc (g, 16);\n";
10614              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10615              pr "  }\n";
10616              pr "  strs[n] = NULL;\n";
10617              pr "  return strs;\n"
10618          | RStruct (_, typ) ->
10619              pr "  struct guestfs_%s *r;\n" typ;
10620              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10621              pr "  return r;\n"
10622          | RStructList (_, typ) ->
10623              pr "  struct guestfs_%s_list *r;\n" typ;
10624              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10625              pr "  sscanf (val, \"%%d\", &r->len);\n";
10626              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10627              pr "  return r;\n"
10628          | RHashtable _ ->
10629              pr "  char **strs;\n";
10630              pr "  int n, i;\n";
10631              pr "  sscanf (val, \"%%d\", &n);\n";
10632              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10633              pr "  for (i = 0; i < n; ++i) {\n";
10634              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10635              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10636              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10637              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10638              pr "  }\n";
10639              pr "  strs[n*2] = NULL;\n";
10640              pr "  return strs;\n"
10641          | RBufferOut _ ->
10642              pr "  return strdup (val);\n"
10643         );
10644         pr "}\n";
10645         pr "\n"
10646       ) else (
10647         pr "/* Test error return. */\n";
10648         generate_prototype ~extern:false ~semicolon:false ~newline:true
10649           ~handle:"g" ~prefix:"guestfs__" name style;
10650         pr "{\n";
10651         pr "  error (g, \"error\");\n";
10652         (match fst style with
10653          | RErr | RInt _ | RInt64 _ | RBool _ ->
10654              pr "  return -1;\n"
10655          | RConstString _ | RConstOptString _
10656          | RString _ | RStringList _ | RStruct _
10657          | RStructList _
10658          | RHashtable _
10659          | RBufferOut _ ->
10660              pr "  return NULL;\n"
10661         );
10662         pr "}\n";
10663         pr "\n"
10664       )
10665   ) tests
10666
10667 and generate_ocaml_bindtests () =
10668   generate_header OCamlStyle GPLv2plus;
10669
10670   pr "\
10671 let () =
10672   let g = Guestfs.create () in
10673 ";
10674
10675   let mkargs args =
10676     String.concat " " (
10677       List.map (
10678         function
10679         | CallString s -> "\"" ^ s ^ "\""
10680         | CallOptString None -> "None"
10681         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10682         | CallStringList xs ->
10683             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10684         | CallInt i when i >= 0 -> string_of_int i
10685         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10686         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10687         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10688         | CallBool b -> string_of_bool b
10689       ) args
10690     )
10691   in
10692
10693   generate_lang_bindtests (
10694     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10695   );
10696
10697   pr "print_endline \"EOF\"\n"
10698
10699 and generate_perl_bindtests () =
10700   pr "#!/usr/bin/perl -w\n";
10701   generate_header HashStyle GPLv2plus;
10702
10703   pr "\
10704 use strict;
10705
10706 use Sys::Guestfs;
10707
10708 my $g = Sys::Guestfs->new ();
10709 ";
10710
10711   let mkargs args =
10712     String.concat ", " (
10713       List.map (
10714         function
10715         | CallString s -> "\"" ^ s ^ "\""
10716         | CallOptString None -> "undef"
10717         | CallOptString (Some s) -> sprintf "\"%s\"" s
10718         | CallStringList xs ->
10719             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10720         | CallInt i -> string_of_int i
10721         | CallInt64 i -> Int64.to_string i
10722         | CallBool b -> if b then "1" else "0"
10723       ) args
10724     )
10725   in
10726
10727   generate_lang_bindtests (
10728     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10729   );
10730
10731   pr "print \"EOF\\n\"\n"
10732
10733 and generate_python_bindtests () =
10734   generate_header HashStyle GPLv2plus;
10735
10736   pr "\
10737 import guestfs
10738
10739 g = guestfs.GuestFS ()
10740 ";
10741
10742   let mkargs args =
10743     String.concat ", " (
10744       List.map (
10745         function
10746         | CallString s -> "\"" ^ s ^ "\""
10747         | CallOptString None -> "None"
10748         | CallOptString (Some s) -> sprintf "\"%s\"" s
10749         | CallStringList xs ->
10750             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10751         | CallInt i -> string_of_int i
10752         | CallInt64 i -> Int64.to_string i
10753         | CallBool b -> if b then "1" else "0"
10754       ) args
10755     )
10756   in
10757
10758   generate_lang_bindtests (
10759     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10760   );
10761
10762   pr "print \"EOF\"\n"
10763
10764 and generate_ruby_bindtests () =
10765   generate_header HashStyle GPLv2plus;
10766
10767   pr "\
10768 require 'guestfs'
10769
10770 g = Guestfs::create()
10771 ";
10772
10773   let mkargs args =
10774     String.concat ", " (
10775       List.map (
10776         function
10777         | CallString s -> "\"" ^ s ^ "\""
10778         | CallOptString None -> "nil"
10779         | CallOptString (Some s) -> sprintf "\"%s\"" s
10780         | CallStringList xs ->
10781             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10782         | CallInt i -> string_of_int i
10783         | CallInt64 i -> Int64.to_string i
10784         | CallBool b -> string_of_bool b
10785       ) args
10786     )
10787   in
10788
10789   generate_lang_bindtests (
10790     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10791   );
10792
10793   pr "print \"EOF\\n\"\n"
10794
10795 and generate_java_bindtests () =
10796   generate_header CStyle GPLv2plus;
10797
10798   pr "\
10799 import com.redhat.et.libguestfs.*;
10800
10801 public class Bindtests {
10802     public static void main (String[] argv)
10803     {
10804         try {
10805             GuestFS g = new GuestFS ();
10806 ";
10807
10808   let mkargs args =
10809     String.concat ", " (
10810       List.map (
10811         function
10812         | CallString s -> "\"" ^ s ^ "\""
10813         | CallOptString None -> "null"
10814         | CallOptString (Some s) -> sprintf "\"%s\"" s
10815         | CallStringList xs ->
10816             "new String[]{" ^
10817               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10818         | CallInt i -> string_of_int i
10819         | CallInt64 i -> Int64.to_string i
10820         | CallBool b -> string_of_bool b
10821       ) args
10822     )
10823   in
10824
10825   generate_lang_bindtests (
10826     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10827   );
10828
10829   pr "
10830             System.out.println (\"EOF\");
10831         }
10832         catch (Exception exn) {
10833             System.err.println (exn);
10834             System.exit (1);
10835         }
10836     }
10837 }
10838 "
10839
10840 and generate_haskell_bindtests () =
10841   generate_header HaskellStyle GPLv2plus;
10842
10843   pr "\
10844 module Bindtests where
10845 import qualified Guestfs
10846
10847 main = do
10848   g <- Guestfs.create
10849 ";
10850
10851   let mkargs args =
10852     String.concat " " (
10853       List.map (
10854         function
10855         | CallString s -> "\"" ^ s ^ "\""
10856         | CallOptString None -> "Nothing"
10857         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10858         | CallStringList xs ->
10859             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10860         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10861         | CallInt i -> string_of_int i
10862         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10863         | CallInt64 i -> Int64.to_string i
10864         | CallBool true -> "True"
10865         | CallBool false -> "False"
10866       ) args
10867     )
10868   in
10869
10870   generate_lang_bindtests (
10871     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10872   );
10873
10874   pr "  putStrLn \"EOF\"\n"
10875
10876 (* Language-independent bindings tests - we do it this way to
10877  * ensure there is parity in testing bindings across all languages.
10878  *)
10879 and generate_lang_bindtests call =
10880   call "test0" [CallString "abc"; CallOptString (Some "def");
10881                 CallStringList []; CallBool false;
10882                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10883   call "test0" [CallString "abc"; CallOptString None;
10884                 CallStringList []; CallBool false;
10885                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10886   call "test0" [CallString ""; CallOptString (Some "def");
10887                 CallStringList []; CallBool false;
10888                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10889   call "test0" [CallString ""; CallOptString (Some "");
10890                 CallStringList []; CallBool false;
10891                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10892   call "test0" [CallString "abc"; CallOptString (Some "def");
10893                 CallStringList ["1"]; CallBool false;
10894                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10895   call "test0" [CallString "abc"; CallOptString (Some "def");
10896                 CallStringList ["1"; "2"]; CallBool false;
10897                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10898   call "test0" [CallString "abc"; CallOptString (Some "def");
10899                 CallStringList ["1"]; CallBool true;
10900                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10901   call "test0" [CallString "abc"; CallOptString (Some "def");
10902                 CallStringList ["1"]; CallBool false;
10903                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
10904   call "test0" [CallString "abc"; CallOptString (Some "def");
10905                 CallStringList ["1"]; CallBool false;
10906                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
10907   call "test0" [CallString "abc"; CallOptString (Some "def");
10908                 CallStringList ["1"]; CallBool false;
10909                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
10910   call "test0" [CallString "abc"; CallOptString (Some "def");
10911                 CallStringList ["1"]; CallBool false;
10912                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
10913   call "test0" [CallString "abc"; CallOptString (Some "def");
10914                 CallStringList ["1"]; CallBool false;
10915                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
10916   call "test0" [CallString "abc"; CallOptString (Some "def");
10917                 CallStringList ["1"]; CallBool false;
10918                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
10919
10920 (* XXX Add here tests of the return and error functions. *)
10921
10922 (* Code to generator bindings for virt-inspector.  Currently only
10923  * implemented for OCaml code (for virt-p2v 2.0).
10924  *)
10925 let rng_input = "inspector/virt-inspector.rng"
10926
10927 (* Read the input file and parse it into internal structures.  This is
10928  * by no means a complete RELAX NG parser, but is just enough to be
10929  * able to parse the specific input file.
10930  *)
10931 type rng =
10932   | Element of string * rng list        (* <element name=name/> *)
10933   | Attribute of string * rng list        (* <attribute name=name/> *)
10934   | Interleave of rng list                (* <interleave/> *)
10935   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
10936   | OneOrMore of rng                        (* <oneOrMore/> *)
10937   | Optional of rng                        (* <optional/> *)
10938   | Choice of string list                (* <choice><value/>*</choice> *)
10939   | Value of string                        (* <value>str</value> *)
10940   | Text                                (* <text/> *)
10941
10942 let rec string_of_rng = function
10943   | Element (name, xs) ->
10944       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
10945   | Attribute (name, xs) ->
10946       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
10947   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
10948   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
10949   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
10950   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
10951   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
10952   | Value value -> "Value \"" ^ value ^ "\""
10953   | Text -> "Text"
10954
10955 and string_of_rng_list xs =
10956   String.concat ", " (List.map string_of_rng xs)
10957
10958 let rec parse_rng ?defines context = function
10959   | [] -> []
10960   | Xml.Element ("element", ["name", name], children) :: rest ->
10961       Element (name, parse_rng ?defines context children)
10962       :: parse_rng ?defines context rest
10963   | Xml.Element ("attribute", ["name", name], children) :: rest ->
10964       Attribute (name, parse_rng ?defines context children)
10965       :: parse_rng ?defines context rest
10966   | Xml.Element ("interleave", [], children) :: rest ->
10967       Interleave (parse_rng ?defines context children)
10968       :: parse_rng ?defines context rest
10969   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
10970       let rng = parse_rng ?defines context [child] in
10971       (match rng with
10972        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
10973        | _ ->
10974            failwithf "%s: <zeroOrMore> contains more than one child element"
10975              context
10976       )
10977   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
10978       let rng = parse_rng ?defines context [child] in
10979       (match rng with
10980        | [child] -> OneOrMore child :: parse_rng ?defines context rest
10981        | _ ->
10982            failwithf "%s: <oneOrMore> contains more than one child element"
10983              context
10984       )
10985   | Xml.Element ("optional", [], [child]) :: rest ->
10986       let rng = parse_rng ?defines context [child] in
10987       (match rng with
10988        | [child] -> Optional child :: parse_rng ?defines context rest
10989        | _ ->
10990            failwithf "%s: <optional> contains more than one child element"
10991              context
10992       )
10993   | Xml.Element ("choice", [], children) :: rest ->
10994       let values = List.map (
10995         function Xml.Element ("value", [], [Xml.PCData value]) -> value
10996         | _ ->
10997             failwithf "%s: can't handle anything except <value> in <choice>"
10998               context
10999       ) children in
11000       Choice values
11001       :: parse_rng ?defines context rest
11002   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11003       Value value :: parse_rng ?defines context rest
11004   | Xml.Element ("text", [], []) :: rest ->
11005       Text :: parse_rng ?defines context rest
11006   | Xml.Element ("ref", ["name", name], []) :: rest ->
11007       (* Look up the reference.  Because of limitations in this parser,
11008        * we can't handle arbitrarily nested <ref> yet.  You can only
11009        * use <ref> from inside <start>.
11010        *)
11011       (match defines with
11012        | None ->
11013            failwithf "%s: contains <ref>, but no refs are defined yet" context
11014        | Some map ->
11015            let rng = StringMap.find name map in
11016            rng @ parse_rng ?defines context rest
11017       )
11018   | x :: _ ->
11019       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11020
11021 let grammar =
11022   let xml = Xml.parse_file rng_input in
11023   match xml with
11024   | Xml.Element ("grammar", _,
11025                  Xml.Element ("start", _, gram) :: defines) ->
11026       (* The <define/> elements are referenced in the <start> section,
11027        * so build a map of those first.
11028        *)
11029       let defines = List.fold_left (
11030         fun map ->
11031           function Xml.Element ("define", ["name", name], defn) ->
11032             StringMap.add name defn map
11033           | _ ->
11034               failwithf "%s: expected <define name=name/>" rng_input
11035       ) StringMap.empty defines in
11036       let defines = StringMap.mapi parse_rng defines in
11037
11038       (* Parse the <start> clause, passing the defines. *)
11039       parse_rng ~defines "<start>" gram
11040   | _ ->
11041       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11042         rng_input
11043
11044 let name_of_field = function
11045   | Element (name, _) | Attribute (name, _)
11046   | ZeroOrMore (Element (name, _))
11047   | OneOrMore (Element (name, _))
11048   | Optional (Element (name, _)) -> name
11049   | Optional (Attribute (name, _)) -> name
11050   | Text -> (* an unnamed field in an element *)
11051       "data"
11052   | rng ->
11053       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11054
11055 (* At the moment this function only generates OCaml types.  However we
11056  * should parameterize it later so it can generate types/structs in a
11057  * variety of languages.
11058  *)
11059 let generate_types xs =
11060   (* A simple type is one that can be printed out directly, eg.
11061    * "string option".  A complex type is one which has a name and has
11062    * to be defined via another toplevel definition, eg. a struct.
11063    *
11064    * generate_type generates code for either simple or complex types.
11065    * In the simple case, it returns the string ("string option").  In
11066    * the complex case, it returns the name ("mountpoint").  In the
11067    * complex case it has to print out the definition before returning,
11068    * so it should only be called when we are at the beginning of a
11069    * new line (BOL context).
11070    *)
11071   let rec generate_type = function
11072     | Text ->                                (* string *)
11073         "string", true
11074     | Choice values ->                        (* [`val1|`val2|...] *)
11075         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11076     | ZeroOrMore rng ->                        (* <rng> list *)
11077         let t, is_simple = generate_type rng in
11078         t ^ " list (* 0 or more *)", is_simple
11079     | OneOrMore rng ->                        (* <rng> list *)
11080         let t, is_simple = generate_type rng in
11081         t ^ " list (* 1 or more *)", is_simple
11082                                         (* virt-inspector hack: bool *)
11083     | Optional (Attribute (name, [Value "1"])) ->
11084         "bool", true
11085     | Optional rng ->                        (* <rng> list *)
11086         let t, is_simple = generate_type rng in
11087         t ^ " option", is_simple
11088                                         (* type name = { fields ... } *)
11089     | Element (name, fields) when is_attrs_interleave fields ->
11090         generate_type_struct name (get_attrs_interleave fields)
11091     | Element (name, [field])                (* type name = field *)
11092     | Attribute (name, [field]) ->
11093         let t, is_simple = generate_type field in
11094         if is_simple then (t, true)
11095         else (
11096           pr "type %s = %s\n" name t;
11097           name, false
11098         )
11099     | Element (name, fields) ->              (* type name = { fields ... } *)
11100         generate_type_struct name fields
11101     | rng ->
11102         failwithf "generate_type failed at: %s" (string_of_rng rng)
11103
11104   and is_attrs_interleave = function
11105     | [Interleave _] -> true
11106     | Attribute _ :: fields -> is_attrs_interleave fields
11107     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11108     | _ -> false
11109
11110   and get_attrs_interleave = function
11111     | [Interleave fields] -> fields
11112     | ((Attribute _) as field) :: fields
11113     | ((Optional (Attribute _)) as field) :: fields ->
11114         field :: get_attrs_interleave fields
11115     | _ -> assert false
11116
11117   and generate_types xs =
11118     List.iter (fun x -> ignore (generate_type x)) xs
11119
11120   and generate_type_struct name fields =
11121     (* Calculate the types of the fields first.  We have to do this
11122      * before printing anything so we are still in BOL context.
11123      *)
11124     let types = List.map fst (List.map generate_type fields) in
11125
11126     (* Special case of a struct containing just a string and another
11127      * field.  Turn it into an assoc list.
11128      *)
11129     match types with
11130     | ["string"; other] ->
11131         let fname1, fname2 =
11132           match fields with
11133           | [f1; f2] -> name_of_field f1, name_of_field f2
11134           | _ -> assert false in
11135         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11136         name, false
11137
11138     | types ->
11139         pr "type %s = {\n" name;
11140         List.iter (
11141           fun (field, ftype) ->
11142             let fname = name_of_field field in
11143             pr "  %s_%s : %s;\n" name fname ftype
11144         ) (List.combine fields types);
11145         pr "}\n";
11146         (* Return the name of this type, and
11147          * false because it's not a simple type.
11148          *)
11149         name, false
11150   in
11151
11152   generate_types xs
11153
11154 let generate_parsers xs =
11155   (* As for generate_type above, generate_parser makes a parser for
11156    * some type, and returns the name of the parser it has generated.
11157    * Because it (may) need to print something, it should always be
11158    * called in BOL context.
11159    *)
11160   let rec generate_parser = function
11161     | Text ->                                (* string *)
11162         "string_child_or_empty"
11163     | Choice values ->                        (* [`val1|`val2|...] *)
11164         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11165           (String.concat "|"
11166              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11167     | ZeroOrMore rng ->                        (* <rng> list *)
11168         let pa = generate_parser rng in
11169         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11170     | OneOrMore rng ->                        (* <rng> list *)
11171         let pa = generate_parser rng in
11172         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11173                                         (* virt-inspector hack: bool *)
11174     | Optional (Attribute (name, [Value "1"])) ->
11175         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11176     | Optional rng ->                        (* <rng> list *)
11177         let pa = generate_parser rng in
11178         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11179                                         (* type name = { fields ... } *)
11180     | Element (name, fields) when is_attrs_interleave fields ->
11181         generate_parser_struct name (get_attrs_interleave fields)
11182     | Element (name, [field]) ->        (* type name = field *)
11183         let pa = generate_parser field in
11184         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11185         pr "let %s =\n" parser_name;
11186         pr "  %s\n" pa;
11187         pr "let parse_%s = %s\n" name parser_name;
11188         parser_name
11189     | Attribute (name, [field]) ->
11190         let pa = generate_parser field in
11191         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11192         pr "let %s =\n" parser_name;
11193         pr "  %s\n" pa;
11194         pr "let parse_%s = %s\n" name parser_name;
11195         parser_name
11196     | Element (name, fields) ->              (* type name = { fields ... } *)
11197         generate_parser_struct name ([], fields)
11198     | rng ->
11199         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11200
11201   and is_attrs_interleave = function
11202     | [Interleave _] -> true
11203     | Attribute _ :: fields -> is_attrs_interleave fields
11204     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11205     | _ -> false
11206
11207   and get_attrs_interleave = function
11208     | [Interleave fields] -> [], fields
11209     | ((Attribute _) as field) :: fields
11210     | ((Optional (Attribute _)) as field) :: fields ->
11211         let attrs, interleaves = get_attrs_interleave fields in
11212         (field :: attrs), interleaves
11213     | _ -> assert false
11214
11215   and generate_parsers xs =
11216     List.iter (fun x -> ignore (generate_parser x)) xs
11217
11218   and generate_parser_struct name (attrs, interleaves) =
11219     (* Generate parsers for the fields first.  We have to do this
11220      * before printing anything so we are still in BOL context.
11221      *)
11222     let fields = attrs @ interleaves in
11223     let pas = List.map generate_parser fields in
11224
11225     (* Generate an intermediate tuple from all the fields first.
11226      * If the type is just a string + another field, then we will
11227      * return this directly, otherwise it is turned into a record.
11228      *
11229      * RELAX NG note: This code treats <interleave> and plain lists of
11230      * fields the same.  In other words, it doesn't bother enforcing
11231      * any ordering of fields in the XML.
11232      *)
11233     pr "let parse_%s x =\n" name;
11234     pr "  let t = (\n    ";
11235     let comma = ref false in
11236     List.iter (
11237       fun x ->
11238         if !comma then pr ",\n    ";
11239         comma := true;
11240         match x with
11241         | Optional (Attribute (fname, [field])), pa ->
11242             pr "%s x" pa
11243         | Optional (Element (fname, [field])), pa ->
11244             pr "%s (optional_child %S x)" pa fname
11245         | Attribute (fname, [Text]), _ ->
11246             pr "attribute %S x" fname
11247         | (ZeroOrMore _ | OneOrMore _), pa ->
11248             pr "%s x" pa
11249         | Text, pa ->
11250             pr "%s x" pa
11251         | (field, pa) ->
11252             let fname = name_of_field field in
11253             pr "%s (child %S x)" pa fname
11254     ) (List.combine fields pas);
11255     pr "\n  ) in\n";
11256
11257     (match fields with
11258      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11259          pr "  t\n"
11260
11261      | _ ->
11262          pr "  (Obj.magic t : %s)\n" name
11263 (*
11264          List.iter (
11265            function
11266            | (Optional (Attribute (fname, [field])), pa) ->
11267                pr "  %s_%s =\n" name fname;
11268                pr "    %s x;\n" pa
11269            | (Optional (Element (fname, [field])), pa) ->
11270                pr "  %s_%s =\n" name fname;
11271                pr "    (let x = optional_child %S x in\n" fname;
11272                pr "     %s x);\n" pa
11273            | (field, pa) ->
11274                let fname = name_of_field field in
11275                pr "  %s_%s =\n" name fname;
11276                pr "    (let x = child %S x in\n" fname;
11277                pr "     %s x);\n" pa
11278          ) (List.combine fields pas);
11279          pr "}\n"
11280 *)
11281     );
11282     sprintf "parse_%s" name
11283   in
11284
11285   generate_parsers xs
11286
11287 (* Generate ocaml/guestfs_inspector.mli. *)
11288 let generate_ocaml_inspector_mli () =
11289   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11290
11291   pr "\
11292 (** This is an OCaml language binding to the external [virt-inspector]
11293     program.
11294
11295     For more information, please read the man page [virt-inspector(1)].
11296 *)
11297
11298 ";
11299
11300   generate_types grammar;
11301   pr "(** The nested information returned from the {!inspect} function. *)\n";
11302   pr "\n";
11303
11304   pr "\
11305 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11306 (** To inspect a libvirt domain called [name], pass a singleton
11307     list: [inspect [name]].  When using libvirt only, you may
11308     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11309
11310     To inspect a disk image or images, pass a list of the filenames
11311     of the disk images: [inspect filenames]
11312
11313     This function inspects the given guest or disk images and
11314     returns a list of operating system(s) found and a large amount
11315     of information about them.  In the vast majority of cases,
11316     a virtual machine only contains a single operating system.
11317
11318     If the optional [~xml] parameter is given, then this function
11319     skips running the external virt-inspector program and just
11320     parses the given XML directly (which is expected to be XML
11321     produced from a previous run of virt-inspector).  The list of
11322     names and connect URI are ignored in this case.
11323
11324     This function can throw a wide variety of exceptions, for example
11325     if the external virt-inspector program cannot be found, or if
11326     it doesn't generate valid XML.
11327 *)
11328 "
11329
11330 (* Generate ocaml/guestfs_inspector.ml. *)
11331 let generate_ocaml_inspector_ml () =
11332   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11333
11334   pr "open Unix\n";
11335   pr "\n";
11336
11337   generate_types grammar;
11338   pr "\n";
11339
11340   pr "\
11341 (* Misc functions which are used by the parser code below. *)
11342 let first_child = function
11343   | Xml.Element (_, _, c::_) -> c
11344   | Xml.Element (name, _, []) ->
11345       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11346   | Xml.PCData str ->
11347       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11348
11349 let string_child_or_empty = function
11350   | Xml.Element (_, _, [Xml.PCData s]) -> s
11351   | Xml.Element (_, _, []) -> \"\"
11352   | Xml.Element (x, _, _) ->
11353       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11354                 x ^ \" instead\")
11355   | Xml.PCData str ->
11356       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11357
11358 let optional_child name xml =
11359   let children = Xml.children xml in
11360   try
11361     Some (List.find (function
11362                      | Xml.Element (n, _, _) when n = name -> true
11363                      | _ -> false) children)
11364   with
11365     Not_found -> None
11366
11367 let child name xml =
11368   match optional_child name xml with
11369   | Some c -> c
11370   | None ->
11371       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11372
11373 let attribute name xml =
11374   try Xml.attrib xml name
11375   with Xml.No_attribute _ ->
11376     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11377
11378 ";
11379
11380   generate_parsers grammar;
11381   pr "\n";
11382
11383   pr "\
11384 (* Run external virt-inspector, then use parser to parse the XML. *)
11385 let inspect ?connect ?xml names =
11386   let xml =
11387     match xml with
11388     | None ->
11389         if names = [] then invalid_arg \"inspect: no names given\";
11390         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11391           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11392           names in
11393         let cmd = List.map Filename.quote cmd in
11394         let cmd = String.concat \" \" cmd in
11395         let chan = open_process_in cmd in
11396         let xml = Xml.parse_in chan in
11397         (match close_process_in chan with
11398          | WEXITED 0 -> ()
11399          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11400          | WSIGNALED i | WSTOPPED i ->
11401              failwith (\"external virt-inspector command died or stopped on sig \" ^
11402                        string_of_int i)
11403         );
11404         xml
11405     | Some doc ->
11406         Xml.parse_string doc in
11407   parse_operatingsystems xml
11408 "
11409
11410 (* This is used to generate the src/MAX_PROC_NR file which
11411  * contains the maximum procedure number, a surrogate for the
11412  * ABI version number.  See src/Makefile.am for the details.
11413  *)
11414 and generate_max_proc_nr () =
11415   let proc_nrs = List.map (
11416     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11417   ) daemon_functions in
11418
11419   let max_proc_nr = List.fold_left max 0 proc_nrs in
11420
11421   pr "%d\n" max_proc_nr
11422
11423 let output_to filename k =
11424   let filename_new = filename ^ ".new" in
11425   chan := open_out filename_new;
11426   k ();
11427   close_out !chan;
11428   chan := Pervasives.stdout;
11429
11430   (* Is the new file different from the current file? *)
11431   if Sys.file_exists filename && files_equal filename filename_new then
11432     unlink filename_new                 (* same, so skip it *)
11433   else (
11434     (* different, overwrite old one *)
11435     (try chmod filename 0o644 with Unix_error _ -> ());
11436     rename filename_new filename;
11437     chmod filename 0o444;
11438     printf "written %s\n%!" filename;
11439   )
11440
11441 let perror msg = function
11442   | Unix_error (err, _, _) ->
11443       eprintf "%s: %s\n" msg (error_message err)
11444   | exn ->
11445       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11446
11447 (* Main program. *)
11448 let () =
11449   let lock_fd =
11450     try openfile "HACKING" [O_RDWR] 0
11451     with
11452     | Unix_error (ENOENT, _, _) ->
11453         eprintf "\
11454 You are probably running this from the wrong directory.
11455 Run it from the top source directory using the command
11456   src/generator.ml
11457 ";
11458         exit 1
11459     | exn ->
11460         perror "open: HACKING" exn;
11461         exit 1 in
11462
11463   (* Acquire a lock so parallel builds won't try to run the generator
11464    * twice at the same time.  Subsequent builds will wait for the first
11465    * one to finish.  Note the lock is released implicitly when the
11466    * program exits.
11467    *)
11468   (try lockf lock_fd F_LOCK 1
11469    with exn ->
11470      perror "lock: HACKING" exn;
11471      exit 1);
11472
11473   check_functions ();
11474
11475   output_to "src/guestfs_protocol.x" generate_xdr;
11476   output_to "src/guestfs-structs.h" generate_structs_h;
11477   output_to "src/guestfs-actions.h" generate_actions_h;
11478   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11479   output_to "src/guestfs-actions.c" generate_client_actions;
11480   output_to "src/guestfs-bindtests.c" generate_bindtests;
11481   output_to "src/guestfs-structs.pod" generate_structs_pod;
11482   output_to "src/guestfs-actions.pod" generate_actions_pod;
11483   output_to "src/guestfs-availability.pod" generate_availability_pod;
11484   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11485   output_to "src/libguestfs.syms" generate_linker_script;
11486   output_to "daemon/actions.h" generate_daemon_actions_h;
11487   output_to "daemon/stubs.c" generate_daemon_actions;
11488   output_to "daemon/names.c" generate_daemon_names;
11489   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11490   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11491   output_to "capitests/tests.c" generate_tests;
11492   output_to "fish/cmds.c" generate_fish_cmds;
11493   output_to "fish/completion.c" generate_fish_completion;
11494   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11495   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11496   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11497   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11498   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11499   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11500   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11501   output_to "perl/Guestfs.xs" generate_perl_xs;
11502   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11503   output_to "perl/bindtests.pl" generate_perl_bindtests;
11504   output_to "python/guestfs-py.c" generate_python_c;
11505   output_to "python/guestfs.py" generate_python_py;
11506   output_to "python/bindtests.py" generate_python_bindtests;
11507   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11508   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11509   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11510
11511   List.iter (
11512     fun (typ, jtyp) ->
11513       let cols = cols_of_struct typ in
11514       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11515       output_to filename (generate_java_struct jtyp cols);
11516   ) java_structs;
11517
11518   output_to "java/Makefile.inc" generate_java_makefile_inc;
11519   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11520   output_to "java/Bindtests.java" generate_java_bindtests;
11521   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11522   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11523   output_to "csharp/Libguestfs.cs" generate_csharp;
11524
11525   (* Always generate this file last, and unconditionally.  It's used
11526    * by the Makefile to know when we must re-run the generator.
11527    *)
11528   let chan = open_out "src/stamp-generator" in
11529   fprintf chan "1\n";
11530   close_out chan;
11531
11532   printf "generated %d lines of code\n" !lines