generator: Fix incorrect shortdesc in docs for 'is-dir' command.
[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     (* Run the test only if 'string' is available in the daemon. *)
311   | IfAvailable of string
312
313 (* Some initial scenarios for testing. *)
314 and test_init =
315     (* Do nothing, block devices could contain random stuff including
316      * LVM PVs, and some filesystems might be mounted.  This is usually
317      * a bad idea.
318      *)
319   | InitNone
320
321     (* Block devices are empty and no filesystems are mounted. *)
322   | InitEmpty
323
324     (* /dev/sda contains a single partition /dev/sda1, with random
325      * content.  /dev/sdb and /dev/sdc may have random content.
326      * No LVM.
327      *)
328   | InitPartition
329
330     (* /dev/sda contains a single partition /dev/sda1, which is formatted
331      * as ext2, empty [except for lost+found] and mounted on /.
332      * /dev/sdb and /dev/sdc may have random content.
333      * No LVM.
334      *)
335   | InitBasicFS
336
337     (* /dev/sda:
338      *   /dev/sda1 (is a PV):
339      *     /dev/VG/LV (size 8MB):
340      *       formatted as ext2, empty [except for lost+found], mounted on /
341      * /dev/sdb and /dev/sdc may have random content.
342      *)
343   | InitBasicFSonLVM
344
345     (* /dev/sdd (the ISO, see images/ directory in source)
346      * is mounted on /
347      *)
348   | InitISOFS
349
350 (* Sequence of commands for testing. *)
351 and seq = cmd list
352 and cmd = string list
353
354 (* Note about long descriptions: When referring to another
355  * action, use the format C<guestfs_other> (ie. the full name of
356  * the C function).  This will be replaced as appropriate in other
357  * language bindings.
358  *
359  * Apart from that, long descriptions are just perldoc paragraphs.
360  *)
361
362 (* Generate a random UUID (used in tests). *)
363 let uuidgen () =
364   let chan = open_process_in "uuidgen" in
365   let uuid = input_line chan in
366   (match close_process_in chan with
367    | WEXITED 0 -> ()
368    | WEXITED _ ->
369        failwith "uuidgen: process exited with non-zero status"
370    | WSIGNALED _ | WSTOPPED _ ->
371        failwith "uuidgen: process signalled or stopped by signal"
372   );
373   uuid
374
375 (* These test functions are used in the language binding tests. *)
376
377 let test_all_args = [
378   String "str";
379   OptString "optstr";
380   StringList "strlist";
381   Bool "b";
382   Int "integer";
383   Int64 "integer64";
384   FileIn "filein";
385   FileOut "fileout";
386 ]
387
388 let test_all_rets = [
389   (* except for RErr, which is tested thoroughly elsewhere *)
390   "test0rint",         RInt "valout";
391   "test0rint64",       RInt64 "valout";
392   "test0rbool",        RBool "valout";
393   "test0rconststring", RConstString "valout";
394   "test0rconstoptstring", RConstOptString "valout";
395   "test0rstring",      RString "valout";
396   "test0rstringlist",  RStringList "valout";
397   "test0rstruct",      RStruct ("valout", "lvm_pv");
398   "test0rstructlist",  RStructList ("valout", "lvm_pv");
399   "test0rhashtable",   RHashtable "valout";
400 ]
401
402 let test_functions = [
403   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
404    [],
405    "internal test function - do not use",
406    "\
407 This is an internal test function which is used to test whether
408 the automatically generated bindings can handle every possible
409 parameter type correctly.
410
411 It echos the contents of each parameter to stdout.
412
413 You probably don't want to call this function.");
414 ] @ List.flatten (
415   List.map (
416     fun (name, ret) ->
417       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
418         [],
419         "internal test function - do not use",
420         "\
421 This is an internal test function which is used to test whether
422 the automatically generated bindings can handle every possible
423 return type correctly.
424
425 It converts string C<val> to the return type.
426
427 You probably don't want to call this function.");
428        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
429         [],
430         "internal test function - do not use",
431         "\
432 This is an internal test function which is used to test whether
433 the automatically generated bindings can handle every possible
434 return type correctly.
435
436 This function always returns an error.
437
438 You probably don't want to call this function.")]
439   ) test_all_rets
440 )
441
442 (* non_daemon_functions are any functions which don't get processed
443  * in the daemon, eg. functions for setting and getting local
444  * configuration values.
445  *)
446
447 let non_daemon_functions = test_functions @ [
448   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
449    [],
450    "launch the qemu subprocess",
451    "\
452 Internally libguestfs is implemented by running a virtual machine
453 using L<qemu(1)>.
454
455 You should call this after configuring the handle
456 (eg. adding drives) but before performing any actions.");
457
458   ("wait_ready", (RErr, []), -1, [NotInFish],
459    [],
460    "wait until the qemu subprocess launches (no op)",
461    "\
462 This function is a no op.
463
464 In versions of the API E<lt> 1.0.71 you had to call this function
465 just after calling C<guestfs_launch> to wait for the launch
466 to complete.  However this is no longer necessary because
467 C<guestfs_launch> now does the waiting.
468
469 If you see any calls to this function in code then you can just
470 remove them, unless you want to retain compatibility with older
471 versions of the API.");
472
473   ("kill_subprocess", (RErr, []), -1, [],
474    [],
475    "kill the qemu subprocess",
476    "\
477 This kills the qemu subprocess.  You should never need to call this.");
478
479   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
480    [],
481    "add an image to examine or modify",
482    "\
483 This function adds a virtual machine disk image C<filename> to the
484 guest.  The first time you call this function, the disk appears as IDE
485 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
486 so on.
487
488 You don't necessarily need to be root when using libguestfs.  However
489 you obviously do need sufficient permissions to access the filename
490 for whatever operations you want to perform (ie. read access if you
491 just want to read the image or write access if you want to modify the
492 image).
493
494 This is equivalent to the qemu parameter
495 C<-drive file=filename,cache=off,if=...>.
496
497 C<cache=off> is omitted in cases where it is not supported by
498 the underlying filesystem.
499
500 C<if=...> is set at compile time by the configuration option
501 C<./configure --with-drive-if=...>.  In the rare case where you
502 might need to change this at run time, use C<guestfs_add_drive_with_if>
503 or C<guestfs_add_drive_ro_with_if>.
504
505 Note that this call checks for the existence of C<filename>.  This
506 stops you from specifying other types of drive which are supported
507 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
508 the general C<guestfs_config> call instead.");
509
510   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
511    [],
512    "add a CD-ROM disk image to examine",
513    "\
514 This function adds a virtual CD-ROM disk image to the guest.
515
516 This is equivalent to the qemu parameter C<-cdrom filename>.
517
518 Notes:
519
520 =over 4
521
522 =item *
523
524 This call checks for the existence of C<filename>.  This
525 stops you from specifying other types of drive which are supported
526 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
527 the general C<guestfs_config> call instead.
528
529 =item *
530
531 If you just want to add an ISO file (often you use this as an
532 efficient way to transfer large files into the guest), then you
533 should probably use C<guestfs_add_drive_ro> instead.
534
535 =back");
536
537   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
538    [],
539    "add a drive in snapshot mode (read-only)",
540    "\
541 This adds a drive in snapshot mode, making it effectively
542 read-only.
543
544 Note that writes to the device are allowed, and will be seen for
545 the duration of the guestfs handle, but they are written
546 to a temporary file which is discarded as soon as the guestfs
547 handle is closed.  We don't currently have any method to enable
548 changes to be committed, although qemu can support this.
549
550 This is equivalent to the qemu parameter
551 C<-drive file=filename,snapshot=on,if=...>.
552
553 C<if=...> is set at compile time by the configuration option
554 C<./configure --with-drive-if=...>.  In the rare case where you
555 might need to change this at run time, use C<guestfs_add_drive_with_if>
556 or C<guestfs_add_drive_ro_with_if>.
557
558 Note that this call checks for the existence of C<filename>.  This
559 stops you from specifying other types of drive which are supported
560 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
561 the general C<guestfs_config> call instead.");
562
563   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
564    [],
565    "add qemu parameters",
566    "\
567 This can be used to add arbitrary qemu command line parameters
568 of the form C<-param value>.  Actually it's not quite arbitrary - we
569 prevent you from setting some parameters which would interfere with
570 parameters that we use.
571
572 The first character of C<param> string must be a C<-> (dash).
573
574 C<value> can be NULL.");
575
576   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
577    [],
578    "set the qemu binary",
579    "\
580 Set the qemu binary that we will use.
581
582 The default is chosen when the library was compiled by the
583 configure script.
584
585 You can also override this by setting the C<LIBGUESTFS_QEMU>
586 environment variable.
587
588 Setting C<qemu> to C<NULL> restores the default qemu binary.
589
590 Note that you should call this function as early as possible
591 after creating the handle.  This is because some pre-launch
592 operations depend on testing qemu features (by running C<qemu -help>).
593 If the qemu binary changes, we don't retest features, and
594 so you might see inconsistent results.  Using the environment
595 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
596 the qemu binary at the same time as the handle is created.");
597
598   ("get_qemu", (RConstString "qemu", []), -1, [],
599    [InitNone, Always, TestRun (
600       [["get_qemu"]])],
601    "get the qemu binary",
602    "\
603 Return the current qemu binary.
604
605 This is always non-NULL.  If it wasn't set already, then this will
606 return the default qemu binary name.");
607
608   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
609    [],
610    "set the search path",
611    "\
612 Set the path that libguestfs searches for kernel and initrd.img.
613
614 The default is C<$libdir/guestfs> unless overridden by setting
615 C<LIBGUESTFS_PATH> environment variable.
616
617 Setting C<path> to C<NULL> restores the default path.");
618
619   ("get_path", (RConstString "path", []), -1, [],
620    [InitNone, Always, TestRun (
621       [["get_path"]])],
622    "get the search path",
623    "\
624 Return the current search path.
625
626 This is always non-NULL.  If it wasn't set already, then this will
627 return the default path.");
628
629   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
630    [],
631    "add options to kernel command line",
632    "\
633 This function is used to add additional options to the
634 guest kernel command line.
635
636 The default is C<NULL> unless overridden by setting
637 C<LIBGUESTFS_APPEND> environment variable.
638
639 Setting C<append> to C<NULL> means I<no> additional options
640 are passed (libguestfs always adds a few of its own).");
641
642   ("get_append", (RConstOptString "append", []), -1, [],
643    (* This cannot be tested with the current framework.  The
644     * function can return NULL in normal operations, which the
645     * test framework interprets as an error.
646     *)
647    [],
648    "get the additional kernel options",
649    "\
650 Return the additional kernel options which are added to the
651 guest kernel command line.
652
653 If C<NULL> then no options are added.");
654
655   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
656    [],
657    "set autosync mode",
658    "\
659 If C<autosync> is true, this enables autosync.  Libguestfs will make a
660 best effort attempt to run C<guestfs_umount_all> followed by
661 C<guestfs_sync> when the handle is closed
662 (also if the program exits without closing handles).
663
664 This is disabled by default (except in guestfish where it is
665 enabled by default).");
666
667   ("get_autosync", (RBool "autosync", []), -1, [],
668    [InitNone, Always, TestRun (
669       [["get_autosync"]])],
670    "get autosync mode",
671    "\
672 Get the autosync flag.");
673
674   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
675    [],
676    "set verbose mode",
677    "\
678 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
679
680 Verbose messages are disabled unless the environment variable
681 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
682
683   ("get_verbose", (RBool "verbose", []), -1, [],
684    [],
685    "get verbose mode",
686    "\
687 This returns the verbose messages flag.");
688
689   ("is_ready", (RBool "ready", []), -1, [],
690    [InitNone, Always, TestOutputTrue (
691       [["is_ready"]])],
692    "is ready to accept commands",
693    "\
694 This returns true iff this handle is ready to accept commands
695 (in the C<READY> state).
696
697 For more information on states, see L<guestfs(3)>.");
698
699   ("is_config", (RBool "config", []), -1, [],
700    [InitNone, Always, TestOutputFalse (
701       [["is_config"]])],
702    "is in configuration state",
703    "\
704 This returns true iff this handle is being configured
705 (in the C<CONFIG> state).
706
707 For more information on states, see L<guestfs(3)>.");
708
709   ("is_launching", (RBool "launching", []), -1, [],
710    [InitNone, Always, TestOutputFalse (
711       [["is_launching"]])],
712    "is launching subprocess",
713    "\
714 This returns true iff this handle is launching the subprocess
715 (in the C<LAUNCHING> state).
716
717 For more information on states, see L<guestfs(3)>.");
718
719   ("is_busy", (RBool "busy", []), -1, [],
720    [InitNone, Always, TestOutputFalse (
721       [["is_busy"]])],
722    "is busy processing a command",
723    "\
724 This returns true iff this handle is busy processing a command
725 (in the C<BUSY> state).
726
727 For more information on states, see L<guestfs(3)>.");
728
729   ("get_state", (RInt "state", []), -1, [],
730    [],
731    "get the current state",
732    "\
733 This returns the current state as an opaque integer.  This is
734 only useful for printing debug and internal error messages.
735
736 For more information on states, see L<guestfs(3)>.");
737
738   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
739    [InitNone, Always, TestOutputInt (
740       [["set_memsize"; "500"];
741        ["get_memsize"]], 500)],
742    "set memory allocated to the qemu subprocess",
743    "\
744 This sets the memory size in megabytes allocated to the
745 qemu subprocess.  This only has any effect if called before
746 C<guestfs_launch>.
747
748 You can also change this by setting the environment
749 variable C<LIBGUESTFS_MEMSIZE> before the handle is
750 created.
751
752 For more information on the architecture of libguestfs,
753 see L<guestfs(3)>.");
754
755   ("get_memsize", (RInt "memsize", []), -1, [],
756    [InitNone, Always, TestOutputIntOp (
757       [["get_memsize"]], ">=", 256)],
758    "get memory allocated to the qemu subprocess",
759    "\
760 This gets the memory size in megabytes allocated to the
761 qemu subprocess.
762
763 If C<guestfs_set_memsize> was not called
764 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
765 then this returns the compiled-in default value for memsize.
766
767 For more information on the architecture of libguestfs,
768 see L<guestfs(3)>.");
769
770   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
771    [InitNone, Always, TestOutputIntOp (
772       [["get_pid"]], ">=", 1)],
773    "get PID of qemu subprocess",
774    "\
775 Return the process ID of the qemu subprocess.  If there is no
776 qemu subprocess, then this will return an error.
777
778 This is an internal call used for debugging and testing.");
779
780   ("version", (RStruct ("version", "version"), []), -1, [],
781    [InitNone, Always, TestOutputStruct (
782       [["version"]], [CompareWithInt ("major", 1)])],
783    "get the library version number",
784    "\
785 Return the libguestfs version number that the program is linked
786 against.
787
788 Note that because of dynamic linking this is not necessarily
789 the version of libguestfs that you compiled against.  You can
790 compile the program, and then at runtime dynamically link
791 against a completely different C<libguestfs.so> library.
792
793 This call was added in version C<1.0.58>.  In previous
794 versions of libguestfs there was no way to get the version
795 number.  From C code you can use dynamic linker functions
796 to find out if this symbol exists (if it doesn't, then
797 it's an earlier version).
798
799 The call returns a structure with four elements.  The first
800 three (C<major>, C<minor> and C<release>) are numbers and
801 correspond to the usual version triplet.  The fourth element
802 (C<extra>) is a string and is normally empty, but may be
803 used for distro-specific information.
804
805 To construct the original version string:
806 C<$major.$minor.$release$extra>
807
808 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
809
810 I<Note:> Don't use this call to test for availability
811 of features.  In enterprise distributions we backport
812 features from later versions into earlier versions,
813 making this an unreliable way to test for features.
814 Use C<guestfs_available> instead.");
815
816   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
817    [InitNone, Always, TestOutputTrue (
818       [["set_selinux"; "true"];
819        ["get_selinux"]])],
820    "set SELinux enabled or disabled at appliance boot",
821    "\
822 This sets the selinux flag that is passed to the appliance
823 at boot time.  The default is C<selinux=0> (disabled).
824
825 Note that if SELinux is enabled, it is always in
826 Permissive mode (C<enforcing=0>).
827
828 For more information on the architecture of libguestfs,
829 see L<guestfs(3)>.");
830
831   ("get_selinux", (RBool "selinux", []), -1, [],
832    [],
833    "get SELinux enabled flag",
834    "\
835 This returns the current setting of the selinux flag which
836 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
837
838 For more information on the architecture of libguestfs,
839 see L<guestfs(3)>.");
840
841   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
842    [InitNone, Always, TestOutputFalse (
843       [["set_trace"; "false"];
844        ["get_trace"]])],
845    "enable or disable command traces",
846    "\
847 If the command trace flag is set to 1, then commands are
848 printed on stdout before they are executed in a format
849 which is very similar to the one used by guestfish.  In
850 other words, you can run a program with this enabled, and
851 you will get out a script which you can feed to guestfish
852 to perform the same set of actions.
853
854 If you want to trace C API calls into libguestfs (and
855 other libraries) then possibly a better way is to use
856 the external ltrace(1) command.
857
858 Command traces are disabled unless the environment variable
859 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
860
861   ("get_trace", (RBool "trace", []), -1, [],
862    [],
863    "get command trace enabled flag",
864    "\
865 Return the command trace flag.");
866
867   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
868    [InitNone, Always, TestOutputFalse (
869       [["set_direct"; "false"];
870        ["get_direct"]])],
871    "enable or disable direct appliance mode",
872    "\
873 If the direct appliance mode flag is enabled, then stdin and
874 stdout are passed directly through to the appliance once it
875 is launched.
876
877 One consequence of this is that log messages aren't caught
878 by the library and handled by C<guestfs_set_log_message_callback>,
879 but go straight to stdout.
880
881 You probably don't want to use this unless you know what you
882 are doing.
883
884 The default is disabled.");
885
886   ("get_direct", (RBool "direct", []), -1, [],
887    [],
888    "get direct appliance mode flag",
889    "\
890 Return the direct appliance mode flag.");
891
892   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
893    [InitNone, Always, TestOutputTrue (
894       [["set_recovery_proc"; "true"];
895        ["get_recovery_proc"]])],
896    "enable or disable the recovery process",
897    "\
898 If this is called with the parameter C<false> then
899 C<guestfs_launch> does not create a recovery process.  The
900 purpose of the recovery process is to stop runaway qemu
901 processes in the case where the main program aborts abruptly.
902
903 This only has any effect if called before C<guestfs_launch>,
904 and the default is true.
905
906 About the only time when you would want to disable this is
907 if the main process will fork itself into the background
908 (\"daemonize\" itself).  In this case the recovery process
909 thinks that the main program has disappeared and so kills
910 qemu, which is not very helpful.");
911
912   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
913    [],
914    "get recovery process enabled flag",
915    "\
916 Return the recovery process enabled flag.");
917
918   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
919    [],
920    "add a drive specifying the QEMU block emulation to use",
921    "\
922 This is the same as C<guestfs_add_drive> but it allows you
923 to specify the QEMU interface emulation to use at run time.");
924
925   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
926    [],
927    "add a drive read-only specifying the QEMU block emulation to use",
928    "\
929 This is the same as C<guestfs_add_drive_ro> but it allows you
930 to specify the QEMU interface emulation to use at run time.");
931
932 ]
933
934 (* daemon_functions are any functions which cause some action
935  * to take place in the daemon.
936  *)
937
938 let daemon_functions = [
939   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
940    [InitEmpty, Always, TestOutput (
941       [["part_disk"; "/dev/sda"; "mbr"];
942        ["mkfs"; "ext2"; "/dev/sda1"];
943        ["mount"; "/dev/sda1"; "/"];
944        ["write_file"; "/new"; "new file contents"; "0"];
945        ["cat"; "/new"]], "new file contents")],
946    "mount a guest disk at a position in the filesystem",
947    "\
948 Mount a guest disk at a position in the filesystem.  Block devices
949 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
950 the guest.  If those block devices contain partitions, they will have
951 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
952 names can be used.
953
954 The rules are the same as for L<mount(2)>:  A filesystem must
955 first be mounted on C</> before others can be mounted.  Other
956 filesystems can only be mounted on directories which already
957 exist.
958
959 The mounted filesystem is writable, if we have sufficient permissions
960 on the underlying device.
961
962 B<Important note:>
963 When you use this call, the filesystem options C<sync> and C<noatime>
964 are set implicitly.  This was originally done because we thought it
965 would improve reliability, but it turns out that I<-o sync> has a
966 very large negative performance impact and negligible effect on
967 reliability.  Therefore we recommend that you avoid using
968 C<guestfs_mount> in any code that needs performance, and instead
969 use C<guestfs_mount_options> (use an empty string for the first
970 parameter if you don't want any options).");
971
972   ("sync", (RErr, []), 2, [],
973    [ InitEmpty, Always, TestRun [["sync"]]],
974    "sync disks, writes are flushed through to the disk image",
975    "\
976 This syncs the disk, so that any writes are flushed through to the
977 underlying disk image.
978
979 You should always call this if you have modified a disk image, before
980 closing the handle.");
981
982   ("touch", (RErr, [Pathname "path"]), 3, [],
983    [InitBasicFS, Always, TestOutputTrue (
984       [["touch"; "/new"];
985        ["exists"; "/new"]])],
986    "update file timestamps or create a new file",
987    "\
988 Touch acts like the L<touch(1)> command.  It can be used to
989 update the timestamps on a file, or, if the file does not exist,
990 to create a new zero-length file.");
991
992   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
993    [InitISOFS, Always, TestOutput (
994       [["cat"; "/known-2"]], "abcdef\n")],
995    "list the contents of a file",
996    "\
997 Return the contents of the file named C<path>.
998
999 Note that this function cannot correctly handle binary files
1000 (specifically, files containing C<\\0> character which is treated
1001 as end of string).  For those you need to use the C<guestfs_read_file>
1002 or C<guestfs_download> functions which have a more complex interface.");
1003
1004   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1005    [], (* XXX Tricky to test because it depends on the exact format
1006         * of the 'ls -l' command, which changes between F10 and F11.
1007         *)
1008    "list the files in a directory (long format)",
1009    "\
1010 List the files in C<directory> (relative to the root directory,
1011 there is no cwd) in the format of 'ls -la'.
1012
1013 This command is mostly useful for interactive sessions.  It
1014 is I<not> intended that you try to parse the output string.");
1015
1016   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1017    [InitBasicFS, Always, TestOutputList (
1018       [["touch"; "/new"];
1019        ["touch"; "/newer"];
1020        ["touch"; "/newest"];
1021        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1022    "list the files in a directory",
1023    "\
1024 List the files in C<directory> (relative to the root directory,
1025 there is no cwd).  The '.' and '..' entries are not returned, but
1026 hidden files are shown.
1027
1028 This command is mostly useful for interactive sessions.  Programs
1029 should probably use C<guestfs_readdir> instead.");
1030
1031   ("list_devices", (RStringList "devices", []), 7, [],
1032    [InitEmpty, Always, TestOutputListOfDevices (
1033       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1034    "list the block devices",
1035    "\
1036 List all the block devices.
1037
1038 The full block device names are returned, eg. C</dev/sda>");
1039
1040   ("list_partitions", (RStringList "partitions", []), 8, [],
1041    [InitBasicFS, Always, TestOutputListOfDevices (
1042       [["list_partitions"]], ["/dev/sda1"]);
1043     InitEmpty, Always, TestOutputListOfDevices (
1044       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1045        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1046    "list the partitions",
1047    "\
1048 List all the partitions detected on all block devices.
1049
1050 The full partition device names are returned, eg. C</dev/sda1>
1051
1052 This does not return logical volumes.  For that you will need to
1053 call C<guestfs_lvs>.");
1054
1055   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1056    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1057       [["pvs"]], ["/dev/sda1"]);
1058     InitEmpty, Always, TestOutputListOfDevices (
1059       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1060        ["pvcreate"; "/dev/sda1"];
1061        ["pvcreate"; "/dev/sda2"];
1062        ["pvcreate"; "/dev/sda3"];
1063        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1064    "list the LVM physical volumes (PVs)",
1065    "\
1066 List all the physical volumes detected.  This is the equivalent
1067 of the L<pvs(8)> command.
1068
1069 This returns a list of just the device names that contain
1070 PVs (eg. C</dev/sda2>).
1071
1072 See also C<guestfs_pvs_full>.");
1073
1074   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1075    [InitBasicFSonLVM, Always, TestOutputList (
1076       [["vgs"]], ["VG"]);
1077     InitEmpty, Always, TestOutputList (
1078       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1079        ["pvcreate"; "/dev/sda1"];
1080        ["pvcreate"; "/dev/sda2"];
1081        ["pvcreate"; "/dev/sda3"];
1082        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1083        ["vgcreate"; "VG2"; "/dev/sda3"];
1084        ["vgs"]], ["VG1"; "VG2"])],
1085    "list the LVM volume groups (VGs)",
1086    "\
1087 List all the volumes groups detected.  This is the equivalent
1088 of the L<vgs(8)> command.
1089
1090 This returns a list of just the volume group names that were
1091 detected (eg. C<VolGroup00>).
1092
1093 See also C<guestfs_vgs_full>.");
1094
1095   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1096    [InitBasicFSonLVM, Always, TestOutputList (
1097       [["lvs"]], ["/dev/VG/LV"]);
1098     InitEmpty, Always, TestOutputList (
1099       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1100        ["pvcreate"; "/dev/sda1"];
1101        ["pvcreate"; "/dev/sda2"];
1102        ["pvcreate"; "/dev/sda3"];
1103        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1104        ["vgcreate"; "VG2"; "/dev/sda3"];
1105        ["lvcreate"; "LV1"; "VG1"; "50"];
1106        ["lvcreate"; "LV2"; "VG1"; "50"];
1107        ["lvcreate"; "LV3"; "VG2"; "50"];
1108        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1109    "list the LVM logical volumes (LVs)",
1110    "\
1111 List all the logical volumes detected.  This is the equivalent
1112 of the L<lvs(8)> command.
1113
1114 This returns a list of the logical volume device names
1115 (eg. C</dev/VolGroup00/LogVol00>).
1116
1117 See also C<guestfs_lvs_full>.");
1118
1119   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1120    [], (* XXX how to test? *)
1121    "list the LVM physical volumes (PVs)",
1122    "\
1123 List all the physical volumes detected.  This is the equivalent
1124 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1125
1126   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1127    [], (* XXX how to test? *)
1128    "list the LVM volume groups (VGs)",
1129    "\
1130 List all the volumes groups detected.  This is the equivalent
1131 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1132
1133   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1134    [], (* XXX how to test? *)
1135    "list the LVM logical volumes (LVs)",
1136    "\
1137 List all the logical volumes detected.  This is the equivalent
1138 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1139
1140   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1141    [InitISOFS, Always, TestOutputList (
1142       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1143     InitISOFS, Always, TestOutputList (
1144       [["read_lines"; "/empty"]], [])],
1145    "read file as lines",
1146    "\
1147 Return the contents of the file named C<path>.
1148
1149 The file contents are returned as a list of lines.  Trailing
1150 C<LF> and C<CRLF> character sequences are I<not> returned.
1151
1152 Note that this function cannot correctly handle binary files
1153 (specifically, files containing C<\\0> character which is treated
1154 as end of line).  For those you need to use the C<guestfs_read_file>
1155 function which has a more complex interface.");
1156
1157   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1158    [], (* XXX Augeas code needs tests. *)
1159    "create a new Augeas handle",
1160    "\
1161 Create a new Augeas handle for editing configuration files.
1162 If there was any previous Augeas handle associated with this
1163 guestfs session, then it is closed.
1164
1165 You must call this before using any other C<guestfs_aug_*>
1166 commands.
1167
1168 C<root> is the filesystem root.  C<root> must not be NULL,
1169 use C</> instead.
1170
1171 The flags are the same as the flags defined in
1172 E<lt>augeas.hE<gt>, the logical I<or> of the following
1173 integers:
1174
1175 =over 4
1176
1177 =item C<AUG_SAVE_BACKUP> = 1
1178
1179 Keep the original file with a C<.augsave> extension.
1180
1181 =item C<AUG_SAVE_NEWFILE> = 2
1182
1183 Save changes into a file with extension C<.augnew>, and
1184 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1185
1186 =item C<AUG_TYPE_CHECK> = 4
1187
1188 Typecheck lenses (can be expensive).
1189
1190 =item C<AUG_NO_STDINC> = 8
1191
1192 Do not use standard load path for modules.
1193
1194 =item C<AUG_SAVE_NOOP> = 16
1195
1196 Make save a no-op, just record what would have been changed.
1197
1198 =item C<AUG_NO_LOAD> = 32
1199
1200 Do not load the tree in C<guestfs_aug_init>.
1201
1202 =back
1203
1204 To close the handle, you can call C<guestfs_aug_close>.
1205
1206 To find out more about Augeas, see L<http://augeas.net/>.");
1207
1208   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1209    [], (* XXX Augeas code needs tests. *)
1210    "close the current Augeas handle",
1211    "\
1212 Close the current Augeas handle and free up any resources
1213 used by it.  After calling this, you have to call
1214 C<guestfs_aug_init> again before you can use any other
1215 Augeas functions.");
1216
1217   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1218    [], (* XXX Augeas code needs tests. *)
1219    "define an Augeas variable",
1220    "\
1221 Defines an Augeas variable C<name> whose value is the result
1222 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1223 undefined.
1224
1225 On success this returns the number of nodes in C<expr>, or
1226 C<0> if C<expr> evaluates to something which is not a nodeset.");
1227
1228   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1229    [], (* XXX Augeas code needs tests. *)
1230    "define an Augeas node",
1231    "\
1232 Defines a variable C<name> whose value is the result of
1233 evaluating C<expr>.
1234
1235 If C<expr> evaluates to an empty nodeset, a node is created,
1236 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1237 C<name> will be the nodeset containing that single node.
1238
1239 On success this returns a pair containing the
1240 number of nodes in the nodeset, and a boolean flag
1241 if a node was created.");
1242
1243   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1244    [], (* XXX Augeas code needs tests. *)
1245    "look up the value of an Augeas path",
1246    "\
1247 Look up the value associated with C<path>.  If C<path>
1248 matches exactly one node, the C<value> is returned.");
1249
1250   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1251    [], (* XXX Augeas code needs tests. *)
1252    "set Augeas path to value",
1253    "\
1254 Set the value associated with C<path> to C<value>.");
1255
1256   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1257    [], (* XXX Augeas code needs tests. *)
1258    "insert a sibling Augeas node",
1259    "\
1260 Create a new sibling C<label> for C<path>, inserting it into
1261 the tree before or after C<path> (depending on the boolean
1262 flag C<before>).
1263
1264 C<path> must match exactly one existing node in the tree, and
1265 C<label> must be a label, ie. not contain C</>, C<*> or end
1266 with a bracketed index C<[N]>.");
1267
1268   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1269    [], (* XXX Augeas code needs tests. *)
1270    "remove an Augeas path",
1271    "\
1272 Remove C<path> and all of its children.
1273
1274 On success this returns the number of entries which were removed.");
1275
1276   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1277    [], (* XXX Augeas code needs tests. *)
1278    "move Augeas node",
1279    "\
1280 Move the node C<src> to C<dest>.  C<src> must match exactly
1281 one node.  C<dest> is overwritten if it exists.");
1282
1283   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1284    [], (* XXX Augeas code needs tests. *)
1285    "return Augeas nodes which match augpath",
1286    "\
1287 Returns a list of paths which match the path expression C<path>.
1288 The returned paths are sufficiently qualified so that they match
1289 exactly one node in the current tree.");
1290
1291   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1292    [], (* XXX Augeas code needs tests. *)
1293    "write all pending Augeas changes to disk",
1294    "\
1295 This writes all pending changes to disk.
1296
1297 The flags which were passed to C<guestfs_aug_init> affect exactly
1298 how files are saved.");
1299
1300   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1301    [], (* XXX Augeas code needs tests. *)
1302    "load files into the tree",
1303    "\
1304 Load files into the tree.
1305
1306 See C<aug_load> in the Augeas documentation for the full gory
1307 details.");
1308
1309   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1310    [], (* XXX Augeas code needs tests. *)
1311    "list Augeas nodes under augpath",
1312    "\
1313 This is just a shortcut for listing C<guestfs_aug_match>
1314 C<path/*> and sorting the resulting nodes into alphabetical order.");
1315
1316   ("rm", (RErr, [Pathname "path"]), 29, [],
1317    [InitBasicFS, Always, TestRun
1318       [["touch"; "/new"];
1319        ["rm"; "/new"]];
1320     InitBasicFS, Always, TestLastFail
1321       [["rm"; "/new"]];
1322     InitBasicFS, Always, TestLastFail
1323       [["mkdir"; "/new"];
1324        ["rm"; "/new"]]],
1325    "remove a file",
1326    "\
1327 Remove the single file C<path>.");
1328
1329   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1330    [InitBasicFS, Always, TestRun
1331       [["mkdir"; "/new"];
1332        ["rmdir"; "/new"]];
1333     InitBasicFS, Always, TestLastFail
1334       [["rmdir"; "/new"]];
1335     InitBasicFS, Always, TestLastFail
1336       [["touch"; "/new"];
1337        ["rmdir"; "/new"]]],
1338    "remove a directory",
1339    "\
1340 Remove the single directory C<path>.");
1341
1342   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1343    [InitBasicFS, Always, TestOutputFalse
1344       [["mkdir"; "/new"];
1345        ["mkdir"; "/new/foo"];
1346        ["touch"; "/new/foo/bar"];
1347        ["rm_rf"; "/new"];
1348        ["exists"; "/new"]]],
1349    "remove a file or directory recursively",
1350    "\
1351 Remove the file or directory C<path>, recursively removing the
1352 contents if its a directory.  This is like the C<rm -rf> shell
1353 command.");
1354
1355   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1356    [InitBasicFS, Always, TestOutputTrue
1357       [["mkdir"; "/new"];
1358        ["is_dir"; "/new"]];
1359     InitBasicFS, Always, TestLastFail
1360       [["mkdir"; "/new/foo/bar"]]],
1361    "create a directory",
1362    "\
1363 Create a directory named C<path>.");
1364
1365   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1366    [InitBasicFS, Always, TestOutputTrue
1367       [["mkdir_p"; "/new/foo/bar"];
1368        ["is_dir"; "/new/foo/bar"]];
1369     InitBasicFS, Always, TestOutputTrue
1370       [["mkdir_p"; "/new/foo/bar"];
1371        ["is_dir"; "/new/foo"]];
1372     InitBasicFS, Always, TestOutputTrue
1373       [["mkdir_p"; "/new/foo/bar"];
1374        ["is_dir"; "/new"]];
1375     (* Regression tests for RHBZ#503133: *)
1376     InitBasicFS, Always, TestRun
1377       [["mkdir"; "/new"];
1378        ["mkdir_p"; "/new"]];
1379     InitBasicFS, Always, TestLastFail
1380       [["touch"; "/new"];
1381        ["mkdir_p"; "/new"]]],
1382    "create a directory and parents",
1383    "\
1384 Create a directory named C<path>, creating any parent directories
1385 as necessary.  This is like the C<mkdir -p> shell command.");
1386
1387   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1388    [], (* XXX Need stat command to test *)
1389    "change file mode",
1390    "\
1391 Change the mode (permissions) of C<path> to C<mode>.  Only
1392 numeric modes are supported.
1393
1394 I<Note>: When using this command from guestfish, C<mode>
1395 by default would be decimal, unless you prefix it with
1396 C<0> to get octal, ie. use C<0700> not C<700>.
1397
1398 The mode actually set is affected by the umask.");
1399
1400   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1401    [], (* XXX Need stat command to test *)
1402    "change file owner and group",
1403    "\
1404 Change the file owner to C<owner> and group to C<group>.
1405
1406 Only numeric uid and gid are supported.  If you want to use
1407 names, you will need to locate and parse the password file
1408 yourself (Augeas support makes this relatively easy).");
1409
1410   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1411    [InitISOFS, Always, TestOutputTrue (
1412       [["exists"; "/empty"]]);
1413     InitISOFS, Always, TestOutputTrue (
1414       [["exists"; "/directory"]])],
1415    "test if file or directory exists",
1416    "\
1417 This returns C<true> if and only if there is a file, directory
1418 (or anything) with the given C<path> name.
1419
1420 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1421
1422   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1423    [InitISOFS, Always, TestOutputTrue (
1424       [["is_file"; "/known-1"]]);
1425     InitISOFS, Always, TestOutputFalse (
1426       [["is_file"; "/directory"]])],
1427    "test if a regular file",
1428    "\
1429 This returns C<true> if and only if there is a regular file
1430 with the given C<path> name.  Note that it returns false for
1431 other objects like directories.
1432
1433 See also C<guestfs_stat>.");
1434
1435   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1436    [InitISOFS, Always, TestOutputFalse (
1437       [["is_dir"; "/known-3"]]);
1438     InitISOFS, Always, TestOutputTrue (
1439       [["is_dir"; "/directory"]])],
1440    "test if a directory",
1441    "\
1442 This returns C<true> if and only if there is a directory
1443 with the given C<path> name.  Note that it returns false for
1444 other objects like files.
1445
1446 See also C<guestfs_stat>.");
1447
1448   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1449    [InitEmpty, Always, TestOutputListOfDevices (
1450       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1451        ["pvcreate"; "/dev/sda1"];
1452        ["pvcreate"; "/dev/sda2"];
1453        ["pvcreate"; "/dev/sda3"];
1454        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1455    "create an LVM physical volume",
1456    "\
1457 This creates an LVM physical volume on the named C<device>,
1458 where C<device> should usually be a partition name such
1459 as C</dev/sda1>.");
1460
1461   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1462    [InitEmpty, Always, TestOutputList (
1463       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1464        ["pvcreate"; "/dev/sda1"];
1465        ["pvcreate"; "/dev/sda2"];
1466        ["pvcreate"; "/dev/sda3"];
1467        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1468        ["vgcreate"; "VG2"; "/dev/sda3"];
1469        ["vgs"]], ["VG1"; "VG2"])],
1470    "create an LVM volume group",
1471    "\
1472 This creates an LVM volume group called C<volgroup>
1473 from the non-empty list of physical volumes C<physvols>.");
1474
1475   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1476    [InitEmpty, Always, TestOutputList (
1477       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1478        ["pvcreate"; "/dev/sda1"];
1479        ["pvcreate"; "/dev/sda2"];
1480        ["pvcreate"; "/dev/sda3"];
1481        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1482        ["vgcreate"; "VG2"; "/dev/sda3"];
1483        ["lvcreate"; "LV1"; "VG1"; "50"];
1484        ["lvcreate"; "LV2"; "VG1"; "50"];
1485        ["lvcreate"; "LV3"; "VG2"; "50"];
1486        ["lvcreate"; "LV4"; "VG2"; "50"];
1487        ["lvcreate"; "LV5"; "VG2"; "50"];
1488        ["lvs"]],
1489       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1490        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1491    "create an LVM logical volume",
1492    "\
1493 This creates an LVM logical volume called C<logvol>
1494 on the volume group C<volgroup>, with C<size> megabytes.");
1495
1496   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1497    [InitEmpty, Always, TestOutput (
1498       [["part_disk"; "/dev/sda"; "mbr"];
1499        ["mkfs"; "ext2"; "/dev/sda1"];
1500        ["mount_options"; ""; "/dev/sda1"; "/"];
1501        ["write_file"; "/new"; "new file contents"; "0"];
1502        ["cat"; "/new"]], "new file contents")],
1503    "make a filesystem",
1504    "\
1505 This creates a filesystem on C<device> (usually a partition
1506 or LVM logical volume).  The filesystem type is C<fstype>, for
1507 example C<ext3>.");
1508
1509   ("sfdisk", (RErr, [Device "device";
1510                      Int "cyls"; Int "heads"; Int "sectors";
1511                      StringList "lines"]), 43, [DangerWillRobinson],
1512    [],
1513    "create partitions on a block device",
1514    "\
1515 This is a direct interface to the L<sfdisk(8)> program for creating
1516 partitions on block devices.
1517
1518 C<device> should be a block device, for example C</dev/sda>.
1519
1520 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1521 and sectors on the device, which are passed directly to sfdisk as
1522 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1523 of these, then the corresponding parameter is omitted.  Usually for
1524 'large' disks, you can just pass C<0> for these, but for small
1525 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1526 out the right geometry and you will need to tell it.
1527
1528 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1529 information refer to the L<sfdisk(8)> manpage.
1530
1531 To create a single partition occupying the whole disk, you would
1532 pass C<lines> as a single element list, when the single element being
1533 the string C<,> (comma).
1534
1535 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1536 C<guestfs_part_init>");
1537
1538   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1539    [InitBasicFS, Always, TestOutput (
1540       [["write_file"; "/new"; "new file contents"; "0"];
1541        ["cat"; "/new"]], "new file contents");
1542     InitBasicFS, Always, TestOutput (
1543       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1544        ["cat"; "/new"]], "\nnew file contents\n");
1545     InitBasicFS, Always, TestOutput (
1546       [["write_file"; "/new"; "\n\n"; "0"];
1547        ["cat"; "/new"]], "\n\n");
1548     InitBasicFS, Always, TestOutput (
1549       [["write_file"; "/new"; ""; "0"];
1550        ["cat"; "/new"]], "");
1551     InitBasicFS, Always, TestOutput (
1552       [["write_file"; "/new"; "\n\n\n"; "0"];
1553        ["cat"; "/new"]], "\n\n\n");
1554     InitBasicFS, Always, TestOutput (
1555       [["write_file"; "/new"; "\n"; "0"];
1556        ["cat"; "/new"]], "\n");
1557     (* Regression test for RHBZ#597135. *)
1558     InitBasicFS, Always, TestLastFail
1559       [["write_file"; "/new"; "abc"; "10000"]]],
1560    "create a file",
1561    "\
1562 This call creates a file called C<path>.  The contents of the
1563 file is the string C<content> (which can contain any 8 bit data),
1564 with length C<size>.
1565
1566 As a special case, if C<size> is C<0>
1567 then the length is calculated using C<strlen> (so in this case
1568 the content cannot contain embedded ASCII NULs).
1569
1570 I<NB.> Owing to a bug, writing content containing ASCII NUL
1571 characters does I<not> work, even if the length is specified.
1572 We hope to resolve this bug in a future version.  In the meantime
1573 use C<guestfs_upload>.");
1574
1575   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1576    [InitEmpty, Always, TestOutputListOfDevices (
1577       [["part_disk"; "/dev/sda"; "mbr"];
1578        ["mkfs"; "ext2"; "/dev/sda1"];
1579        ["mount_options"; ""; "/dev/sda1"; "/"];
1580        ["mounts"]], ["/dev/sda1"]);
1581     InitEmpty, Always, TestOutputList (
1582       [["part_disk"; "/dev/sda"; "mbr"];
1583        ["mkfs"; "ext2"; "/dev/sda1"];
1584        ["mount_options"; ""; "/dev/sda1"; "/"];
1585        ["umount"; "/"];
1586        ["mounts"]], [])],
1587    "unmount a filesystem",
1588    "\
1589 This unmounts the given filesystem.  The filesystem may be
1590 specified either by its mountpoint (path) or the device which
1591 contains the filesystem.");
1592
1593   ("mounts", (RStringList "devices", []), 46, [],
1594    [InitBasicFS, Always, TestOutputListOfDevices (
1595       [["mounts"]], ["/dev/sda1"])],
1596    "show mounted filesystems",
1597    "\
1598 This returns the list of currently mounted filesystems.  It returns
1599 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1600
1601 Some internal mounts are not shown.
1602
1603 See also: C<guestfs_mountpoints>");
1604
1605   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1606    [InitBasicFS, Always, TestOutputList (
1607       [["umount_all"];
1608        ["mounts"]], []);
1609     (* check that umount_all can unmount nested mounts correctly: *)
1610     InitEmpty, Always, TestOutputList (
1611       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1612        ["mkfs"; "ext2"; "/dev/sda1"];
1613        ["mkfs"; "ext2"; "/dev/sda2"];
1614        ["mkfs"; "ext2"; "/dev/sda3"];
1615        ["mount_options"; ""; "/dev/sda1"; "/"];
1616        ["mkdir"; "/mp1"];
1617        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1618        ["mkdir"; "/mp1/mp2"];
1619        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1620        ["mkdir"; "/mp1/mp2/mp3"];
1621        ["umount_all"];
1622        ["mounts"]], [])],
1623    "unmount all filesystems",
1624    "\
1625 This unmounts all mounted filesystems.
1626
1627 Some internal mounts are not unmounted by this call.");
1628
1629   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1630    [],
1631    "remove all LVM LVs, VGs and PVs",
1632    "\
1633 This command removes all LVM logical volumes, volume groups
1634 and physical volumes.");
1635
1636   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1637    [InitISOFS, Always, TestOutput (
1638       [["file"; "/empty"]], "empty");
1639     InitISOFS, Always, TestOutput (
1640       [["file"; "/known-1"]], "ASCII text");
1641     InitISOFS, Always, TestLastFail (
1642       [["file"; "/notexists"]])],
1643    "determine file type",
1644    "\
1645 This call uses the standard L<file(1)> command to determine
1646 the type or contents of the file.  This also works on devices,
1647 for example to find out whether a partition contains a filesystem.
1648
1649 This call will also transparently look inside various types
1650 of compressed file.
1651
1652 The exact command which runs is C<file -zbsL path>.  Note in
1653 particular that the filename is not prepended to the output
1654 (the C<-b> option).");
1655
1656   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1657    [InitBasicFS, Always, TestOutput (
1658       [["upload"; "test-command"; "/test-command"];
1659        ["chmod"; "0o755"; "/test-command"];
1660        ["command"; "/test-command 1"]], "Result1");
1661     InitBasicFS, Always, TestOutput (
1662       [["upload"; "test-command"; "/test-command"];
1663        ["chmod"; "0o755"; "/test-command"];
1664        ["command"; "/test-command 2"]], "Result2\n");
1665     InitBasicFS, Always, TestOutput (
1666       [["upload"; "test-command"; "/test-command"];
1667        ["chmod"; "0o755"; "/test-command"];
1668        ["command"; "/test-command 3"]], "\nResult3");
1669     InitBasicFS, Always, TestOutput (
1670       [["upload"; "test-command"; "/test-command"];
1671        ["chmod"; "0o755"; "/test-command"];
1672        ["command"; "/test-command 4"]], "\nResult4\n");
1673     InitBasicFS, Always, TestOutput (
1674       [["upload"; "test-command"; "/test-command"];
1675        ["chmod"; "0o755"; "/test-command"];
1676        ["command"; "/test-command 5"]], "\nResult5\n\n");
1677     InitBasicFS, Always, TestOutput (
1678       [["upload"; "test-command"; "/test-command"];
1679        ["chmod"; "0o755"; "/test-command"];
1680        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1681     InitBasicFS, Always, TestOutput (
1682       [["upload"; "test-command"; "/test-command"];
1683        ["chmod"; "0o755"; "/test-command"];
1684        ["command"; "/test-command 7"]], "");
1685     InitBasicFS, Always, TestOutput (
1686       [["upload"; "test-command"; "/test-command"];
1687        ["chmod"; "0o755"; "/test-command"];
1688        ["command"; "/test-command 8"]], "\n");
1689     InitBasicFS, Always, TestOutput (
1690       [["upload"; "test-command"; "/test-command"];
1691        ["chmod"; "0o755"; "/test-command"];
1692        ["command"; "/test-command 9"]], "\n\n");
1693     InitBasicFS, Always, TestOutput (
1694       [["upload"; "test-command"; "/test-command"];
1695        ["chmod"; "0o755"; "/test-command"];
1696        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1697     InitBasicFS, Always, TestOutput (
1698       [["upload"; "test-command"; "/test-command"];
1699        ["chmod"; "0o755"; "/test-command"];
1700        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1701     InitBasicFS, Always, TestLastFail (
1702       [["upload"; "test-command"; "/test-command"];
1703        ["chmod"; "0o755"; "/test-command"];
1704        ["command"; "/test-command"]])],
1705    "run a command from the guest filesystem",
1706    "\
1707 This call runs a command from the guest filesystem.  The
1708 filesystem must be mounted, and must contain a compatible
1709 operating system (ie. something Linux, with the same
1710 or compatible processor architecture).
1711
1712 The single parameter is an argv-style list of arguments.
1713 The first element is the name of the program to run.
1714 Subsequent elements are parameters.  The list must be
1715 non-empty (ie. must contain a program name).  Note that
1716 the command runs directly, and is I<not> invoked via
1717 the shell (see C<guestfs_sh>).
1718
1719 The return value is anything printed to I<stdout> by
1720 the command.
1721
1722 If the command returns a non-zero exit status, then
1723 this function returns an error message.  The error message
1724 string is the content of I<stderr> from the command.
1725
1726 The C<$PATH> environment variable will contain at least
1727 C</usr/bin> and C</bin>.  If you require a program from
1728 another location, you should provide the full path in the
1729 first parameter.
1730
1731 Shared libraries and data files required by the program
1732 must be available on filesystems which are mounted in the
1733 correct places.  It is the caller's responsibility to ensure
1734 all filesystems that are needed are mounted at the right
1735 locations.");
1736
1737   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1738    [InitBasicFS, Always, TestOutputList (
1739       [["upload"; "test-command"; "/test-command"];
1740        ["chmod"; "0o755"; "/test-command"];
1741        ["command_lines"; "/test-command 1"]], ["Result1"]);
1742     InitBasicFS, Always, TestOutputList (
1743       [["upload"; "test-command"; "/test-command"];
1744        ["chmod"; "0o755"; "/test-command"];
1745        ["command_lines"; "/test-command 2"]], ["Result2"]);
1746     InitBasicFS, Always, TestOutputList (
1747       [["upload"; "test-command"; "/test-command"];
1748        ["chmod"; "0o755"; "/test-command"];
1749        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1750     InitBasicFS, Always, TestOutputList (
1751       [["upload"; "test-command"; "/test-command"];
1752        ["chmod"; "0o755"; "/test-command"];
1753        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1754     InitBasicFS, Always, TestOutputList (
1755       [["upload"; "test-command"; "/test-command"];
1756        ["chmod"; "0o755"; "/test-command"];
1757        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1758     InitBasicFS, Always, TestOutputList (
1759       [["upload"; "test-command"; "/test-command"];
1760        ["chmod"; "0o755"; "/test-command"];
1761        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1762     InitBasicFS, Always, TestOutputList (
1763       [["upload"; "test-command"; "/test-command"];
1764        ["chmod"; "0o755"; "/test-command"];
1765        ["command_lines"; "/test-command 7"]], []);
1766     InitBasicFS, Always, TestOutputList (
1767       [["upload"; "test-command"; "/test-command"];
1768        ["chmod"; "0o755"; "/test-command"];
1769        ["command_lines"; "/test-command 8"]], [""]);
1770     InitBasicFS, Always, TestOutputList (
1771       [["upload"; "test-command"; "/test-command"];
1772        ["chmod"; "0o755"; "/test-command"];
1773        ["command_lines"; "/test-command 9"]], ["";""]);
1774     InitBasicFS, Always, TestOutputList (
1775       [["upload"; "test-command"; "/test-command"];
1776        ["chmod"; "0o755"; "/test-command"];
1777        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1778     InitBasicFS, Always, TestOutputList (
1779       [["upload"; "test-command"; "/test-command"];
1780        ["chmod"; "0o755"; "/test-command"];
1781        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1782    "run a command, returning lines",
1783    "\
1784 This is the same as C<guestfs_command>, but splits the
1785 result into a list of lines.
1786
1787 See also: C<guestfs_sh_lines>");
1788
1789   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1790    [InitISOFS, Always, TestOutputStruct (
1791       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1792    "get file information",
1793    "\
1794 Returns file information for the given C<path>.
1795
1796 This is the same as the C<stat(2)> system call.");
1797
1798   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1799    [InitISOFS, Always, TestOutputStruct (
1800       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1801    "get file information for a symbolic link",
1802    "\
1803 Returns file information for the given C<path>.
1804
1805 This is the same as C<guestfs_stat> except that if C<path>
1806 is a symbolic link, then the link is stat-ed, not the file it
1807 refers to.
1808
1809 This is the same as the C<lstat(2)> system call.");
1810
1811   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1812    [InitISOFS, Always, TestOutputStruct (
1813       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1814    "get file system statistics",
1815    "\
1816 Returns file system statistics for any mounted file system.
1817 C<path> should be a file or directory in the mounted file system
1818 (typically it is the mount point itself, but it doesn't need to be).
1819
1820 This is the same as the C<statvfs(2)> system call.");
1821
1822   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1823    [], (* XXX test *)
1824    "get ext2/ext3/ext4 superblock details",
1825    "\
1826 This returns the contents of the ext2, ext3 or ext4 filesystem
1827 superblock on C<device>.
1828
1829 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1830 manpage for more details.  The list of fields returned isn't
1831 clearly defined, and depends on both the version of C<tune2fs>
1832 that libguestfs was built against, and the filesystem itself.");
1833
1834   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1835    [InitEmpty, Always, TestOutputTrue (
1836       [["blockdev_setro"; "/dev/sda"];
1837        ["blockdev_getro"; "/dev/sda"]])],
1838    "set block device to read-only",
1839    "\
1840 Sets the block device named C<device> to read-only.
1841
1842 This uses the L<blockdev(8)> command.");
1843
1844   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1845    [InitEmpty, Always, TestOutputFalse (
1846       [["blockdev_setrw"; "/dev/sda"];
1847        ["blockdev_getro"; "/dev/sda"]])],
1848    "set block device to read-write",
1849    "\
1850 Sets the block device named C<device> to read-write.
1851
1852 This uses the L<blockdev(8)> command.");
1853
1854   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1855    [InitEmpty, Always, TestOutputTrue (
1856       [["blockdev_setro"; "/dev/sda"];
1857        ["blockdev_getro"; "/dev/sda"]])],
1858    "is block device set to read-only",
1859    "\
1860 Returns a boolean indicating if the block device is read-only
1861 (true if read-only, false if not).
1862
1863 This uses the L<blockdev(8)> command.");
1864
1865   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1866    [InitEmpty, Always, TestOutputInt (
1867       [["blockdev_getss"; "/dev/sda"]], 512)],
1868    "get sectorsize of block device",
1869    "\
1870 This returns the size of sectors on a block device.
1871 Usually 512, but can be larger for modern devices.
1872
1873 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1874 for that).
1875
1876 This uses the L<blockdev(8)> command.");
1877
1878   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1879    [InitEmpty, Always, TestOutputInt (
1880       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1881    "get blocksize of block device",
1882    "\
1883 This returns the block size of a device.
1884
1885 (Note this is different from both I<size in blocks> and
1886 I<filesystem block size>).
1887
1888 This uses the L<blockdev(8)> command.");
1889
1890   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1891    [], (* XXX test *)
1892    "set blocksize of block device",
1893    "\
1894 This sets the block size of a device.
1895
1896 (Note this is different from both I<size in blocks> and
1897 I<filesystem block size>).
1898
1899 This uses the L<blockdev(8)> command.");
1900
1901   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1902    [InitEmpty, Always, TestOutputInt (
1903       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1904    "get total size of device in 512-byte sectors",
1905    "\
1906 This returns the size of the device in units of 512-byte sectors
1907 (even if the sectorsize isn't 512 bytes ... weird).
1908
1909 See also C<guestfs_blockdev_getss> for the real sector size of
1910 the device, and C<guestfs_blockdev_getsize64> for the more
1911 useful I<size in bytes>.
1912
1913 This uses the L<blockdev(8)> command.");
1914
1915   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1916    [InitEmpty, Always, TestOutputInt (
1917       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1918    "get total size of device in bytes",
1919    "\
1920 This returns the size of the device in bytes.
1921
1922 See also C<guestfs_blockdev_getsz>.
1923
1924 This uses the L<blockdev(8)> command.");
1925
1926   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1927    [InitEmpty, Always, TestRun
1928       [["blockdev_flushbufs"; "/dev/sda"]]],
1929    "flush device buffers",
1930    "\
1931 This tells the kernel to flush internal buffers associated
1932 with C<device>.
1933
1934 This uses the L<blockdev(8)> command.");
1935
1936   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1937    [InitEmpty, Always, TestRun
1938       [["blockdev_rereadpt"; "/dev/sda"]]],
1939    "reread partition table",
1940    "\
1941 Reread the partition table on C<device>.
1942
1943 This uses the L<blockdev(8)> command.");
1944
1945   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1946    [InitBasicFS, Always, TestOutput (
1947       (* Pick a file from cwd which isn't likely to change. *)
1948       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1949        ["checksum"; "md5"; "/COPYING.LIB"]],
1950       Digest.to_hex (Digest.file "COPYING.LIB"))],
1951    "upload a file from the local machine",
1952    "\
1953 Upload local file C<filename> to C<remotefilename> on the
1954 filesystem.
1955
1956 C<filename> can also be a named pipe.
1957
1958 See also C<guestfs_download>.");
1959
1960   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1961    [InitBasicFS, Always, TestOutput (
1962       (* Pick a file from cwd which isn't likely to change. *)
1963       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1964        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1965        ["upload"; "testdownload.tmp"; "/upload"];
1966        ["checksum"; "md5"; "/upload"]],
1967       Digest.to_hex (Digest.file "COPYING.LIB"))],
1968    "download a file to the local machine",
1969    "\
1970 Download file C<remotefilename> and save it as C<filename>
1971 on the local machine.
1972
1973 C<filename> can also be a named pipe.
1974
1975 See also C<guestfs_upload>, C<guestfs_cat>.");
1976
1977   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1978    [InitISOFS, Always, TestOutput (
1979       [["checksum"; "crc"; "/known-3"]], "2891671662");
1980     InitISOFS, Always, TestLastFail (
1981       [["checksum"; "crc"; "/notexists"]]);
1982     InitISOFS, Always, TestOutput (
1983       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1984     InitISOFS, Always, TestOutput (
1985       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1986     InitISOFS, Always, TestOutput (
1987       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1988     InitISOFS, Always, TestOutput (
1989       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1990     InitISOFS, Always, TestOutput (
1991       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1992     InitISOFS, Always, TestOutput (
1993       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1994    "compute MD5, SHAx or CRC checksum of file",
1995    "\
1996 This call computes the MD5, SHAx or CRC checksum of the
1997 file named C<path>.
1998
1999 The type of checksum to compute is given by the C<csumtype>
2000 parameter which must have one of the following values:
2001
2002 =over 4
2003
2004 =item C<crc>
2005
2006 Compute the cyclic redundancy check (CRC) specified by POSIX
2007 for the C<cksum> command.
2008
2009 =item C<md5>
2010
2011 Compute the MD5 hash (using the C<md5sum> program).
2012
2013 =item C<sha1>
2014
2015 Compute the SHA1 hash (using the C<sha1sum> program).
2016
2017 =item C<sha224>
2018
2019 Compute the SHA224 hash (using the C<sha224sum> program).
2020
2021 =item C<sha256>
2022
2023 Compute the SHA256 hash (using the C<sha256sum> program).
2024
2025 =item C<sha384>
2026
2027 Compute the SHA384 hash (using the C<sha384sum> program).
2028
2029 =item C<sha512>
2030
2031 Compute the SHA512 hash (using the C<sha512sum> program).
2032
2033 =back
2034
2035 The checksum is returned as a printable string.");
2036
2037   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2038    [InitBasicFS, Always, TestOutput (
2039       [["tar_in"; "../images/helloworld.tar"; "/"];
2040        ["cat"; "/hello"]], "hello\n")],
2041    "unpack tarfile to directory",
2042    "\
2043 This command uploads and unpacks local file C<tarfile> (an
2044 I<uncompressed> tar file) into C<directory>.
2045
2046 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2047
2048   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2049    [],
2050    "pack directory into tarfile",
2051    "\
2052 This command packs the contents of C<directory> and downloads
2053 it to local file C<tarfile>.
2054
2055 To download a compressed tarball, use C<guestfs_tgz_out>.");
2056
2057   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2058    [InitBasicFS, Always, TestOutput (
2059       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2060        ["cat"; "/hello"]], "hello\n")],
2061    "unpack compressed tarball to directory",
2062    "\
2063 This command uploads and unpacks local file C<tarball> (a
2064 I<gzip compressed> tar file) into C<directory>.
2065
2066 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2067
2068   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2069    [],
2070    "pack directory into compressed tarball",
2071    "\
2072 This command packs the contents of C<directory> and downloads
2073 it to local file C<tarball>.
2074
2075 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2076
2077   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2078    [InitBasicFS, Always, TestLastFail (
2079       [["umount"; "/"];
2080        ["mount_ro"; "/dev/sda1"; "/"];
2081        ["touch"; "/new"]]);
2082     InitBasicFS, Always, TestOutput (
2083       [["write_file"; "/new"; "data"; "0"];
2084        ["umount"; "/"];
2085        ["mount_ro"; "/dev/sda1"; "/"];
2086        ["cat"; "/new"]], "data")],
2087    "mount a guest disk, read-only",
2088    "\
2089 This is the same as the C<guestfs_mount> command, but it
2090 mounts the filesystem with the read-only (I<-o ro>) flag.");
2091
2092   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2093    [],
2094    "mount a guest disk with mount options",
2095    "\
2096 This is the same as the C<guestfs_mount> command, but it
2097 allows you to set the mount options as for the
2098 L<mount(8)> I<-o> flag.
2099
2100 If the C<options> parameter is an empty string, then
2101 no options are passed (all options default to whatever
2102 the filesystem uses).");
2103
2104   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2105    [],
2106    "mount a guest disk with mount options and vfstype",
2107    "\
2108 This is the same as the C<guestfs_mount> command, but it
2109 allows you to set both the mount options and the vfstype
2110 as for the L<mount(8)> I<-o> and I<-t> flags.");
2111
2112   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2113    [],
2114    "debugging and internals",
2115    "\
2116 The C<guestfs_debug> command exposes some internals of
2117 C<guestfsd> (the guestfs daemon) that runs inside the
2118 qemu subprocess.
2119
2120 There is no comprehensive help for this command.  You have
2121 to look at the file C<daemon/debug.c> in the libguestfs source
2122 to find out what you can do.");
2123
2124   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2125    [InitEmpty, Always, TestOutputList (
2126       [["part_disk"; "/dev/sda"; "mbr"];
2127        ["pvcreate"; "/dev/sda1"];
2128        ["vgcreate"; "VG"; "/dev/sda1"];
2129        ["lvcreate"; "LV1"; "VG"; "50"];
2130        ["lvcreate"; "LV2"; "VG"; "50"];
2131        ["lvremove"; "/dev/VG/LV1"];
2132        ["lvs"]], ["/dev/VG/LV2"]);
2133     InitEmpty, Always, TestOutputList (
2134       [["part_disk"; "/dev/sda"; "mbr"];
2135        ["pvcreate"; "/dev/sda1"];
2136        ["vgcreate"; "VG"; "/dev/sda1"];
2137        ["lvcreate"; "LV1"; "VG"; "50"];
2138        ["lvcreate"; "LV2"; "VG"; "50"];
2139        ["lvremove"; "/dev/VG"];
2140        ["lvs"]], []);
2141     InitEmpty, Always, TestOutputList (
2142       [["part_disk"; "/dev/sda"; "mbr"];
2143        ["pvcreate"; "/dev/sda1"];
2144        ["vgcreate"; "VG"; "/dev/sda1"];
2145        ["lvcreate"; "LV1"; "VG"; "50"];
2146        ["lvcreate"; "LV2"; "VG"; "50"];
2147        ["lvremove"; "/dev/VG"];
2148        ["vgs"]], ["VG"])],
2149    "remove an LVM logical volume",
2150    "\
2151 Remove an LVM logical volume C<device>, where C<device> is
2152 the path to the LV, such as C</dev/VG/LV>.
2153
2154 You can also remove all LVs in a volume group by specifying
2155 the VG name, C</dev/VG>.");
2156
2157   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2158    [InitEmpty, Always, TestOutputList (
2159       [["part_disk"; "/dev/sda"; "mbr"];
2160        ["pvcreate"; "/dev/sda1"];
2161        ["vgcreate"; "VG"; "/dev/sda1"];
2162        ["lvcreate"; "LV1"; "VG"; "50"];
2163        ["lvcreate"; "LV2"; "VG"; "50"];
2164        ["vgremove"; "VG"];
2165        ["lvs"]], []);
2166     InitEmpty, Always, TestOutputList (
2167       [["part_disk"; "/dev/sda"; "mbr"];
2168        ["pvcreate"; "/dev/sda1"];
2169        ["vgcreate"; "VG"; "/dev/sda1"];
2170        ["lvcreate"; "LV1"; "VG"; "50"];
2171        ["lvcreate"; "LV2"; "VG"; "50"];
2172        ["vgremove"; "VG"];
2173        ["vgs"]], [])],
2174    "remove an LVM volume group",
2175    "\
2176 Remove an LVM volume group C<vgname>, (for example C<VG>).
2177
2178 This also forcibly removes all logical volumes in the volume
2179 group (if any).");
2180
2181   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2182    [InitEmpty, Always, TestOutputListOfDevices (
2183       [["part_disk"; "/dev/sda"; "mbr"];
2184        ["pvcreate"; "/dev/sda1"];
2185        ["vgcreate"; "VG"; "/dev/sda1"];
2186        ["lvcreate"; "LV1"; "VG"; "50"];
2187        ["lvcreate"; "LV2"; "VG"; "50"];
2188        ["vgremove"; "VG"];
2189        ["pvremove"; "/dev/sda1"];
2190        ["lvs"]], []);
2191     InitEmpty, Always, TestOutputListOfDevices (
2192       [["part_disk"; "/dev/sda"; "mbr"];
2193        ["pvcreate"; "/dev/sda1"];
2194        ["vgcreate"; "VG"; "/dev/sda1"];
2195        ["lvcreate"; "LV1"; "VG"; "50"];
2196        ["lvcreate"; "LV2"; "VG"; "50"];
2197        ["vgremove"; "VG"];
2198        ["pvremove"; "/dev/sda1"];
2199        ["vgs"]], []);
2200     InitEmpty, Always, TestOutputListOfDevices (
2201       [["part_disk"; "/dev/sda"; "mbr"];
2202        ["pvcreate"; "/dev/sda1"];
2203        ["vgcreate"; "VG"; "/dev/sda1"];
2204        ["lvcreate"; "LV1"; "VG"; "50"];
2205        ["lvcreate"; "LV2"; "VG"; "50"];
2206        ["vgremove"; "VG"];
2207        ["pvremove"; "/dev/sda1"];
2208        ["pvs"]], [])],
2209    "remove an LVM physical volume",
2210    "\
2211 This wipes a physical volume C<device> so that LVM will no longer
2212 recognise it.
2213
2214 The implementation uses the C<pvremove> command which refuses to
2215 wipe physical volumes that contain any volume groups, so you have
2216 to remove those first.");
2217
2218   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2219    [InitBasicFS, Always, TestOutput (
2220       [["set_e2label"; "/dev/sda1"; "testlabel"];
2221        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2222    "set the ext2/3/4 filesystem label",
2223    "\
2224 This sets the ext2/3/4 filesystem label of the filesystem on
2225 C<device> to C<label>.  Filesystem labels are limited to
2226 16 characters.
2227
2228 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2229 to return the existing label on a filesystem.");
2230
2231   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2232    [],
2233    "get the ext2/3/4 filesystem label",
2234    "\
2235 This returns the ext2/3/4 filesystem label of the filesystem on
2236 C<device>.");
2237
2238   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2239    (let uuid = uuidgen () in
2240     [InitBasicFS, Always, TestOutput (
2241        [["set_e2uuid"; "/dev/sda1"; uuid];
2242         ["get_e2uuid"; "/dev/sda1"]], uuid);
2243      InitBasicFS, Always, TestOutput (
2244        [["set_e2uuid"; "/dev/sda1"; "clear"];
2245         ["get_e2uuid"; "/dev/sda1"]], "");
2246      (* We can't predict what UUIDs will be, so just check the commands run. *)
2247      InitBasicFS, Always, TestRun (
2248        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2249      InitBasicFS, Always, TestRun (
2250        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2251    "set the ext2/3/4 filesystem UUID",
2252    "\
2253 This sets the ext2/3/4 filesystem UUID of the filesystem on
2254 C<device> to C<uuid>.  The format of the UUID and alternatives
2255 such as C<clear>, C<random> and C<time> are described in the
2256 L<tune2fs(8)> manpage.
2257
2258 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2259 to return the existing UUID of a filesystem.");
2260
2261   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2262    [],
2263    "get the ext2/3/4 filesystem UUID",
2264    "\
2265 This returns the ext2/3/4 filesystem UUID of the filesystem on
2266 C<device>.");
2267
2268   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2269    [InitBasicFS, Always, TestOutputInt (
2270       [["umount"; "/dev/sda1"];
2271        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2272     InitBasicFS, Always, TestOutputInt (
2273       [["umount"; "/dev/sda1"];
2274        ["zero"; "/dev/sda1"];
2275        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2276    "run the filesystem checker",
2277    "\
2278 This runs the filesystem checker (fsck) on C<device> which
2279 should have filesystem type C<fstype>.
2280
2281 The returned integer is the status.  See L<fsck(8)> for the
2282 list of status codes from C<fsck>.
2283
2284 Notes:
2285
2286 =over 4
2287
2288 =item *
2289
2290 Multiple status codes can be summed together.
2291
2292 =item *
2293
2294 A non-zero return code can mean \"success\", for example if
2295 errors have been corrected on the filesystem.
2296
2297 =item *
2298
2299 Checking or repairing NTFS volumes is not supported
2300 (by linux-ntfs).
2301
2302 =back
2303
2304 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2305
2306   ("zero", (RErr, [Device "device"]), 85, [],
2307    [InitBasicFS, Always, TestOutput (
2308       [["umount"; "/dev/sda1"];
2309        ["zero"; "/dev/sda1"];
2310        ["file"; "/dev/sda1"]], "data")],
2311    "write zeroes to the device",
2312    "\
2313 This command writes zeroes over the first few blocks of C<device>.
2314
2315 How many blocks are zeroed isn't specified (but it's I<not> enough
2316 to securely wipe the device).  It should be sufficient to remove
2317 any partition tables, filesystem superblocks and so on.
2318
2319 See also: C<guestfs_scrub_device>.");
2320
2321   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2322    (* Test disabled because grub-install incompatible with virtio-blk driver.
2323     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2324     *)
2325    [InitBasicFS, Disabled, TestOutputTrue (
2326       [["grub_install"; "/"; "/dev/sda1"];
2327        ["is_dir"; "/boot"]])],
2328    "install GRUB",
2329    "\
2330 This command installs GRUB (the Grand Unified Bootloader) on
2331 C<device>, with the root directory being C<root>.
2332
2333 Note: If grub-install reports the error
2334 \"No suitable drive was found in the generated device map.\"
2335 it may be that you need to create a C</boot/grub/device.map>
2336 file first that contains the mapping between grub device names
2337 and Linux device names.  It is usually sufficient to create
2338 a file containing:
2339
2340  (hd0) /dev/vda
2341
2342 replacing C</dev/vda> with the name of the installation device.");
2343
2344   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2345    [InitBasicFS, Always, TestOutput (
2346       [["write_file"; "/old"; "file content"; "0"];
2347        ["cp"; "/old"; "/new"];
2348        ["cat"; "/new"]], "file content");
2349     InitBasicFS, Always, TestOutputTrue (
2350       [["write_file"; "/old"; "file content"; "0"];
2351        ["cp"; "/old"; "/new"];
2352        ["is_file"; "/old"]]);
2353     InitBasicFS, Always, TestOutput (
2354       [["write_file"; "/old"; "file content"; "0"];
2355        ["mkdir"; "/dir"];
2356        ["cp"; "/old"; "/dir/new"];
2357        ["cat"; "/dir/new"]], "file content")],
2358    "copy a file",
2359    "\
2360 This copies a file from C<src> to C<dest> where C<dest> is
2361 either a destination filename or destination directory.");
2362
2363   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2364    [InitBasicFS, Always, TestOutput (
2365       [["mkdir"; "/olddir"];
2366        ["mkdir"; "/newdir"];
2367        ["write_file"; "/olddir/file"; "file content"; "0"];
2368        ["cp_a"; "/olddir"; "/newdir"];
2369        ["cat"; "/newdir/olddir/file"]], "file content")],
2370    "copy a file or directory recursively",
2371    "\
2372 This copies a file or directory from C<src> to C<dest>
2373 recursively using the C<cp -a> command.");
2374
2375   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2376    [InitBasicFS, Always, TestOutput (
2377       [["write_file"; "/old"; "file content"; "0"];
2378        ["mv"; "/old"; "/new"];
2379        ["cat"; "/new"]], "file content");
2380     InitBasicFS, Always, TestOutputFalse (
2381       [["write_file"; "/old"; "file content"; "0"];
2382        ["mv"; "/old"; "/new"];
2383        ["is_file"; "/old"]])],
2384    "move a file",
2385    "\
2386 This moves a file from C<src> to C<dest> where C<dest> is
2387 either a destination filename or destination directory.");
2388
2389   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2390    [InitEmpty, Always, TestRun (
2391       [["drop_caches"; "3"]])],
2392    "drop kernel page cache, dentries and inodes",
2393    "\
2394 This instructs the guest kernel to drop its page cache,
2395 and/or dentries and inode caches.  The parameter C<whattodrop>
2396 tells the kernel what precisely to drop, see
2397 L<http://linux-mm.org/Drop_Caches>
2398
2399 Setting C<whattodrop> to 3 should drop everything.
2400
2401 This automatically calls L<sync(2)> before the operation,
2402 so that the maximum guest memory is freed.");
2403
2404   ("dmesg", (RString "kmsgs", []), 91, [],
2405    [InitEmpty, Always, TestRun (
2406       [["dmesg"]])],
2407    "return kernel messages",
2408    "\
2409 This returns the kernel messages (C<dmesg> output) from
2410 the guest kernel.  This is sometimes useful for extended
2411 debugging of problems.
2412
2413 Another way to get the same information is to enable
2414 verbose messages with C<guestfs_set_verbose> or by setting
2415 the environment variable C<LIBGUESTFS_DEBUG=1> before
2416 running the program.");
2417
2418   ("ping_daemon", (RErr, []), 92, [],
2419    [InitEmpty, Always, TestRun (
2420       [["ping_daemon"]])],
2421    "ping the guest daemon",
2422    "\
2423 This is a test probe into the guestfs daemon running inside
2424 the qemu subprocess.  Calling this function checks that the
2425 daemon responds to the ping message, without affecting the daemon
2426 or attached block device(s) in any other way.");
2427
2428   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2429    [InitBasicFS, Always, TestOutputTrue (
2430       [["write_file"; "/file1"; "contents of a file"; "0"];
2431        ["cp"; "/file1"; "/file2"];
2432        ["equal"; "/file1"; "/file2"]]);
2433     InitBasicFS, Always, TestOutputFalse (
2434       [["write_file"; "/file1"; "contents of a file"; "0"];
2435        ["write_file"; "/file2"; "contents of another file"; "0"];
2436        ["equal"; "/file1"; "/file2"]]);
2437     InitBasicFS, Always, TestLastFail (
2438       [["equal"; "/file1"; "/file2"]])],
2439    "test if two files have equal contents",
2440    "\
2441 This compares the two files C<file1> and C<file2> and returns
2442 true if their content is exactly equal, or false otherwise.
2443
2444 The external L<cmp(1)> program is used for the comparison.");
2445
2446   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2447    [InitISOFS, Always, TestOutputList (
2448       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2449     InitISOFS, Always, TestOutputList (
2450       [["strings"; "/empty"]], [])],
2451    "print the printable strings in a file",
2452    "\
2453 This runs the L<strings(1)> command on a file and returns
2454 the list of printable strings found.");
2455
2456   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2457    [InitISOFS, Always, TestOutputList (
2458       [["strings_e"; "b"; "/known-5"]], []);
2459     InitBasicFS, Disabled, TestOutputList (
2460       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2461        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2462    "print the printable strings in a file",
2463    "\
2464 This is like the C<guestfs_strings> command, but allows you to
2465 specify the encoding of strings that are looked for in
2466 the source file C<path>.
2467
2468 Allowed encodings are:
2469
2470 =over 4
2471
2472 =item s
2473
2474 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2475 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2476
2477 =item S
2478
2479 Single 8-bit-byte characters.
2480
2481 =item b
2482
2483 16-bit big endian strings such as those encoded in
2484 UTF-16BE or UCS-2BE.
2485
2486 =item l (lower case letter L)
2487
2488 16-bit little endian such as UTF-16LE and UCS-2LE.
2489 This is useful for examining binaries in Windows guests.
2490
2491 =item B
2492
2493 32-bit big endian such as UCS-4BE.
2494
2495 =item L
2496
2497 32-bit little endian such as UCS-4LE.
2498
2499 =back
2500
2501 The returned strings are transcoded to UTF-8.");
2502
2503   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2504    [InitISOFS, Always, TestOutput (
2505       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2506     (* Test for RHBZ#501888c2 regression which caused large hexdump
2507      * commands to segfault.
2508      *)
2509     InitISOFS, Always, TestRun (
2510       [["hexdump"; "/100krandom"]])],
2511    "dump a file in hexadecimal",
2512    "\
2513 This runs C<hexdump -C> on the given C<path>.  The result is
2514 the human-readable, canonical hex dump of the file.");
2515
2516   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2517    [InitNone, Always, TestOutput (
2518       [["part_disk"; "/dev/sda"; "mbr"];
2519        ["mkfs"; "ext3"; "/dev/sda1"];
2520        ["mount_options"; ""; "/dev/sda1"; "/"];
2521        ["write_file"; "/new"; "test file"; "0"];
2522        ["umount"; "/dev/sda1"];
2523        ["zerofree"; "/dev/sda1"];
2524        ["mount_options"; ""; "/dev/sda1"; "/"];
2525        ["cat"; "/new"]], "test file")],
2526    "zero unused inodes and disk blocks on ext2/3 filesystem",
2527    "\
2528 This runs the I<zerofree> program on C<device>.  This program
2529 claims to zero unused inodes and disk blocks on an ext2/3
2530 filesystem, thus making it possible to compress the filesystem
2531 more effectively.
2532
2533 You should B<not> run this program if the filesystem is
2534 mounted.
2535
2536 It is possible that using this program can damage the filesystem
2537 or data on the filesystem.");
2538
2539   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2540    [],
2541    "resize an LVM physical volume",
2542    "\
2543 This resizes (expands or shrinks) an existing LVM physical
2544 volume to match the new size of the underlying device.");
2545
2546   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2547                        Int "cyls"; Int "heads"; Int "sectors";
2548                        String "line"]), 99, [DangerWillRobinson],
2549    [],
2550    "modify a single partition on a block device",
2551    "\
2552 This runs L<sfdisk(8)> option to modify just the single
2553 partition C<n> (note: C<n> counts from 1).
2554
2555 For other parameters, see C<guestfs_sfdisk>.  You should usually
2556 pass C<0> for the cyls/heads/sectors parameters.
2557
2558 See also: C<guestfs_part_add>");
2559
2560   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2561    [],
2562    "display the partition table",
2563    "\
2564 This displays the partition table on C<device>, in the
2565 human-readable output of the L<sfdisk(8)> command.  It is
2566 not intended to be parsed.
2567
2568 See also: C<guestfs_part_list>");
2569
2570   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2571    [],
2572    "display the kernel geometry",
2573    "\
2574 This displays the kernel's idea of the geometry of C<device>.
2575
2576 The result is in human-readable format, and not designed to
2577 be parsed.");
2578
2579   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2580    [],
2581    "display the disk geometry from the partition table",
2582    "\
2583 This displays the disk geometry of C<device> read from the
2584 partition table.  Especially in the case where the underlying
2585 block device has been resized, this can be different from the
2586 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2587
2588 The result is in human-readable format, and not designed to
2589 be parsed.");
2590
2591   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2592    [],
2593    "activate or deactivate all volume groups",
2594    "\
2595 This command activates or (if C<activate> is false) deactivates
2596 all logical volumes in all volume groups.
2597 If activated, then they are made known to the
2598 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2599 then those devices disappear.
2600
2601 This command is the same as running C<vgchange -a y|n>");
2602
2603   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2604    [],
2605    "activate or deactivate some volume groups",
2606    "\
2607 This command activates or (if C<activate> is false) deactivates
2608 all logical volumes in the listed volume groups C<volgroups>.
2609 If activated, then they are made known to the
2610 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2611 then those devices disappear.
2612
2613 This command is the same as running C<vgchange -a y|n volgroups...>
2614
2615 Note that if C<volgroups> is an empty list then B<all> volume groups
2616 are activated or deactivated.");
2617
2618   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2619    [InitNone, Always, TestOutput (
2620       [["part_disk"; "/dev/sda"; "mbr"];
2621        ["pvcreate"; "/dev/sda1"];
2622        ["vgcreate"; "VG"; "/dev/sda1"];
2623        ["lvcreate"; "LV"; "VG"; "10"];
2624        ["mkfs"; "ext2"; "/dev/VG/LV"];
2625        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2626        ["write_file"; "/new"; "test content"; "0"];
2627        ["umount"; "/"];
2628        ["lvresize"; "/dev/VG/LV"; "20"];
2629        ["e2fsck_f"; "/dev/VG/LV"];
2630        ["resize2fs"; "/dev/VG/LV"];
2631        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2632        ["cat"; "/new"]], "test content");
2633     InitNone, Always, TestRun (
2634       (* Make an LV smaller to test RHBZ#587484. *)
2635       [["part_disk"; "/dev/sda"; "mbr"];
2636        ["pvcreate"; "/dev/sda1"];
2637        ["vgcreate"; "VG"; "/dev/sda1"];
2638        ["lvcreate"; "LV"; "VG"; "20"];
2639        ["lvresize"; "/dev/VG/LV"; "10"]])],
2640    "resize an LVM logical volume",
2641    "\
2642 This resizes (expands or shrinks) an existing LVM logical
2643 volume to C<mbytes>.  When reducing, data in the reduced part
2644 is lost.");
2645
2646   ("resize2fs", (RErr, [Device "device"]), 106, [],
2647    [], (* lvresize tests this *)
2648    "resize an ext2, ext3 or ext4 filesystem",
2649    "\
2650 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2651 the underlying device.
2652
2653 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2654 on the C<device> before calling this command.  For unknown reasons
2655 C<resize2fs> sometimes gives an error about this and sometimes not.
2656 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2657 calling this function.");
2658
2659   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2660    [InitBasicFS, Always, TestOutputList (
2661       [["find"; "/"]], ["lost+found"]);
2662     InitBasicFS, Always, TestOutputList (
2663       [["touch"; "/a"];
2664        ["mkdir"; "/b"];
2665        ["touch"; "/b/c"];
2666        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2667     InitBasicFS, Always, TestOutputList (
2668       [["mkdir_p"; "/a/b/c"];
2669        ["touch"; "/a/b/c/d"];
2670        ["find"; "/a/b/"]], ["c"; "c/d"])],
2671    "find all files and directories",
2672    "\
2673 This command lists out all files and directories, recursively,
2674 starting at C<directory>.  It is essentially equivalent to
2675 running the shell command C<find directory -print> but some
2676 post-processing happens on the output, described below.
2677
2678 This returns a list of strings I<without any prefix>.  Thus
2679 if the directory structure was:
2680
2681  /tmp/a
2682  /tmp/b
2683  /tmp/c/d
2684
2685 then the returned list from C<guestfs_find> C</tmp> would be
2686 4 elements:
2687
2688  a
2689  b
2690  c
2691  c/d
2692
2693 If C<directory> is not a directory, then this command returns
2694 an error.
2695
2696 The returned list is sorted.
2697
2698 See also C<guestfs_find0>.");
2699
2700   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2701    [], (* lvresize tests this *)
2702    "check an ext2/ext3 filesystem",
2703    "\
2704 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2705 filesystem checker on C<device>, noninteractively (C<-p>),
2706 even if the filesystem appears to be clean (C<-f>).
2707
2708 This command is only needed because of C<guestfs_resize2fs>
2709 (q.v.).  Normally you should use C<guestfs_fsck>.");
2710
2711   ("sleep", (RErr, [Int "secs"]), 109, [],
2712    [InitNone, Always, TestRun (
2713       [["sleep"; "1"]])],
2714    "sleep for some seconds",
2715    "\
2716 Sleep for C<secs> seconds.");
2717
2718   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2719    [InitNone, Always, TestOutputInt (
2720       [["part_disk"; "/dev/sda"; "mbr"];
2721        ["mkfs"; "ntfs"; "/dev/sda1"];
2722        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2723     InitNone, Always, TestOutputInt (
2724       [["part_disk"; "/dev/sda"; "mbr"];
2725        ["mkfs"; "ext2"; "/dev/sda1"];
2726        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2727    "probe NTFS volume",
2728    "\
2729 This command runs the L<ntfs-3g.probe(8)> command which probes
2730 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2731 be mounted read-write, and some cannot be mounted at all).
2732
2733 C<rw> is a boolean flag.  Set it to true if you want to test
2734 if the volume can be mounted read-write.  Set it to false if
2735 you want to test if the volume can be mounted read-only.
2736
2737 The return value is an integer which C<0> if the operation
2738 would succeed, or some non-zero value documented in the
2739 L<ntfs-3g.probe(8)> manual page.");
2740
2741   ("sh", (RString "output", [String "command"]), 111, [],
2742    [], (* XXX needs tests *)
2743    "run a command via the shell",
2744    "\
2745 This call runs a command from the guest filesystem via the
2746 guest's C</bin/sh>.
2747
2748 This is like C<guestfs_command>, but passes the command to:
2749
2750  /bin/sh -c \"command\"
2751
2752 Depending on the guest's shell, this usually results in
2753 wildcards being expanded, shell expressions being interpolated
2754 and so on.
2755
2756 All the provisos about C<guestfs_command> apply to this call.");
2757
2758   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2759    [], (* XXX needs tests *)
2760    "run a command via the shell returning lines",
2761    "\
2762 This is the same as C<guestfs_sh>, but splits the result
2763 into a list of lines.
2764
2765 See also: C<guestfs_command_lines>");
2766
2767   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2768    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2769     * code in stubs.c, since all valid glob patterns must start with "/".
2770     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2771     *)
2772    [InitBasicFS, Always, TestOutputList (
2773       [["mkdir_p"; "/a/b/c"];
2774        ["touch"; "/a/b/c/d"];
2775        ["touch"; "/a/b/c/e"];
2776        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2777     InitBasicFS, Always, TestOutputList (
2778       [["mkdir_p"; "/a/b/c"];
2779        ["touch"; "/a/b/c/d"];
2780        ["touch"; "/a/b/c/e"];
2781        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2782     InitBasicFS, Always, TestOutputList (
2783       [["mkdir_p"; "/a/b/c"];
2784        ["touch"; "/a/b/c/d"];
2785        ["touch"; "/a/b/c/e"];
2786        ["glob_expand"; "/a/*/x/*"]], [])],
2787    "expand a wildcard path",
2788    "\
2789 This command searches for all the pathnames matching
2790 C<pattern> according to the wildcard expansion rules
2791 used by the shell.
2792
2793 If no paths match, then this returns an empty list
2794 (note: not an error).
2795
2796 It is just a wrapper around the C L<glob(3)> function
2797 with flags C<GLOB_MARK|GLOB_BRACE>.
2798 See that manual page for more details.");
2799
2800   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2801    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2802       [["scrub_device"; "/dev/sdc"]])],
2803    "scrub (securely wipe) a device",
2804    "\
2805 This command writes patterns over C<device> to make data retrieval
2806 more difficult.
2807
2808 It is an interface to the L<scrub(1)> program.  See that
2809 manual page for more details.");
2810
2811   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2812    [InitBasicFS, Always, TestRun (
2813       [["write_file"; "/file"; "content"; "0"];
2814        ["scrub_file"; "/file"]])],
2815    "scrub (securely wipe) a file",
2816    "\
2817 This command writes patterns over a file to make data retrieval
2818 more difficult.
2819
2820 The file is I<removed> after scrubbing.
2821
2822 It is an interface to the L<scrub(1)> program.  See that
2823 manual page for more details.");
2824
2825   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2826    [], (* XXX needs testing *)
2827    "scrub (securely wipe) free space",
2828    "\
2829 This command creates the directory C<dir> and then fills it
2830 with files until the filesystem is full, and scrubs the files
2831 as for C<guestfs_scrub_file>, and deletes them.
2832 The intention is to scrub any free space on the partition
2833 containing C<dir>.
2834
2835 It is an interface to the L<scrub(1)> program.  See that
2836 manual page for more details.");
2837
2838   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2839    [InitBasicFS, Always, TestRun (
2840       [["mkdir"; "/tmp"];
2841        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2842    "create a temporary directory",
2843    "\
2844 This command creates a temporary directory.  The
2845 C<template> parameter should be a full pathname for the
2846 temporary directory name with the final six characters being
2847 \"XXXXXX\".
2848
2849 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2850 the second one being suitable for Windows filesystems.
2851
2852 The name of the temporary directory that was created
2853 is returned.
2854
2855 The temporary directory is created with mode 0700
2856 and is owned by root.
2857
2858 The caller is responsible for deleting the temporary
2859 directory and its contents after use.
2860
2861 See also: L<mkdtemp(3)>");
2862
2863   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2864    [InitISOFS, Always, TestOutputInt (
2865       [["wc_l"; "/10klines"]], 10000)],
2866    "count lines in a file",
2867    "\
2868 This command counts the lines in a file, using the
2869 C<wc -l> external command.");
2870
2871   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2872    [InitISOFS, Always, TestOutputInt (
2873       [["wc_w"; "/10klines"]], 10000)],
2874    "count words in a file",
2875    "\
2876 This command counts the words in a file, using the
2877 C<wc -w> external command.");
2878
2879   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2880    [InitISOFS, Always, TestOutputInt (
2881       [["wc_c"; "/100kallspaces"]], 102400)],
2882    "count characters in a file",
2883    "\
2884 This command counts the characters in a file, using the
2885 C<wc -c> external command.");
2886
2887   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2888    [InitISOFS, Always, TestOutputList (
2889       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2890    "return first 10 lines of a file",
2891    "\
2892 This command returns up to the first 10 lines of a file as
2893 a list of strings.");
2894
2895   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2896    [InitISOFS, Always, TestOutputList (
2897       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2898     InitISOFS, Always, TestOutputList (
2899       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2900     InitISOFS, Always, TestOutputList (
2901       [["head_n"; "0"; "/10klines"]], [])],
2902    "return first N lines of a file",
2903    "\
2904 If the parameter C<nrlines> is a positive number, this returns the first
2905 C<nrlines> lines of the file C<path>.
2906
2907 If the parameter C<nrlines> is a negative number, this returns lines
2908 from the file C<path>, excluding the last C<nrlines> lines.
2909
2910 If the parameter C<nrlines> is zero, this returns an empty list.");
2911
2912   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2913    [InitISOFS, Always, TestOutputList (
2914       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2915    "return last 10 lines of a file",
2916    "\
2917 This command returns up to the last 10 lines of a file as
2918 a list of strings.");
2919
2920   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2921    [InitISOFS, Always, TestOutputList (
2922       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2923     InitISOFS, Always, TestOutputList (
2924       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2925     InitISOFS, Always, TestOutputList (
2926       [["tail_n"; "0"; "/10klines"]], [])],
2927    "return last N lines of a file",
2928    "\
2929 If the parameter C<nrlines> is a positive number, this returns the last
2930 C<nrlines> lines of the file C<path>.
2931
2932 If the parameter C<nrlines> is a negative number, this returns lines
2933 from the file C<path>, starting with the C<-nrlines>th line.
2934
2935 If the parameter C<nrlines> is zero, this returns an empty list.");
2936
2937   ("df", (RString "output", []), 125, [],
2938    [], (* XXX Tricky to test because it depends on the exact format
2939         * of the 'df' command and other imponderables.
2940         *)
2941    "report file system disk space usage",
2942    "\
2943 This command runs the C<df> command to report disk space used.
2944
2945 This command is mostly useful for interactive sessions.  It
2946 is I<not> intended that you try to parse the output string.
2947 Use C<statvfs> from programs.");
2948
2949   ("df_h", (RString "output", []), 126, [],
2950    [], (* XXX Tricky to test because it depends on the exact format
2951         * of the 'df' command and other imponderables.
2952         *)
2953    "report file system disk space usage (human readable)",
2954    "\
2955 This command runs the C<df -h> command to report disk space used
2956 in human-readable format.
2957
2958 This command is mostly useful for interactive sessions.  It
2959 is I<not> intended that you try to parse the output string.
2960 Use C<statvfs> from programs.");
2961
2962   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2963    [InitISOFS, Always, TestOutputInt (
2964       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2965    "estimate file space usage",
2966    "\
2967 This command runs the C<du -s> command to estimate file space
2968 usage for C<path>.
2969
2970 C<path> can be a file or a directory.  If C<path> is a directory
2971 then the estimate includes the contents of the directory and all
2972 subdirectories (recursively).
2973
2974 The result is the estimated size in I<kilobytes>
2975 (ie. units of 1024 bytes).");
2976
2977   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2978    [InitISOFS, Always, TestOutputList (
2979       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2980    "list files in an initrd",
2981    "\
2982 This command lists out files contained in an initrd.
2983
2984 The files are listed without any initial C</> character.  The
2985 files are listed in the order they appear (not necessarily
2986 alphabetical).  Directory names are listed as separate items.
2987
2988 Old Linux kernels (2.4 and earlier) used a compressed ext2
2989 filesystem as initrd.  We I<only> support the newer initramfs
2990 format (compressed cpio files).");
2991
2992   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2993    [],
2994    "mount a file using the loop device",
2995    "\
2996 This command lets you mount C<file> (a filesystem image
2997 in a file) on a mount point.  It is entirely equivalent to
2998 the command C<mount -o loop file mountpoint>.");
2999
3000   ("mkswap", (RErr, [Device "device"]), 130, [],
3001    [InitEmpty, Always, TestRun (
3002       [["part_disk"; "/dev/sda"; "mbr"];
3003        ["mkswap"; "/dev/sda1"]])],
3004    "create a swap partition",
3005    "\
3006 Create a swap partition on C<device>.");
3007
3008   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3009    [InitEmpty, Always, TestRun (
3010       [["part_disk"; "/dev/sda"; "mbr"];
3011        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3012    "create a swap partition with a label",
3013    "\
3014 Create a swap partition on C<device> with label C<label>.
3015
3016 Note that you cannot attach a swap label to a block device
3017 (eg. C</dev/sda>), just to a partition.  This appears to be
3018 a limitation of the kernel or swap tools.");
3019
3020   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3021    (let uuid = uuidgen () in
3022     [InitEmpty, Always, TestRun (
3023        [["part_disk"; "/dev/sda"; "mbr"];
3024         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3025    "create a swap partition with an explicit UUID",
3026    "\
3027 Create a swap partition on C<device> with UUID C<uuid>.");
3028
3029   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3030    [InitBasicFS, Always, TestOutputStruct (
3031       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3032        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3033        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3034     InitBasicFS, Always, TestOutputStruct (
3035       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3036        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3037    "make block, character or FIFO devices",
3038    "\
3039 This call creates block or character special devices, or
3040 named pipes (FIFOs).
3041
3042 The C<mode> parameter should be the mode, using the standard
3043 constants.  C<devmajor> and C<devminor> are the
3044 device major and minor numbers, only used when creating block
3045 and character special devices.
3046
3047 Note that, just like L<mknod(2)>, the mode must be bitwise
3048 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3049 just creates a regular file).  These constants are
3050 available in the standard Linux header files, or you can use
3051 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3052 which are wrappers around this command which bitwise OR
3053 in the appropriate constant for you.
3054
3055 The mode actually set is affected by the umask.");
3056
3057   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3058    [InitBasicFS, Always, TestOutputStruct (
3059       [["mkfifo"; "0o777"; "/node"];
3060        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3061    "make FIFO (named pipe)",
3062    "\
3063 This call creates a FIFO (named pipe) called C<path> with
3064 mode C<mode>.  It is just a convenient wrapper around
3065 C<guestfs_mknod>.
3066
3067 The mode actually set is affected by the umask.");
3068
3069   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3070    [InitBasicFS, Always, TestOutputStruct (
3071       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3072        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3073    "make block device node",
3074    "\
3075 This call creates a block device node called C<path> with
3076 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3077 It is just a convenient wrapper around C<guestfs_mknod>.
3078
3079 The mode actually set is affected by the umask.");
3080
3081   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3082    [InitBasicFS, Always, TestOutputStruct (
3083       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3084        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3085    "make char device node",
3086    "\
3087 This call creates a char device node called C<path> with
3088 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3089 It is just a convenient wrapper around C<guestfs_mknod>.
3090
3091 The mode actually set is affected by the umask.");
3092
3093   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3094    [InitEmpty, Always, TestOutputInt (
3095       [["umask"; "0o22"]], 0o22)],
3096    "set file mode creation mask (umask)",
3097    "\
3098 This function sets the mask used for creating new files and
3099 device nodes to C<mask & 0777>.
3100
3101 Typical umask values would be C<022> which creates new files
3102 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3103 C<002> which creates new files with permissions like
3104 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3105
3106 The default umask is C<022>.  This is important because it
3107 means that directories and device nodes will be created with
3108 C<0644> or C<0755> mode even if you specify C<0777>.
3109
3110 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3111
3112 This call returns the previous umask.");
3113
3114   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3115    [],
3116    "read directories entries",
3117    "\
3118 This returns the list of directory entries in directory C<dir>.
3119
3120 All entries in the directory are returned, including C<.> and
3121 C<..>.  The entries are I<not> sorted, but returned in the same
3122 order as the underlying filesystem.
3123
3124 Also this call returns basic file type information about each
3125 file.  The C<ftyp> field will contain one of the following characters:
3126
3127 =over 4
3128
3129 =item 'b'
3130
3131 Block special
3132
3133 =item 'c'
3134
3135 Char special
3136
3137 =item 'd'
3138
3139 Directory
3140
3141 =item 'f'
3142
3143 FIFO (named pipe)
3144
3145 =item 'l'
3146
3147 Symbolic link
3148
3149 =item 'r'
3150
3151 Regular file
3152
3153 =item 's'
3154
3155 Socket
3156
3157 =item 'u'
3158
3159 Unknown file type
3160
3161 =item '?'
3162
3163 The L<readdir(3)> call returned a C<d_type> field with an
3164 unexpected value
3165
3166 =back
3167
3168 This function is primarily intended for use by programs.  To
3169 get a simple list of names, use C<guestfs_ls>.  To get a printable
3170 directory for human consumption, use C<guestfs_ll>.");
3171
3172   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3173    [],
3174    "create partitions on a block device",
3175    "\
3176 This is a simplified interface to the C<guestfs_sfdisk>
3177 command, where partition sizes are specified in megabytes
3178 only (rounded to the nearest cylinder) and you don't need
3179 to specify the cyls, heads and sectors parameters which
3180 were rarely if ever used anyway.
3181
3182 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3183 and C<guestfs_part_disk>");
3184
3185   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3186    [],
3187    "determine file type inside a compressed file",
3188    "\
3189 This command runs C<file> after first decompressing C<path>
3190 using C<method>.
3191
3192 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3193
3194 Since 1.0.63, use C<guestfs_file> instead which can now
3195 process compressed files.");
3196
3197   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3198    [],
3199    "list extended attributes of a file or directory",
3200    "\
3201 This call lists the extended attributes of the file or directory
3202 C<path>.
3203
3204 At the system call level, this is a combination of the
3205 L<listxattr(2)> and L<getxattr(2)> calls.
3206
3207 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3208
3209   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3210    [],
3211    "list extended attributes of a file or directory",
3212    "\
3213 This is the same as C<guestfs_getxattrs>, but if C<path>
3214 is a symbolic link, then it returns the extended attributes
3215 of the link itself.");
3216
3217   ("setxattr", (RErr, [String "xattr";
3218                        String "val"; Int "vallen"; (* will be BufferIn *)
3219                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3220    [],
3221    "set extended attribute of a file or directory",
3222    "\
3223 This call sets the extended attribute named C<xattr>
3224 of the file C<path> to the value C<val> (of length C<vallen>).
3225 The value is arbitrary 8 bit data.
3226
3227 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3228
3229   ("lsetxattr", (RErr, [String "xattr";
3230                         String "val"; Int "vallen"; (* will be BufferIn *)
3231                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3232    [],
3233    "set extended attribute of a file or directory",
3234    "\
3235 This is the same as C<guestfs_setxattr>, but if C<path>
3236 is a symbolic link, then it sets an extended attribute
3237 of the link itself.");
3238
3239   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3240    [],
3241    "remove extended attribute of a file or directory",
3242    "\
3243 This call removes the extended attribute named C<xattr>
3244 of the file C<path>.
3245
3246 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3247
3248   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3249    [],
3250    "remove extended attribute of a file or directory",
3251    "\
3252 This is the same as C<guestfs_removexattr>, but if C<path>
3253 is a symbolic link, then it removes an extended attribute
3254 of the link itself.");
3255
3256   ("mountpoints", (RHashtable "mps", []), 147, [],
3257    [],
3258    "show mountpoints",
3259    "\
3260 This call is similar to C<guestfs_mounts>.  That call returns
3261 a list of devices.  This one returns a hash table (map) of
3262 device name to directory where the device is mounted.");
3263
3264   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3265    (* This is a special case: while you would expect a parameter
3266     * of type "Pathname", that doesn't work, because it implies
3267     * NEED_ROOT in the generated calling code in stubs.c, and
3268     * this function cannot use NEED_ROOT.
3269     *)
3270    [],
3271    "create a mountpoint",
3272    "\
3273 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3274 specialized calls that can be used to create extra mountpoints
3275 before mounting the first filesystem.
3276
3277 These calls are I<only> necessary in some very limited circumstances,
3278 mainly the case where you want to mount a mix of unrelated and/or
3279 read-only filesystems together.
3280
3281 For example, live CDs often contain a \"Russian doll\" nest of
3282 filesystems, an ISO outer layer, with a squashfs image inside, with
3283 an ext2/3 image inside that.  You can unpack this as follows
3284 in guestfish:
3285
3286  add-ro Fedora-11-i686-Live.iso
3287  run
3288  mkmountpoint /cd
3289  mkmountpoint /squash
3290  mkmountpoint /ext3
3291  mount /dev/sda /cd
3292  mount-loop /cd/LiveOS/squashfs.img /squash
3293  mount-loop /squash/LiveOS/ext3fs.img /ext3
3294
3295 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3296
3297   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3298    [],
3299    "remove a mountpoint",
3300    "\
3301 This calls removes a mountpoint that was previously created
3302 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3303 for full details.");
3304
3305   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3306    [InitISOFS, Always, TestOutputBuffer (
3307       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3308     (* Test various near large, large and too large files (RHBZ#589039). *)
3309     InitBasicFS, Always, TestLastFail (
3310       [["touch"; "/a"];
3311        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3312        ["read_file"; "/a"]]);
3313     InitBasicFS, Always, TestLastFail (
3314       [["touch"; "/a"];
3315        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3316        ["read_file"; "/a"]]);
3317     InitBasicFS, Always, TestLastFail (
3318       [["touch"; "/a"];
3319        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3320        ["read_file"; "/a"]])],
3321    "read a file",
3322    "\
3323 This calls returns the contents of the file C<path> as a
3324 buffer.
3325
3326 Unlike C<guestfs_cat>, this function can correctly
3327 handle files that contain embedded ASCII NUL characters.
3328 However unlike C<guestfs_download>, this function is limited
3329 in the total size of file that can be handled.");
3330
3331   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3332    [InitISOFS, Always, TestOutputList (
3333       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3334     InitISOFS, Always, TestOutputList (
3335       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3336    "return lines matching a pattern",
3337    "\
3338 This calls the external C<grep> program and returns the
3339 matching lines.");
3340
3341   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3342    [InitISOFS, Always, TestOutputList (
3343       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3344    "return lines matching a pattern",
3345    "\
3346 This calls the external C<egrep> program and returns the
3347 matching lines.");
3348
3349   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3350    [InitISOFS, Always, TestOutputList (
3351       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3352    "return lines matching a pattern",
3353    "\
3354 This calls the external C<fgrep> program and returns the
3355 matching lines.");
3356
3357   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3358    [InitISOFS, Always, TestOutputList (
3359       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3360    "return lines matching a pattern",
3361    "\
3362 This calls the external C<grep -i> program and returns the
3363 matching lines.");
3364
3365   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3366    [InitISOFS, Always, TestOutputList (
3367       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3368    "return lines matching a pattern",
3369    "\
3370 This calls the external C<egrep -i> program and returns the
3371 matching lines.");
3372
3373   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3374    [InitISOFS, Always, TestOutputList (
3375       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3376    "return lines matching a pattern",
3377    "\
3378 This calls the external C<fgrep -i> program and returns the
3379 matching lines.");
3380
3381   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3382    [InitISOFS, Always, TestOutputList (
3383       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3384    "return lines matching a pattern",
3385    "\
3386 This calls the external C<zgrep> program and returns the
3387 matching lines.");
3388
3389   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3390    [InitISOFS, Always, TestOutputList (
3391       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3392    "return lines matching a pattern",
3393    "\
3394 This calls the external C<zegrep> program and returns the
3395 matching lines.");
3396
3397   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3398    [InitISOFS, Always, TestOutputList (
3399       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3400    "return lines matching a pattern",
3401    "\
3402 This calls the external C<zfgrep> program and returns the
3403 matching lines.");
3404
3405   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3406    [InitISOFS, Always, TestOutputList (
3407       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3408    "return lines matching a pattern",
3409    "\
3410 This calls the external C<zgrep -i> program and returns the
3411 matching lines.");
3412
3413   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3414    [InitISOFS, Always, TestOutputList (
3415       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3416    "return lines matching a pattern",
3417    "\
3418 This calls the external C<zegrep -i> program and returns the
3419 matching lines.");
3420
3421   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3422    [InitISOFS, Always, TestOutputList (
3423       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3424    "return lines matching a pattern",
3425    "\
3426 This calls the external C<zfgrep -i> program and returns the
3427 matching lines.");
3428
3429   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3430    [InitISOFS, Always, TestOutput (
3431       [["realpath"; "/../directory"]], "/directory")],
3432    "canonicalized absolute pathname",
3433    "\
3434 Return the canonicalized absolute pathname of C<path>.  The
3435 returned path has no C<.>, C<..> or symbolic link path elements.");
3436
3437   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3438    [InitBasicFS, Always, TestOutputStruct (
3439       [["touch"; "/a"];
3440        ["ln"; "/a"; "/b"];
3441        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3442    "create a hard link",
3443    "\
3444 This command creates a hard link using the C<ln> command.");
3445
3446   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3447    [InitBasicFS, Always, TestOutputStruct (
3448       [["touch"; "/a"];
3449        ["touch"; "/b"];
3450        ["ln_f"; "/a"; "/b"];
3451        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3452    "create a hard link",
3453    "\
3454 This command creates a hard link using the C<ln -f> command.
3455 The C<-f> option removes the link (C<linkname>) if it exists already.");
3456
3457   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3458    [InitBasicFS, Always, TestOutputStruct (
3459       [["touch"; "/a"];
3460        ["ln_s"; "a"; "/b"];
3461        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3462    "create a symbolic link",
3463    "\
3464 This command creates a symbolic link using the C<ln -s> command.");
3465
3466   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3467    [InitBasicFS, Always, TestOutput (
3468       [["mkdir_p"; "/a/b"];
3469        ["touch"; "/a/b/c"];
3470        ["ln_sf"; "../d"; "/a/b/c"];
3471        ["readlink"; "/a/b/c"]], "../d")],
3472    "create a symbolic link",
3473    "\
3474 This command creates a symbolic link using the C<ln -sf> command,
3475 The C<-f> option removes the link (C<linkname>) if it exists already.");
3476
3477   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3478    [] (* XXX tested above *),
3479    "read the target of a symbolic link",
3480    "\
3481 This command reads the target of a symbolic link.");
3482
3483   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3484    [InitBasicFS, Always, TestOutputStruct (
3485       [["fallocate"; "/a"; "1000000"];
3486        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3487    "preallocate a file in the guest filesystem",
3488    "\
3489 This command preallocates a file (containing zero bytes) named
3490 C<path> of size C<len> bytes.  If the file exists already, it
3491 is overwritten.
3492
3493 Do not confuse this with the guestfish-specific
3494 C<alloc> command which allocates a file in the host and
3495 attaches it as a device.");
3496
3497   ("swapon_device", (RErr, [Device "device"]), 170, [],
3498    [InitPartition, Always, TestRun (
3499       [["mkswap"; "/dev/sda1"];
3500        ["swapon_device"; "/dev/sda1"];
3501        ["swapoff_device"; "/dev/sda1"]])],
3502    "enable swap on device",
3503    "\
3504 This command enables the libguestfs appliance to use the
3505 swap device or partition named C<device>.  The increased
3506 memory is made available for all commands, for example
3507 those run using C<guestfs_command> or C<guestfs_sh>.
3508
3509 Note that you should not swap to existing guest swap
3510 partitions unless you know what you are doing.  They may
3511 contain hibernation information, or other information that
3512 the guest doesn't want you to trash.  You also risk leaking
3513 information about the host to the guest this way.  Instead,
3514 attach a new host device to the guest and swap on that.");
3515
3516   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3517    [], (* XXX tested by swapon_device *)
3518    "disable swap on device",
3519    "\
3520 This command disables the libguestfs appliance swap
3521 device or partition named C<device>.
3522 See C<guestfs_swapon_device>.");
3523
3524   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3525    [InitBasicFS, Always, TestRun (
3526       [["fallocate"; "/swap"; "8388608"];
3527        ["mkswap_file"; "/swap"];
3528        ["swapon_file"; "/swap"];
3529        ["swapoff_file"; "/swap"]])],
3530    "enable swap on file",
3531    "\
3532 This command enables swap to a file.
3533 See C<guestfs_swapon_device> for other notes.");
3534
3535   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3536    [], (* XXX tested by swapon_file *)
3537    "disable swap on file",
3538    "\
3539 This command disables the libguestfs appliance swap on file.");
3540
3541   ("swapon_label", (RErr, [String "label"]), 174, [],
3542    [InitEmpty, Always, TestRun (
3543       [["part_disk"; "/dev/sdb"; "mbr"];
3544        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3545        ["swapon_label"; "swapit"];
3546        ["swapoff_label"; "swapit"];
3547        ["zero"; "/dev/sdb"];
3548        ["blockdev_rereadpt"; "/dev/sdb"]])],
3549    "enable swap on labeled swap partition",
3550    "\
3551 This command enables swap to a labeled swap partition.
3552 See C<guestfs_swapon_device> for other notes.");
3553
3554   ("swapoff_label", (RErr, [String "label"]), 175, [],
3555    [], (* XXX tested by swapon_label *)
3556    "disable swap on labeled swap partition",
3557    "\
3558 This command disables the libguestfs appliance swap on
3559 labeled swap partition.");
3560
3561   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3562    (let uuid = uuidgen () in
3563     [InitEmpty, Always, TestRun (
3564        [["mkswap_U"; uuid; "/dev/sdb"];
3565         ["swapon_uuid"; uuid];
3566         ["swapoff_uuid"; uuid]])]),
3567    "enable swap on swap partition by UUID",
3568    "\
3569 This command enables swap to a swap partition with the given UUID.
3570 See C<guestfs_swapon_device> for other notes.");
3571
3572   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3573    [], (* XXX tested by swapon_uuid *)
3574    "disable swap on swap partition by UUID",
3575    "\
3576 This command disables the libguestfs appliance swap partition
3577 with the given UUID.");
3578
3579   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3580    [InitBasicFS, Always, TestRun (
3581       [["fallocate"; "/swap"; "8388608"];
3582        ["mkswap_file"; "/swap"]])],
3583    "create a swap file",
3584    "\
3585 Create a swap file.
3586
3587 This command just writes a swap file signature to an existing
3588 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3589
3590   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3591    [InitISOFS, Always, TestRun (
3592       [["inotify_init"; "0"]])],
3593    "create an inotify handle",
3594    "\
3595 This command creates a new inotify handle.
3596 The inotify subsystem can be used to notify events which happen to
3597 objects in the guest filesystem.
3598
3599 C<maxevents> is the maximum number of events which will be
3600 queued up between calls to C<guestfs_inotify_read> or
3601 C<guestfs_inotify_files>.
3602 If this is passed as C<0>, then the kernel (or previously set)
3603 default is used.  For Linux 2.6.29 the default was 16384 events.
3604 Beyond this limit, the kernel throws away events, but records
3605 the fact that it threw them away by setting a flag
3606 C<IN_Q_OVERFLOW> in the returned structure list (see
3607 C<guestfs_inotify_read>).
3608
3609 Before any events are generated, you have to add some
3610 watches to the internal watch list.  See:
3611 C<guestfs_inotify_add_watch>,
3612 C<guestfs_inotify_rm_watch> and
3613 C<guestfs_inotify_watch_all>.
3614
3615 Queued up events should be read periodically by calling
3616 C<guestfs_inotify_read>
3617 (or C<guestfs_inotify_files> which is just a helpful
3618 wrapper around C<guestfs_inotify_read>).  If you don't
3619 read the events out often enough then you risk the internal
3620 queue overflowing.
3621
3622 The handle should be closed after use by calling
3623 C<guestfs_inotify_close>.  This also removes any
3624 watches automatically.
3625
3626 See also L<inotify(7)> for an overview of the inotify interface
3627 as exposed by the Linux kernel, which is roughly what we expose
3628 via libguestfs.  Note that there is one global inotify handle
3629 per libguestfs instance.");
3630
3631   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3632    [InitBasicFS, Always, TestOutputList (
3633       [["inotify_init"; "0"];
3634        ["inotify_add_watch"; "/"; "1073741823"];
3635        ["touch"; "/a"];
3636        ["touch"; "/b"];
3637        ["inotify_files"]], ["a"; "b"])],
3638    "add an inotify watch",
3639    "\
3640 Watch C<path> for the events listed in C<mask>.
3641
3642 Note that if C<path> is a directory then events within that
3643 directory are watched, but this does I<not> happen recursively
3644 (in subdirectories).
3645
3646 Note for non-C or non-Linux callers: the inotify events are
3647 defined by the Linux kernel ABI and are listed in
3648 C</usr/include/sys/inotify.h>.");
3649
3650   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3651    [],
3652    "remove an inotify watch",
3653    "\
3654 Remove a previously defined inotify watch.
3655 See C<guestfs_inotify_add_watch>.");
3656
3657   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3658    [],
3659    "return list of inotify events",
3660    "\
3661 Return the complete queue of events that have happened
3662 since the previous read call.
3663
3664 If no events have happened, this returns an empty list.
3665
3666 I<Note>: In order to make sure that all events have been
3667 read, you must call this function repeatedly until it
3668 returns an empty list.  The reason is that the call will
3669 read events up to the maximum appliance-to-host message
3670 size and leave remaining events in the queue.");
3671
3672   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3673    [],
3674    "return list of watched files that had events",
3675    "\
3676 This function is a helpful wrapper around C<guestfs_inotify_read>
3677 which just returns a list of pathnames of objects that were
3678 touched.  The returned pathnames are sorted and deduplicated.");
3679
3680   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3681    [],
3682    "close the inotify handle",
3683    "\
3684 This closes the inotify handle which was previously
3685 opened by inotify_init.  It removes all watches, throws
3686 away any pending events, and deallocates all resources.");
3687
3688   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3689    [],
3690    "set SELinux security context",
3691    "\
3692 This sets the SELinux security context of the daemon
3693 to the string C<context>.
3694
3695 See the documentation about SELINUX in L<guestfs(3)>.");
3696
3697   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3698    [],
3699    "get SELinux security context",
3700    "\
3701 This gets the SELinux security context of the daemon.
3702
3703 See the documentation about SELINUX in L<guestfs(3)>,
3704 and C<guestfs_setcon>");
3705
3706   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3707    [InitEmpty, Always, TestOutput (
3708       [["part_disk"; "/dev/sda"; "mbr"];
3709        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3710        ["mount_options"; ""; "/dev/sda1"; "/"];
3711        ["write_file"; "/new"; "new file contents"; "0"];
3712        ["cat"; "/new"]], "new file contents")],
3713    "make a filesystem with block size",
3714    "\
3715 This call is similar to C<guestfs_mkfs>, but it allows you to
3716 control the block size of the resulting filesystem.  Supported
3717 block sizes depend on the filesystem type, but typically they
3718 are C<1024>, C<2048> or C<4096> only.");
3719
3720   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3721    [InitEmpty, Always, TestOutput (
3722       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3723        ["mke2journal"; "4096"; "/dev/sda1"];
3724        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3725        ["mount_options"; ""; "/dev/sda2"; "/"];
3726        ["write_file"; "/new"; "new file contents"; "0"];
3727        ["cat"; "/new"]], "new file contents")],
3728    "make ext2/3/4 external journal",
3729    "\
3730 This creates an ext2 external journal on C<device>.  It is equivalent
3731 to the command:
3732
3733  mke2fs -O journal_dev -b blocksize device");
3734
3735   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3736    [InitEmpty, Always, TestOutput (
3737       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3738        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3739        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3740        ["mount_options"; ""; "/dev/sda2"; "/"];
3741        ["write_file"; "/new"; "new file contents"; "0"];
3742        ["cat"; "/new"]], "new file contents")],
3743    "make ext2/3/4 external journal with label",
3744    "\
3745 This creates an ext2 external journal on C<device> with label C<label>.");
3746
3747   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3748    (let uuid = uuidgen () in
3749     [InitEmpty, Always, TestOutput (
3750        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3751         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3752         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3753         ["mount_options"; ""; "/dev/sda2"; "/"];
3754         ["write_file"; "/new"; "new file contents"; "0"];
3755         ["cat"; "/new"]], "new file contents")]),
3756    "make ext2/3/4 external journal with UUID",
3757    "\
3758 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3759
3760   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3761    [],
3762    "make ext2/3/4 filesystem with external journal",
3763    "\
3764 This creates an ext2/3/4 filesystem on C<device> with
3765 an external journal on C<journal>.  It is equivalent
3766 to the command:
3767
3768  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3769
3770 See also C<guestfs_mke2journal>.");
3771
3772   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3773    [],
3774    "make ext2/3/4 filesystem with external journal",
3775    "\
3776 This creates an ext2/3/4 filesystem on C<device> with
3777 an external journal on the journal labeled C<label>.
3778
3779 See also C<guestfs_mke2journal_L>.");
3780
3781   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3782    [],
3783    "make ext2/3/4 filesystem with external journal",
3784    "\
3785 This creates an ext2/3/4 filesystem on C<device> with
3786 an external journal on the journal with UUID C<uuid>.
3787
3788 See also C<guestfs_mke2journal_U>.");
3789
3790   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3791    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3792    "load a kernel module",
3793    "\
3794 This loads a kernel module in the appliance.
3795
3796 The kernel module must have been whitelisted when libguestfs
3797 was built (see C<appliance/kmod.whitelist.in> in the source).");
3798
3799   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3800    [InitNone, Always, TestOutput (
3801       [["echo_daemon"; "This is a test"]], "This is a test"
3802     )],
3803    "echo arguments back to the client",
3804    "\
3805 This command concatenates the list of C<words> passed with single spaces
3806 between them and returns the resulting string.
3807
3808 You can use this command to test the connection through to the daemon.
3809
3810 See also C<guestfs_ping_daemon>.");
3811
3812   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3813    [], (* There is a regression test for this. *)
3814    "find all files and directories, returning NUL-separated list",
3815    "\
3816 This command lists out all files and directories, recursively,
3817 starting at C<directory>, placing the resulting list in the
3818 external file called C<files>.
3819
3820 This command works the same way as C<guestfs_find> with the
3821 following exceptions:
3822
3823 =over 4
3824
3825 =item *
3826
3827 The resulting list is written to an external file.
3828
3829 =item *
3830
3831 Items (filenames) in the result are separated
3832 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3833
3834 =item *
3835
3836 This command is not limited in the number of names that it
3837 can return.
3838
3839 =item *
3840
3841 The result list is not sorted.
3842
3843 =back");
3844
3845   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3846    [InitISOFS, Always, TestOutput (
3847       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3848     InitISOFS, Always, TestOutput (
3849       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3850     InitISOFS, Always, TestOutput (
3851       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3852     InitISOFS, Always, TestLastFail (
3853       [["case_sensitive_path"; "/Known-1/"]]);
3854     InitBasicFS, Always, TestOutput (
3855       [["mkdir"; "/a"];
3856        ["mkdir"; "/a/bbb"];
3857        ["touch"; "/a/bbb/c"];
3858        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3859     InitBasicFS, Always, TestOutput (
3860       [["mkdir"; "/a"];
3861        ["mkdir"; "/a/bbb"];
3862        ["touch"; "/a/bbb/c"];
3863        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3864     InitBasicFS, Always, TestLastFail (
3865       [["mkdir"; "/a"];
3866        ["mkdir"; "/a/bbb"];
3867        ["touch"; "/a/bbb/c"];
3868        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3869    "return true path on case-insensitive filesystem",
3870    "\
3871 This can be used to resolve case insensitive paths on
3872 a filesystem which is case sensitive.  The use case is
3873 to resolve paths which you have read from Windows configuration
3874 files or the Windows Registry, to the true path.
3875
3876 The command handles a peculiarity of the Linux ntfs-3g
3877 filesystem driver (and probably others), which is that although
3878 the underlying filesystem is case-insensitive, the driver
3879 exports the filesystem to Linux as case-sensitive.
3880
3881 One consequence of this is that special directories such
3882 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3883 (or other things) depending on the precise details of how
3884 they were created.  In Windows itself this would not be
3885 a problem.
3886
3887 Bug or feature?  You decide:
3888 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3889
3890 This function resolves the true case of each element in the
3891 path and returns the case-sensitive path.
3892
3893 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3894 might return C<\"/WINDOWS/system32\"> (the exact return value
3895 would depend on details of how the directories were originally
3896 created under Windows).
3897
3898 I<Note>:
3899 This function does not handle drive names, backslashes etc.
3900
3901 See also C<guestfs_realpath>.");
3902
3903   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3904    [InitBasicFS, Always, TestOutput (
3905       [["vfs_type"; "/dev/sda1"]], "ext2")],
3906    "get the Linux VFS type corresponding to a mounted device",
3907    "\
3908 This command gets the filesystem type corresponding to
3909 the filesystem on C<device>.
3910
3911 For most filesystems, the result is the name of the Linux
3912 VFS module which would be used to mount this filesystem
3913 if you mounted it without specifying the filesystem type.
3914 For example a string such as C<ext3> or C<ntfs>.");
3915
3916   ("truncate", (RErr, [Pathname "path"]), 199, [],
3917    [InitBasicFS, Always, TestOutputStruct (
3918       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3919        ["truncate"; "/test"];
3920        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3921    "truncate a file to zero size",
3922    "\
3923 This command truncates C<path> to a zero-length file.  The
3924 file must exist already.");
3925
3926   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3927    [InitBasicFS, Always, TestOutputStruct (
3928       [["touch"; "/test"];
3929        ["truncate_size"; "/test"; "1000"];
3930        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3931    "truncate a file to a particular size",
3932    "\
3933 This command truncates C<path> to size C<size> bytes.  The file
3934 must exist already.
3935
3936 If the current file size is less than C<size> then
3937 the file is extended to the required size with zero bytes.
3938 This creates a sparse file (ie. disk blocks are not allocated
3939 for the file until you write to it).  To create a non-sparse
3940 file of zeroes, use C<guestfs_fallocate64> instead.");
3941
3942   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3943    [InitBasicFS, Always, TestOutputStruct (
3944       [["touch"; "/test"];
3945        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3946        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3947    "set timestamp of a file with nanosecond precision",
3948    "\
3949 This command sets the timestamps of a file with nanosecond
3950 precision.
3951
3952 C<atsecs, atnsecs> are the last access time (atime) in secs and
3953 nanoseconds from the epoch.
3954
3955 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3956 secs and nanoseconds from the epoch.
3957
3958 If the C<*nsecs> field contains the special value C<-1> then
3959 the corresponding timestamp is set to the current time.  (The
3960 C<*secs> field is ignored in this case).
3961
3962 If the C<*nsecs> field contains the special value C<-2> then
3963 the corresponding timestamp is left unchanged.  (The
3964 C<*secs> field is ignored in this case).");
3965
3966   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3967    [InitBasicFS, Always, TestOutputStruct (
3968       [["mkdir_mode"; "/test"; "0o111"];
3969        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3970    "create a directory with a particular mode",
3971    "\
3972 This command creates a directory, setting the initial permissions
3973 of the directory to C<mode>.
3974
3975 For common Linux filesystems, the actual mode which is set will
3976 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3977 interpret the mode in other ways.
3978
3979 See also C<guestfs_mkdir>, C<guestfs_umask>");
3980
3981   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3982    [], (* XXX *)
3983    "change file owner and group",
3984    "\
3985 Change the file owner to C<owner> and group to C<group>.
3986 This is like C<guestfs_chown> but if C<path> is a symlink then
3987 the link itself is changed, not the target.
3988
3989 Only numeric uid and gid are supported.  If you want to use
3990 names, you will need to locate and parse the password file
3991 yourself (Augeas support makes this relatively easy).");
3992
3993   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3994    [], (* XXX *)
3995    "lstat on multiple files",
3996    "\
3997 This call allows you to perform the C<guestfs_lstat> operation
3998 on multiple files, where all files are in the directory C<path>.
3999 C<names> is the list of files from this directory.
4000
4001 On return you get a list of stat structs, with a one-to-one
4002 correspondence to the C<names> list.  If any name did not exist
4003 or could not be lstat'd, then the C<ino> field of that structure
4004 is set to C<-1>.
4005
4006 This call is intended for programs that want to efficiently
4007 list a directory contents without making many round-trips.
4008 See also C<guestfs_lxattrlist> for a similarly efficient call
4009 for getting extended attributes.  Very long directory listings
4010 might cause the protocol message size to be exceeded, causing
4011 this call to fail.  The caller must split up such requests
4012 into smaller groups of names.");
4013
4014   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4015    [], (* XXX *)
4016    "lgetxattr on multiple files",
4017    "\
4018 This call allows you to get the extended attributes
4019 of multiple files, where all files are in the directory C<path>.
4020 C<names> is the list of files from this directory.
4021
4022 On return you get a flat list of xattr structs which must be
4023 interpreted sequentially.  The first xattr struct always has a zero-length
4024 C<attrname>.  C<attrval> in this struct is zero-length
4025 to indicate there was an error doing C<lgetxattr> for this
4026 file, I<or> is a C string which is a decimal number
4027 (the number of following attributes for this file, which could
4028 be C<\"0\">).  Then after the first xattr struct are the
4029 zero or more attributes for the first named file.
4030 This repeats for the second and subsequent files.
4031
4032 This call is intended for programs that want to efficiently
4033 list a directory contents without making many round-trips.
4034 See also C<guestfs_lstatlist> for a similarly efficient call
4035 for getting standard stats.  Very long directory listings
4036 might cause the protocol message size to be exceeded, causing
4037 this call to fail.  The caller must split up such requests
4038 into smaller groups of names.");
4039
4040   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4041    [], (* XXX *)
4042    "readlink on multiple files",
4043    "\
4044 This call allows you to do a C<readlink> operation
4045 on multiple files, where all files are in the directory C<path>.
4046 C<names> is the list of files from this directory.
4047
4048 On return you get a list of strings, with a one-to-one
4049 correspondence to the C<names> list.  Each string is the
4050 value of the symbolic link.
4051
4052 If the C<readlink(2)> operation fails on any name, then
4053 the corresponding result string is the empty string C<\"\">.
4054 However the whole operation is completed even if there
4055 were C<readlink(2)> errors, and so you can call this
4056 function with names where you don't know if they are
4057 symbolic links already (albeit slightly less efficient).
4058
4059 This call is intended for programs that want to efficiently
4060 list a directory contents without making many round-trips.
4061 Very long directory listings might cause the protocol
4062 message size to be exceeded, causing
4063 this call to fail.  The caller must split up such requests
4064 into smaller groups of names.");
4065
4066   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4067    [InitISOFS, Always, TestOutputBuffer (
4068       [["pread"; "/known-4"; "1"; "3"]], "\n");
4069     InitISOFS, Always, TestOutputBuffer (
4070       [["pread"; "/empty"; "0"; "100"]], "")],
4071    "read part of a file",
4072    "\
4073 This command lets you read part of a file.  It reads C<count>
4074 bytes of the file, starting at C<offset>, from file C<path>.
4075
4076 This may read fewer bytes than requested.  For further details
4077 see the L<pread(2)> system call.");
4078
4079   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4080    [InitEmpty, Always, TestRun (
4081       [["part_init"; "/dev/sda"; "gpt"]])],
4082    "create an empty partition table",
4083    "\
4084 This creates an empty partition table on C<device> of one of the
4085 partition types listed below.  Usually C<parttype> should be
4086 either C<msdos> or C<gpt> (for large disks).
4087
4088 Initially there are no partitions.  Following this, you should
4089 call C<guestfs_part_add> for each partition required.
4090
4091 Possible values for C<parttype> are:
4092
4093 =over 4
4094
4095 =item B<efi> | B<gpt>
4096
4097 Intel EFI / GPT partition table.
4098
4099 This is recommended for >= 2 TB partitions that will be accessed
4100 from Linux and Intel-based Mac OS X.  It also has limited backwards
4101 compatibility with the C<mbr> format.
4102
4103 =item B<mbr> | B<msdos>
4104
4105 The standard PC \"Master Boot Record\" (MBR) format used
4106 by MS-DOS and Windows.  This partition type will B<only> work
4107 for device sizes up to 2 TB.  For large disks we recommend
4108 using C<gpt>.
4109
4110 =back
4111
4112 Other partition table types that may work but are not
4113 supported include:
4114
4115 =over 4
4116
4117 =item B<aix>
4118
4119 AIX disk labels.
4120
4121 =item B<amiga> | B<rdb>
4122
4123 Amiga \"Rigid Disk Block\" format.
4124
4125 =item B<bsd>
4126
4127 BSD disk labels.
4128
4129 =item B<dasd>
4130
4131 DASD, used on IBM mainframes.
4132
4133 =item B<dvh>
4134
4135 MIPS/SGI volumes.
4136
4137 =item B<mac>
4138
4139 Old Mac partition format.  Modern Macs use C<gpt>.
4140
4141 =item B<pc98>
4142
4143 NEC PC-98 format, common in Japan apparently.
4144
4145 =item B<sun>
4146
4147 Sun disk labels.
4148
4149 =back");
4150
4151   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4152    [InitEmpty, Always, TestRun (
4153       [["part_init"; "/dev/sda"; "mbr"];
4154        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4155     InitEmpty, Always, TestRun (
4156       [["part_init"; "/dev/sda"; "gpt"];
4157        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4158        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4159     InitEmpty, Always, TestRun (
4160       [["part_init"; "/dev/sda"; "mbr"];
4161        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4162        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4163        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4164        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4165    "add a partition to the device",
4166    "\
4167 This command adds a partition to C<device>.  If there is no partition
4168 table on the device, call C<guestfs_part_init> first.
4169
4170 The C<prlogex> parameter is the type of partition.  Normally you
4171 should pass C<p> or C<primary> here, but MBR partition tables also
4172 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4173 types.
4174
4175 C<startsect> and C<endsect> are the start and end of the partition
4176 in I<sectors>.  C<endsect> may be negative, which means it counts
4177 backwards from the end of the disk (C<-1> is the last sector).
4178
4179 Creating a partition which covers the whole disk is not so easy.
4180 Use C<guestfs_part_disk> to do that.");
4181
4182   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4183    [InitEmpty, Always, TestRun (
4184       [["part_disk"; "/dev/sda"; "mbr"]]);
4185     InitEmpty, Always, TestRun (
4186       [["part_disk"; "/dev/sda"; "gpt"]])],
4187    "partition whole disk with a single primary partition",
4188    "\
4189 This command is simply a combination of C<guestfs_part_init>
4190 followed by C<guestfs_part_add> to create a single primary partition
4191 covering the whole disk.
4192
4193 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4194 but other possible values are described in C<guestfs_part_init>.");
4195
4196   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4197    [InitEmpty, Always, TestRun (
4198       [["part_disk"; "/dev/sda"; "mbr"];
4199        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4200    "make a partition bootable",
4201    "\
4202 This sets the bootable flag on partition numbered C<partnum> on
4203 device C<device>.  Note that partitions are numbered from 1.
4204
4205 The bootable flag is used by some operating systems (notably
4206 Windows) to determine which partition to boot from.  It is by
4207 no means universally recognized.");
4208
4209   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4210    [InitEmpty, Always, TestRun (
4211       [["part_disk"; "/dev/sda"; "gpt"];
4212        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4213    "set partition name",
4214    "\
4215 This sets the partition name on partition numbered C<partnum> on
4216 device C<device>.  Note that partitions are numbered from 1.
4217
4218 The partition name can only be set on certain types of partition
4219 table.  This works on C<gpt> but not on C<mbr> partitions.");
4220
4221   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4222    [], (* XXX Add a regression test for this. *)
4223    "list partitions on a device",
4224    "\
4225 This command parses the partition table on C<device> and
4226 returns the list of partitions found.
4227
4228 The fields in the returned structure are:
4229
4230 =over 4
4231
4232 =item B<part_num>
4233
4234 Partition number, counting from 1.
4235
4236 =item B<part_start>
4237
4238 Start of the partition I<in bytes>.  To get sectors you have to
4239 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4240
4241 =item B<part_end>
4242
4243 End of the partition in bytes.
4244
4245 =item B<part_size>
4246
4247 Size of the partition in bytes.
4248
4249 =back");
4250
4251   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4252    [InitEmpty, Always, TestOutput (
4253       [["part_disk"; "/dev/sda"; "gpt"];
4254        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4255    "get the partition table type",
4256    "\
4257 This command examines the partition table on C<device> and
4258 returns the partition table type (format) being used.
4259
4260 Common return values include: C<msdos> (a DOS/Windows style MBR
4261 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4262 values are possible, although unusual.  See C<guestfs_part_init>
4263 for a full list.");
4264
4265   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4266    [InitBasicFS, Always, TestOutputBuffer (
4267       [["fill"; "0x63"; "10"; "/test"];
4268        ["read_file"; "/test"]], "cccccccccc")],
4269    "fill a file with octets",
4270    "\
4271 This command creates a new file called C<path>.  The initial
4272 content of the file is C<len> octets of C<c>, where C<c>
4273 must be a number in the range C<[0..255]>.
4274
4275 To fill a file with zero bytes (sparsely), it is
4276 much more efficient to use C<guestfs_truncate_size>.");
4277
4278   ("available", (RErr, [StringList "groups"]), 216, [],
4279    [InitNone, Always, TestRun [["available"; ""]]],
4280    "test availability of some parts of the API",
4281    "\
4282 This command is used to check the availability of some
4283 groups of functionality in the appliance, which not all builds of
4284 the libguestfs appliance will be able to provide.
4285
4286 The libguestfs groups, and the functions that those
4287 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4288
4289 The argument C<groups> is a list of group names, eg:
4290 C<[\"inotify\", \"augeas\"]> would check for the availability of
4291 the Linux inotify functions and Augeas (configuration file
4292 editing) functions.
4293
4294 The command returns no error if I<all> requested groups are available.
4295
4296 It fails with an error if one or more of the requested
4297 groups is unavailable in the appliance.
4298
4299 If an unknown group name is included in the
4300 list of groups then an error is always returned.
4301
4302 I<Notes:>
4303
4304 =over 4
4305
4306 =item *
4307
4308 You must call C<guestfs_launch> before calling this function.
4309
4310 The reason is because we don't know what groups are
4311 supported by the appliance/daemon until it is running and can
4312 be queried.
4313
4314 =item *
4315
4316 If a group of functions is available, this does not necessarily
4317 mean that they will work.  You still have to check for errors
4318 when calling individual API functions even if they are
4319 available.
4320
4321 =item *
4322
4323 It is usually the job of distro packagers to build
4324 complete functionality into the libguestfs appliance.
4325 Upstream libguestfs, if built from source with all
4326 requirements satisfied, will support everything.
4327
4328 =item *
4329
4330 This call was added in version C<1.0.80>.  In previous
4331 versions of libguestfs all you could do would be to speculatively
4332 execute a command to find out if the daemon implemented it.
4333 See also C<guestfs_version>.
4334
4335 =back");
4336
4337   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4338    [InitBasicFS, Always, TestOutputBuffer (
4339       [["write_file"; "/src"; "hello, world"; "0"];
4340        ["dd"; "/src"; "/dest"];
4341        ["read_file"; "/dest"]], "hello, world")],
4342    "copy from source to destination using dd",
4343    "\
4344 This command copies from one source device or file C<src>
4345 to another destination device or file C<dest>.  Normally you
4346 would use this to copy to or from a device or partition, for
4347 example to duplicate a filesystem.
4348
4349 If the destination is a device, it must be as large or larger
4350 than the source file or device, otherwise the copy will fail.
4351 This command cannot do partial copies (see C<guestfs_copy_size>).");
4352
4353   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4354    [InitBasicFS, Always, TestOutputInt (
4355       [["write_file"; "/file"; "hello, world"; "0"];
4356        ["filesize"; "/file"]], 12)],
4357    "return the size of the file in bytes",
4358    "\
4359 This command returns the size of C<file> in bytes.
4360
4361 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4362 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4363 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4364
4365   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4366    [InitBasicFSonLVM, Always, TestOutputList (
4367       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4368        ["lvs"]], ["/dev/VG/LV2"])],
4369    "rename an LVM logical volume",
4370    "\
4371 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4372
4373   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4374    [InitBasicFSonLVM, Always, TestOutputList (
4375       [["umount"; "/"];
4376        ["vg_activate"; "false"; "VG"];
4377        ["vgrename"; "VG"; "VG2"];
4378        ["vg_activate"; "true"; "VG2"];
4379        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4380        ["vgs"]], ["VG2"])],
4381    "rename an LVM volume group",
4382    "\
4383 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4384
4385   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4386    [InitISOFS, Always, TestOutputBuffer (
4387       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4388    "list the contents of a single file in an initrd",
4389    "\
4390 This command unpacks the file C<filename> from the initrd file
4391 called C<initrdpath>.  The filename must be given I<without> the
4392 initial C</> character.
4393
4394 For example, in guestfish you could use the following command
4395 to examine the boot script (usually called C</init>)
4396 contained in a Linux initrd or initramfs image:
4397
4398  initrd-cat /boot/initrd-<version>.img init
4399
4400 See also C<guestfs_initrd_list>.");
4401
4402   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4403    [],
4404    "get the UUID of a physical volume",
4405    "\
4406 This command returns the UUID of the LVM PV C<device>.");
4407
4408   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4409    [],
4410    "get the UUID of a volume group",
4411    "\
4412 This command returns the UUID of the LVM VG named C<vgname>.");
4413
4414   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4415    [],
4416    "get the UUID of a logical volume",
4417    "\
4418 This command returns the UUID of the LVM LV C<device>.");
4419
4420   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4421    [],
4422    "get the PV UUIDs containing the volume group",
4423    "\
4424 Given a VG called C<vgname>, this returns the UUIDs of all
4425 the physical volumes that this volume group resides on.
4426
4427 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4428 calls to associate physical volumes and volume groups.
4429
4430 See also C<guestfs_vglvuuids>.");
4431
4432   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4433    [],
4434    "get the LV UUIDs of all LVs in the volume group",
4435    "\
4436 Given a VG called C<vgname>, this returns the UUIDs of all
4437 the logical volumes created in this volume group.
4438
4439 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4440 calls to associate logical volumes and volume groups.
4441
4442 See also C<guestfs_vgpvuuids>.");
4443
4444   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4445    [InitBasicFS, Always, TestOutputBuffer (
4446       [["write_file"; "/src"; "hello, world"; "0"];
4447        ["copy_size"; "/src"; "/dest"; "5"];
4448        ["read_file"; "/dest"]], "hello")],
4449    "copy size bytes from source to destination using dd",
4450    "\
4451 This command copies exactly C<size> bytes from one source device
4452 or file C<src> to another destination device or file C<dest>.
4453
4454 Note this will fail if the source is too short or if the destination
4455 is not large enough.");
4456
4457   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4458    [InitEmpty, Always, TestRun (
4459       [["part_init"; "/dev/sda"; "mbr"];
4460        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4461        ["part_del"; "/dev/sda"; "1"]])],
4462    "delete a partition",
4463    "\
4464 This command deletes the partition numbered C<partnum> on C<device>.
4465
4466 Note that in the case of MBR partitioning, deleting an
4467 extended partition also deletes any logical partitions
4468 it contains.");
4469
4470   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4471    [InitEmpty, Always, TestOutputTrue (
4472       [["part_init"; "/dev/sda"; "mbr"];
4473        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4474        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4475        ["part_get_bootable"; "/dev/sda"; "1"]])],
4476    "return true if a partition is bootable",
4477    "\
4478 This command returns true if the partition C<partnum> on
4479 C<device> has the bootable flag set.
4480
4481 See also C<guestfs_part_set_bootable>.");
4482
4483   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4484    [InitEmpty, Always, TestOutputInt (
4485       [["part_init"; "/dev/sda"; "mbr"];
4486        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4487        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4488        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4489    "get the MBR type byte (ID byte) from a partition",
4490    "\
4491 Returns the MBR type byte (also known as the ID byte) from
4492 the numbered partition C<partnum>.
4493
4494 Note that only MBR (old DOS-style) partitions have type bytes.
4495 You will get undefined results for other partition table
4496 types (see C<guestfs_part_get_parttype>).");
4497
4498   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4499    [], (* tested by part_get_mbr_id *)
4500    "set the MBR type byte (ID byte) of a partition",
4501    "\
4502 Sets the MBR type byte (also known as the ID byte) of
4503 the numbered partition C<partnum> to C<idbyte>.  Note
4504 that the type bytes quoted in most documentation are
4505 in fact hexadecimal numbers, but usually documented
4506 without any leading \"0x\" which might be confusing.
4507
4508 Note that only MBR (old DOS-style) partitions have type bytes.
4509 You will get undefined results for other partition table
4510 types (see C<guestfs_part_get_parttype>).");
4511
4512 ]
4513
4514 let all_functions = non_daemon_functions @ daemon_functions
4515
4516 (* In some places we want the functions to be displayed sorted
4517  * alphabetically, so this is useful:
4518  *)
4519 let all_functions_sorted =
4520   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4521                compare n1 n2) all_functions
4522
4523 (* Field types for structures. *)
4524 type field =
4525   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4526   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4527   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4528   | FUInt32
4529   | FInt32
4530   | FUInt64
4531   | FInt64
4532   | FBytes                      (* Any int measure that counts bytes. *)
4533   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4534   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4535
4536 (* Because we generate extra parsing code for LVM command line tools,
4537  * we have to pull out the LVM columns separately here.
4538  *)
4539 let lvm_pv_cols = [
4540   "pv_name", FString;
4541   "pv_uuid", FUUID;
4542   "pv_fmt", FString;
4543   "pv_size", FBytes;
4544   "dev_size", FBytes;
4545   "pv_free", FBytes;
4546   "pv_used", FBytes;
4547   "pv_attr", FString (* XXX *);
4548   "pv_pe_count", FInt64;
4549   "pv_pe_alloc_count", FInt64;
4550   "pv_tags", FString;
4551   "pe_start", FBytes;
4552   "pv_mda_count", FInt64;
4553   "pv_mda_free", FBytes;
4554   (* Not in Fedora 10:
4555      "pv_mda_size", FBytes;
4556   *)
4557 ]
4558 let lvm_vg_cols = [
4559   "vg_name", FString;
4560   "vg_uuid", FUUID;
4561   "vg_fmt", FString;
4562   "vg_attr", FString (* XXX *);
4563   "vg_size", FBytes;
4564   "vg_free", FBytes;
4565   "vg_sysid", FString;
4566   "vg_extent_size", FBytes;
4567   "vg_extent_count", FInt64;
4568   "vg_free_count", FInt64;
4569   "max_lv", FInt64;
4570   "max_pv", FInt64;
4571   "pv_count", FInt64;
4572   "lv_count", FInt64;
4573   "snap_count", FInt64;
4574   "vg_seqno", FInt64;
4575   "vg_tags", FString;
4576   "vg_mda_count", FInt64;
4577   "vg_mda_free", FBytes;
4578   (* Not in Fedora 10:
4579      "vg_mda_size", FBytes;
4580   *)
4581 ]
4582 let lvm_lv_cols = [
4583   "lv_name", FString;
4584   "lv_uuid", FUUID;
4585   "lv_attr", FString (* XXX *);
4586   "lv_major", FInt64;
4587   "lv_minor", FInt64;
4588   "lv_kernel_major", FInt64;
4589   "lv_kernel_minor", FInt64;
4590   "lv_size", FBytes;
4591   "seg_count", FInt64;
4592   "origin", FString;
4593   "snap_percent", FOptPercent;
4594   "copy_percent", FOptPercent;
4595   "move_pv", FString;
4596   "lv_tags", FString;
4597   "mirror_log", FString;
4598   "modules", FString;
4599 ]
4600
4601 (* Names and fields in all structures (in RStruct and RStructList)
4602  * that we support.
4603  *)
4604 let structs = [
4605   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4606    * not use this struct in any new code.
4607    *)
4608   "int_bool", [
4609     "i", FInt32;                (* for historical compatibility *)
4610     "b", FInt32;                (* for historical compatibility *)
4611   ];
4612
4613   (* LVM PVs, VGs, LVs. *)
4614   "lvm_pv", lvm_pv_cols;
4615   "lvm_vg", lvm_vg_cols;
4616   "lvm_lv", lvm_lv_cols;
4617
4618   (* Column names and types from stat structures.
4619    * NB. Can't use things like 'st_atime' because glibc header files
4620    * define some of these as macros.  Ugh.
4621    *)
4622   "stat", [
4623     "dev", FInt64;
4624     "ino", FInt64;
4625     "mode", FInt64;
4626     "nlink", FInt64;
4627     "uid", FInt64;
4628     "gid", FInt64;
4629     "rdev", FInt64;
4630     "size", FInt64;
4631     "blksize", FInt64;
4632     "blocks", FInt64;
4633     "atime", FInt64;
4634     "mtime", FInt64;
4635     "ctime", FInt64;
4636   ];
4637   "statvfs", [
4638     "bsize", FInt64;
4639     "frsize", FInt64;
4640     "blocks", FInt64;
4641     "bfree", FInt64;
4642     "bavail", FInt64;
4643     "files", FInt64;
4644     "ffree", FInt64;
4645     "favail", FInt64;
4646     "fsid", FInt64;
4647     "flag", FInt64;
4648     "namemax", FInt64;
4649   ];
4650
4651   (* Column names in dirent structure. *)
4652   "dirent", [
4653     "ino", FInt64;
4654     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4655     "ftyp", FChar;
4656     "name", FString;
4657   ];
4658
4659   (* Version numbers. *)
4660   "version", [
4661     "major", FInt64;
4662     "minor", FInt64;
4663     "release", FInt64;
4664     "extra", FString;
4665   ];
4666
4667   (* Extended attribute. *)
4668   "xattr", [
4669     "attrname", FString;
4670     "attrval", FBuffer;
4671   ];
4672
4673   (* Inotify events. *)
4674   "inotify_event", [
4675     "in_wd", FInt64;
4676     "in_mask", FUInt32;
4677     "in_cookie", FUInt32;
4678     "in_name", FString;
4679   ];
4680
4681   (* Partition table entry. *)
4682   "partition", [
4683     "part_num", FInt32;
4684     "part_start", FBytes;
4685     "part_end", FBytes;
4686     "part_size", FBytes;
4687   ];
4688 ] (* end of structs *)
4689
4690 (* Ugh, Java has to be different ..
4691  * These names are also used by the Haskell bindings.
4692  *)
4693 let java_structs = [
4694   "int_bool", "IntBool";
4695   "lvm_pv", "PV";
4696   "lvm_vg", "VG";
4697   "lvm_lv", "LV";
4698   "stat", "Stat";
4699   "statvfs", "StatVFS";
4700   "dirent", "Dirent";
4701   "version", "Version";
4702   "xattr", "XAttr";
4703   "inotify_event", "INotifyEvent";
4704   "partition", "Partition";
4705 ]
4706
4707 (* What structs are actually returned. *)
4708 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4709
4710 (* Returns a list of RStruct/RStructList structs that are returned
4711  * by any function.  Each element of returned list is a pair:
4712  *
4713  * (structname, RStructOnly)
4714  *    == there exists function which returns RStruct (_, structname)
4715  * (structname, RStructListOnly)
4716  *    == there exists function which returns RStructList (_, structname)
4717  * (structname, RStructAndList)
4718  *    == there are functions returning both RStruct (_, structname)
4719  *                                      and RStructList (_, structname)
4720  *)
4721 let rstructs_used_by functions =
4722   (* ||| is a "logical OR" for rstructs_used_t *)
4723   let (|||) a b =
4724     match a, b with
4725     | RStructAndList, _
4726     | _, RStructAndList -> RStructAndList
4727     | RStructOnly, RStructListOnly
4728     | RStructListOnly, RStructOnly -> RStructAndList
4729     | RStructOnly, RStructOnly -> RStructOnly
4730     | RStructListOnly, RStructListOnly -> RStructListOnly
4731   in
4732
4733   let h = Hashtbl.create 13 in
4734
4735   (* if elem->oldv exists, update entry using ||| operator,
4736    * else just add elem->newv to the hash
4737    *)
4738   let update elem newv =
4739     try  let oldv = Hashtbl.find h elem in
4740          Hashtbl.replace h elem (newv ||| oldv)
4741     with Not_found -> Hashtbl.add h elem newv
4742   in
4743
4744   List.iter (
4745     fun (_, style, _, _, _, _, _) ->
4746       match fst style with
4747       | RStruct (_, structname) -> update structname RStructOnly
4748       | RStructList (_, structname) -> update structname RStructListOnly
4749       | _ -> ()
4750   ) functions;
4751
4752   (* return key->values as a list of (key,value) *)
4753   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4754
4755 (* Used for testing language bindings. *)
4756 type callt =
4757   | CallString of string
4758   | CallOptString of string option
4759   | CallStringList of string list
4760   | CallInt of int
4761   | CallInt64 of int64
4762   | CallBool of bool
4763
4764 (* Used to memoize the result of pod2text. *)
4765 let pod2text_memo_filename = "src/.pod2text.data"
4766 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4767   try
4768     let chan = open_in pod2text_memo_filename in
4769     let v = input_value chan in
4770     close_in chan;
4771     v
4772   with
4773     _ -> Hashtbl.create 13
4774 let pod2text_memo_updated () =
4775   let chan = open_out pod2text_memo_filename in
4776   output_value chan pod2text_memo;
4777   close_out chan
4778
4779 (* Useful functions.
4780  * Note we don't want to use any external OCaml libraries which
4781  * makes this a bit harder than it should be.
4782  *)
4783 module StringMap = Map.Make (String)
4784
4785 let failwithf fs = ksprintf failwith fs
4786
4787 let unique = let i = ref 0 in fun () -> incr i; !i
4788
4789 let replace_char s c1 c2 =
4790   let s2 = String.copy s in
4791   let r = ref false in
4792   for i = 0 to String.length s2 - 1 do
4793     if String.unsafe_get s2 i = c1 then (
4794       String.unsafe_set s2 i c2;
4795       r := true
4796     )
4797   done;
4798   if not !r then s else s2
4799
4800 let isspace c =
4801   c = ' '
4802   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4803
4804 let triml ?(test = isspace) str =
4805   let i = ref 0 in
4806   let n = ref (String.length str) in
4807   while !n > 0 && test str.[!i]; do
4808     decr n;
4809     incr i
4810   done;
4811   if !i = 0 then str
4812   else String.sub str !i !n
4813
4814 let trimr ?(test = isspace) str =
4815   let n = ref (String.length str) in
4816   while !n > 0 && test str.[!n-1]; do
4817     decr n
4818   done;
4819   if !n = String.length str then str
4820   else String.sub str 0 !n
4821
4822 let trim ?(test = isspace) str =
4823   trimr ~test (triml ~test str)
4824
4825 let rec find s sub =
4826   let len = String.length s in
4827   let sublen = String.length sub in
4828   let rec loop i =
4829     if i <= len-sublen then (
4830       let rec loop2 j =
4831         if j < sublen then (
4832           if s.[i+j] = sub.[j] then loop2 (j+1)
4833           else -1
4834         ) else
4835           i (* found *)
4836       in
4837       let r = loop2 0 in
4838       if r = -1 then loop (i+1) else r
4839     ) else
4840       -1 (* not found *)
4841   in
4842   loop 0
4843
4844 let rec replace_str s s1 s2 =
4845   let len = String.length s in
4846   let sublen = String.length s1 in
4847   let i = find s s1 in
4848   if i = -1 then s
4849   else (
4850     let s' = String.sub s 0 i in
4851     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4852     s' ^ s2 ^ replace_str s'' s1 s2
4853   )
4854
4855 let rec string_split sep str =
4856   let len = String.length str in
4857   let seplen = String.length sep in
4858   let i = find str sep in
4859   if i = -1 then [str]
4860   else (
4861     let s' = String.sub str 0 i in
4862     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4863     s' :: string_split sep s''
4864   )
4865
4866 let files_equal n1 n2 =
4867   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4868   match Sys.command cmd with
4869   | 0 -> true
4870   | 1 -> false
4871   | i -> failwithf "%s: failed with error code %d" cmd i
4872
4873 let rec filter_map f = function
4874   | [] -> []
4875   | x :: xs ->
4876       match f x with
4877       | Some y -> y :: filter_map f xs
4878       | None -> filter_map f xs
4879
4880 let rec find_map f = function
4881   | [] -> raise Not_found
4882   | x :: xs ->
4883       match f x with
4884       | Some y -> y
4885       | None -> find_map f xs
4886
4887 let iteri f xs =
4888   let rec loop i = function
4889     | [] -> ()
4890     | x :: xs -> f i x; loop (i+1) xs
4891   in
4892   loop 0 xs
4893
4894 let mapi f xs =
4895   let rec loop i = function
4896     | [] -> []
4897     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4898   in
4899   loop 0 xs
4900
4901 let count_chars c str =
4902   let count = ref 0 in
4903   for i = 0 to String.length str - 1 do
4904     if c = String.unsafe_get str i then incr count
4905   done;
4906   !count
4907
4908 let name_of_argt = function
4909   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4910   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4911   | FileIn n | FileOut n -> n
4912
4913 let java_name_of_struct typ =
4914   try List.assoc typ java_structs
4915   with Not_found ->
4916     failwithf
4917       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4918
4919 let cols_of_struct typ =
4920   try List.assoc typ structs
4921   with Not_found ->
4922     failwithf "cols_of_struct: unknown struct %s" typ
4923
4924 let seq_of_test = function
4925   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4926   | TestOutputListOfDevices (s, _)
4927   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4928   | TestOutputTrue s | TestOutputFalse s
4929   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4930   | TestOutputStruct (s, _)
4931   | TestLastFail s -> s
4932
4933 (* Handling for function flags. *)
4934 let protocol_limit_warning =
4935   "Because of the message protocol, there is a transfer limit
4936 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4937
4938 let danger_will_robinson =
4939   "B<This command is dangerous.  Without careful use you
4940 can easily destroy all your data>."
4941
4942 let deprecation_notice flags =
4943   try
4944     let alt =
4945       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4946     let txt =
4947       sprintf "This function is deprecated.
4948 In new code, use the C<%s> call instead.
4949
4950 Deprecated functions will not be removed from the API, but the
4951 fact that they are deprecated indicates that there are problems
4952 with correct use of these functions." alt in
4953     Some txt
4954   with
4955     Not_found -> None
4956
4957 (* Create list of optional groups. *)
4958 let optgroups =
4959   let h = Hashtbl.create 13 in
4960   List.iter (
4961     fun (name, _, _, flags, _, _, _) ->
4962       List.iter (
4963         function
4964         | Optional group ->
4965             let names = try Hashtbl.find h group with Not_found -> [] in
4966             Hashtbl.replace h group (name :: names)
4967         | _ -> ()
4968       ) flags
4969   ) daemon_functions;
4970   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4971   let groups =
4972     List.map (
4973       fun group -> group, List.sort compare (Hashtbl.find h group)
4974     ) groups in
4975   List.sort (fun x y -> compare (fst x) (fst y)) groups
4976
4977 (* Check function names etc. for consistency. *)
4978 let check_functions () =
4979   let contains_uppercase str =
4980     let len = String.length str in
4981     let rec loop i =
4982       if i >= len then false
4983       else (
4984         let c = str.[i] in
4985         if c >= 'A' && c <= 'Z' then true
4986         else loop (i+1)
4987       )
4988     in
4989     loop 0
4990   in
4991
4992   (* Check function names. *)
4993   List.iter (
4994     fun (name, _, _, _, _, _, _) ->
4995       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4996         failwithf "function name %s does not need 'guestfs' prefix" name;
4997       if name = "" then
4998         failwithf "function name is empty";
4999       if name.[0] < 'a' || name.[0] > 'z' then
5000         failwithf "function name %s must start with lowercase a-z" name;
5001       if String.contains name '-' then
5002         failwithf "function name %s should not contain '-', use '_' instead."
5003           name
5004   ) all_functions;
5005
5006   (* Check function parameter/return names. *)
5007   List.iter (
5008     fun (name, style, _, _, _, _, _) ->
5009       let check_arg_ret_name n =
5010         if contains_uppercase n then
5011           failwithf "%s param/ret %s should not contain uppercase chars"
5012             name n;
5013         if String.contains n '-' || String.contains n '_' then
5014           failwithf "%s param/ret %s should not contain '-' or '_'"
5015             name n;
5016         if n = "value" then
5017           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;
5018         if n = "int" || n = "char" || n = "short" || n = "long" then
5019           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5020         if n = "i" || n = "n" then
5021           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5022         if n = "argv" || n = "args" then
5023           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5024
5025         (* List Haskell, OCaml and C keywords here.
5026          * http://www.haskell.org/haskellwiki/Keywords
5027          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5028          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5029          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5030          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5031          * Omitting _-containing words, since they're handled above.
5032          * Omitting the OCaml reserved word, "val", is ok,
5033          * and saves us from renaming several parameters.
5034          *)
5035         let reserved = [
5036           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5037           "char"; "class"; "const"; "constraint"; "continue"; "data";
5038           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5039           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5040           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5041           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5042           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5043           "interface";
5044           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5045           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5046           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5047           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5048           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5049           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5050           "volatile"; "when"; "where"; "while";
5051           ] in
5052         if List.mem n reserved then
5053           failwithf "%s has param/ret using reserved word %s" name n;
5054       in
5055
5056       (match fst style with
5057        | RErr -> ()
5058        | RInt n | RInt64 n | RBool n
5059        | RConstString n | RConstOptString n | RString n
5060        | RStringList n | RStruct (n, _) | RStructList (n, _)
5061        | RHashtable n | RBufferOut n ->
5062            check_arg_ret_name n
5063       );
5064       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5065   ) all_functions;
5066
5067   (* Check short descriptions. *)
5068   List.iter (
5069     fun (name, _, _, _, _, shortdesc, _) ->
5070       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5071         failwithf "short description of %s should begin with lowercase." name;
5072       let c = shortdesc.[String.length shortdesc-1] in
5073       if c = '\n' || c = '.' then
5074         failwithf "short description of %s should not end with . or \\n." name
5075   ) all_functions;
5076
5077   (* Check long descriptions. *)
5078   List.iter (
5079     fun (name, _, _, _, _, _, longdesc) ->
5080       if longdesc.[String.length longdesc-1] = '\n' then
5081         failwithf "long description of %s should not end with \\n." name
5082   ) all_functions;
5083
5084   (* Check proc_nrs. *)
5085   List.iter (
5086     fun (name, _, proc_nr, _, _, _, _) ->
5087       if proc_nr <= 0 then
5088         failwithf "daemon function %s should have proc_nr > 0" name
5089   ) daemon_functions;
5090
5091   List.iter (
5092     fun (name, _, proc_nr, _, _, _, _) ->
5093       if proc_nr <> -1 then
5094         failwithf "non-daemon function %s should have proc_nr -1" name
5095   ) non_daemon_functions;
5096
5097   let proc_nrs =
5098     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5099       daemon_functions in
5100   let proc_nrs =
5101     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5102   let rec loop = function
5103     | [] -> ()
5104     | [_] -> ()
5105     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5106         loop rest
5107     | (name1,nr1) :: (name2,nr2) :: _ ->
5108         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5109           name1 name2 nr1 nr2
5110   in
5111   loop proc_nrs;
5112
5113   (* Check tests. *)
5114   List.iter (
5115     function
5116       (* Ignore functions that have no tests.  We generate a
5117        * warning when the user does 'make check' instead.
5118        *)
5119     | name, _, _, _, [], _, _ -> ()
5120     | name, _, _, _, tests, _, _ ->
5121         let funcs =
5122           List.map (
5123             fun (_, _, test) ->
5124               match seq_of_test test with
5125               | [] ->
5126                   failwithf "%s has a test containing an empty sequence" name
5127               | cmds -> List.map List.hd cmds
5128           ) tests in
5129         let funcs = List.flatten funcs in
5130
5131         let tested = List.mem name funcs in
5132
5133         if not tested then
5134           failwithf "function %s has tests but does not test itself" name
5135   ) all_functions
5136
5137 (* 'pr' prints to the current output file. *)
5138 let chan = ref Pervasives.stdout
5139 let lines = ref 0
5140 let pr fs =
5141   ksprintf
5142     (fun str ->
5143        let i = count_chars '\n' str in
5144        lines := !lines + i;
5145        output_string !chan str
5146     ) fs
5147
5148 let copyright_years =
5149   let this_year = 1900 + (localtime (time ())).tm_year in
5150   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5151
5152 (* Generate a header block in a number of standard styles. *)
5153 type comment_style =
5154     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5155 type license = GPLv2plus | LGPLv2plus
5156
5157 let generate_header ?(extra_inputs = []) comment license =
5158   let inputs = "src/generator.ml" :: extra_inputs in
5159   let c = match comment with
5160     | CStyle ->         pr "/* "; " *"
5161     | CPlusPlusStyle -> pr "// "; "//"
5162     | HashStyle ->      pr "# ";  "#"
5163     | OCamlStyle ->     pr "(* "; " *"
5164     | HaskellStyle ->   pr "{- "; "  " in
5165   pr "libguestfs generated file\n";
5166   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5167   List.iter (pr "%s   %s\n" c) inputs;
5168   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5169   pr "%s\n" c;
5170   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5171   pr "%s\n" c;
5172   (match license with
5173    | GPLv2plus ->
5174        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5175        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5176        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5177        pr "%s (at your option) any later version.\n" c;
5178        pr "%s\n" c;
5179        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5180        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5181        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5182        pr "%s GNU General Public License for more details.\n" c;
5183        pr "%s\n" c;
5184        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5185        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5186        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5187
5188    | LGPLv2plus ->
5189        pr "%s This library is free software; you can redistribute it and/or\n" c;
5190        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5191        pr "%s License as published by the Free Software Foundation; either\n" c;
5192        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5193        pr "%s\n" c;
5194        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5195        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5196        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5197        pr "%s Lesser General Public License for more details.\n" c;
5198        pr "%s\n" c;
5199        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5200        pr "%s License along with this library; if not, write to the Free Software\n" c;
5201        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5202   );
5203   (match comment with
5204    | CStyle -> pr " */\n"
5205    | CPlusPlusStyle
5206    | HashStyle -> ()
5207    | OCamlStyle -> pr " *)\n"
5208    | HaskellStyle -> pr "-}\n"
5209   );
5210   pr "\n"
5211
5212 (* Start of main code generation functions below this line. *)
5213
5214 (* Generate the pod documentation for the C API. *)
5215 let rec generate_actions_pod () =
5216   List.iter (
5217     fun (shortname, style, _, flags, _, _, longdesc) ->
5218       if not (List.mem NotInDocs flags) then (
5219         let name = "guestfs_" ^ shortname in
5220         pr "=head2 %s\n\n" name;
5221         pr " ";
5222         generate_prototype ~extern:false ~handle:"g" name style;
5223         pr "\n\n";
5224         pr "%s\n\n" longdesc;
5225         (match fst style with
5226          | RErr ->
5227              pr "This function returns 0 on success or -1 on error.\n\n"
5228          | RInt _ ->
5229              pr "On error this function returns -1.\n\n"
5230          | RInt64 _ ->
5231              pr "On error this function returns -1.\n\n"
5232          | RBool _ ->
5233              pr "This function returns a C truth value on success or -1 on error.\n\n"
5234          | RConstString _ ->
5235              pr "This function returns a string, or NULL on error.
5236 The string is owned by the guest handle and must I<not> be freed.\n\n"
5237          | RConstOptString _ ->
5238              pr "This function returns a string which may be NULL.
5239 There is no way to return an error from this function.
5240 The string is owned by the guest handle and must I<not> be freed.\n\n"
5241          | RString _ ->
5242              pr "This function returns a string, or NULL on error.
5243 I<The caller must free the returned string after use>.\n\n"
5244          | RStringList _ ->
5245              pr "This function returns a NULL-terminated array of strings
5246 (like L<environ(3)>), or NULL if there was an error.
5247 I<The caller must free the strings and the array after use>.\n\n"
5248          | RStruct (_, typ) ->
5249              pr "This function returns a C<struct guestfs_%s *>,
5250 or NULL if there was an error.
5251 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5252          | RStructList (_, typ) ->
5253              pr "This function returns a C<struct guestfs_%s_list *>
5254 (see E<lt>guestfs-structs.hE<gt>),
5255 or NULL if there was an error.
5256 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5257          | RHashtable _ ->
5258              pr "This function returns a NULL-terminated array of
5259 strings, or NULL if there was an error.
5260 The array of strings will always have length C<2n+1>, where
5261 C<n> keys and values alternate, followed by the trailing NULL entry.
5262 I<The caller must free the strings and the array after use>.\n\n"
5263          | RBufferOut _ ->
5264              pr "This function returns a buffer, or NULL on error.
5265 The size of the returned buffer is written to C<*size_r>.
5266 I<The caller must free the returned buffer after use>.\n\n"
5267         );
5268         if List.mem ProtocolLimitWarning flags then
5269           pr "%s\n\n" protocol_limit_warning;
5270         if List.mem DangerWillRobinson flags then
5271           pr "%s\n\n" danger_will_robinson;
5272         match deprecation_notice flags with
5273         | None -> ()
5274         | Some txt -> pr "%s\n\n" txt
5275       )
5276   ) all_functions_sorted
5277
5278 and generate_structs_pod () =
5279   (* Structs documentation. *)
5280   List.iter (
5281     fun (typ, cols) ->
5282       pr "=head2 guestfs_%s\n" typ;
5283       pr "\n";
5284       pr " struct guestfs_%s {\n" typ;
5285       List.iter (
5286         function
5287         | name, FChar -> pr "   char %s;\n" name
5288         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5289         | name, FInt32 -> pr "   int32_t %s;\n" name
5290         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5291         | name, FInt64 -> pr "   int64_t %s;\n" name
5292         | name, FString -> pr "   char *%s;\n" name
5293         | name, FBuffer ->
5294             pr "   /* The next two fields describe a byte array. */\n";
5295             pr "   uint32_t %s_len;\n" name;
5296             pr "   char *%s;\n" name
5297         | name, FUUID ->
5298             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5299             pr "   char %s[32];\n" name
5300         | name, FOptPercent ->
5301             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5302             pr "   float %s;\n" name
5303       ) cols;
5304       pr " };\n";
5305       pr " \n";
5306       pr " struct guestfs_%s_list {\n" typ;
5307       pr "   uint32_t len; /* Number of elements in list. */\n";
5308       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5309       pr " };\n";
5310       pr " \n";
5311       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5312       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5313         typ typ;
5314       pr "\n"
5315   ) structs
5316
5317 and generate_availability_pod () =
5318   (* Availability documentation. *)
5319   pr "=over 4\n";
5320   pr "\n";
5321   List.iter (
5322     fun (group, functions) ->
5323       pr "=item B<%s>\n" group;
5324       pr "\n";
5325       pr "The following functions:\n";
5326       List.iter (pr "L</guestfs_%s>\n") functions;
5327       pr "\n"
5328   ) optgroups;
5329   pr "=back\n";
5330   pr "\n"
5331
5332 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5333  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5334  *
5335  * We have to use an underscore instead of a dash because otherwise
5336  * rpcgen generates incorrect code.
5337  *
5338  * This header is NOT exported to clients, but see also generate_structs_h.
5339  *)
5340 and generate_xdr () =
5341   generate_header CStyle LGPLv2plus;
5342
5343   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5344   pr "typedef string guestfs_str<>;\n";
5345   pr "\n";
5346
5347   (* Internal structures. *)
5348   List.iter (
5349     function
5350     | typ, cols ->
5351         pr "struct guestfs_int_%s {\n" typ;
5352         List.iter (function
5353                    | name, FChar -> pr "  char %s;\n" name
5354                    | name, FString -> pr "  string %s<>;\n" name
5355                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5356                    | name, FUUID -> pr "  opaque %s[32];\n" name
5357                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5358                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5359                    | name, FOptPercent -> pr "  float %s;\n" name
5360                   ) cols;
5361         pr "};\n";
5362         pr "\n";
5363         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5364         pr "\n";
5365   ) structs;
5366
5367   List.iter (
5368     fun (shortname, style, _, _, _, _, _) ->
5369       let name = "guestfs_" ^ shortname in
5370
5371       (match snd style with
5372        | [] -> ()
5373        | args ->
5374            pr "struct %s_args {\n" name;
5375            List.iter (
5376              function
5377              | Pathname n | Device n | Dev_or_Path n | String n ->
5378                  pr "  string %s<>;\n" n
5379              | OptString n -> pr "  guestfs_str *%s;\n" n
5380              | StringList n | DeviceList n -> pr "  guestfs_str %s<>;\n" n
5381              | Bool n -> pr "  bool %s;\n" n
5382              | Int n -> pr "  int %s;\n" n
5383              | Int64 n -> pr "  hyper %s;\n" n
5384              | FileIn _ | FileOut _ -> ()
5385            ) args;
5386            pr "};\n\n"
5387       );
5388       (match fst style with
5389        | RErr -> ()
5390        | RInt n ->
5391            pr "struct %s_ret {\n" name;
5392            pr "  int %s;\n" n;
5393            pr "};\n\n"
5394        | RInt64 n ->
5395            pr "struct %s_ret {\n" name;
5396            pr "  hyper %s;\n" n;
5397            pr "};\n\n"
5398        | RBool n ->
5399            pr "struct %s_ret {\n" name;
5400            pr "  bool %s;\n" n;
5401            pr "};\n\n"
5402        | RConstString _ | RConstOptString _ ->
5403            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5404        | RString n ->
5405            pr "struct %s_ret {\n" name;
5406            pr "  string %s<>;\n" n;
5407            pr "};\n\n"
5408        | RStringList n ->
5409            pr "struct %s_ret {\n" name;
5410            pr "  guestfs_str %s<>;\n" n;
5411            pr "};\n\n"
5412        | RStruct (n, typ) ->
5413            pr "struct %s_ret {\n" name;
5414            pr "  guestfs_int_%s %s;\n" typ n;
5415            pr "};\n\n"
5416        | RStructList (n, typ) ->
5417            pr "struct %s_ret {\n" name;
5418            pr "  guestfs_int_%s_list %s;\n" typ n;
5419            pr "};\n\n"
5420        | RHashtable n ->
5421            pr "struct %s_ret {\n" name;
5422            pr "  guestfs_str %s<>;\n" n;
5423            pr "};\n\n"
5424        | RBufferOut n ->
5425            pr "struct %s_ret {\n" name;
5426            pr "  opaque %s<>;\n" n;
5427            pr "};\n\n"
5428       );
5429   ) daemon_functions;
5430
5431   (* Table of procedure numbers. *)
5432   pr "enum guestfs_procedure {\n";
5433   List.iter (
5434     fun (shortname, _, proc_nr, _, _, _, _) ->
5435       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5436   ) daemon_functions;
5437   pr "  GUESTFS_PROC_NR_PROCS\n";
5438   pr "};\n";
5439   pr "\n";
5440
5441   (* Having to choose a maximum message size is annoying for several
5442    * reasons (it limits what we can do in the API), but it (a) makes
5443    * the protocol a lot simpler, and (b) provides a bound on the size
5444    * of the daemon which operates in limited memory space.
5445    *)
5446   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5447   pr "\n";
5448
5449   (* Message header, etc. *)
5450   pr "\
5451 /* The communication protocol is now documented in the guestfs(3)
5452  * manpage.
5453  */
5454
5455 const GUESTFS_PROGRAM = 0x2000F5F5;
5456 const GUESTFS_PROTOCOL_VERSION = 1;
5457
5458 /* These constants must be larger than any possible message length. */
5459 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5460 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5461
5462 enum guestfs_message_direction {
5463   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5464   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5465 };
5466
5467 enum guestfs_message_status {
5468   GUESTFS_STATUS_OK = 0,
5469   GUESTFS_STATUS_ERROR = 1
5470 };
5471
5472 const GUESTFS_ERROR_LEN = 256;
5473
5474 struct guestfs_message_error {
5475   string error_message<GUESTFS_ERROR_LEN>;
5476 };
5477
5478 struct guestfs_message_header {
5479   unsigned prog;                     /* GUESTFS_PROGRAM */
5480   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5481   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5482   guestfs_message_direction direction;
5483   unsigned serial;                   /* message serial number */
5484   guestfs_message_status status;
5485 };
5486
5487 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5488
5489 struct guestfs_chunk {
5490   int cancel;                        /* if non-zero, transfer is cancelled */
5491   /* data size is 0 bytes if the transfer has finished successfully */
5492   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5493 };
5494 "
5495
5496 (* Generate the guestfs-structs.h file. *)
5497 and generate_structs_h () =
5498   generate_header CStyle LGPLv2plus;
5499
5500   (* This is a public exported header file containing various
5501    * structures.  The structures are carefully written to have
5502    * exactly the same in-memory format as the XDR structures that
5503    * we use on the wire to the daemon.  The reason for creating
5504    * copies of these structures here is just so we don't have to
5505    * export the whole of guestfs_protocol.h (which includes much
5506    * unrelated and XDR-dependent stuff that we don't want to be
5507    * public, or required by clients).
5508    *
5509    * To reiterate, we will pass these structures to and from the
5510    * client with a simple assignment or memcpy, so the format
5511    * must be identical to what rpcgen / the RFC defines.
5512    *)
5513
5514   (* Public structures. *)
5515   List.iter (
5516     fun (typ, cols) ->
5517       pr "struct guestfs_%s {\n" typ;
5518       List.iter (
5519         function
5520         | name, FChar -> pr "  char %s;\n" name
5521         | name, FString -> pr "  char *%s;\n" name
5522         | name, FBuffer ->
5523             pr "  uint32_t %s_len;\n" name;
5524             pr "  char *%s;\n" name
5525         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5526         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5527         | name, FInt32 -> pr "  int32_t %s;\n" name
5528         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5529         | name, FInt64 -> pr "  int64_t %s;\n" name
5530         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5531       ) cols;
5532       pr "};\n";
5533       pr "\n";
5534       pr "struct guestfs_%s_list {\n" typ;
5535       pr "  uint32_t len;\n";
5536       pr "  struct guestfs_%s *val;\n" typ;
5537       pr "};\n";
5538       pr "\n";
5539       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5540       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5541       pr "\n"
5542   ) structs
5543
5544 (* Generate the guestfs-actions.h file. *)
5545 and generate_actions_h () =
5546   generate_header CStyle LGPLv2plus;
5547   List.iter (
5548     fun (shortname, style, _, _, _, _, _) ->
5549       let name = "guestfs_" ^ shortname in
5550       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5551         name style
5552   ) all_functions
5553
5554 (* Generate the guestfs-internal-actions.h file. *)
5555 and generate_internal_actions_h () =
5556   generate_header CStyle LGPLv2plus;
5557   List.iter (
5558     fun (shortname, style, _, _, _, _, _) ->
5559       let name = "guestfs__" ^ shortname in
5560       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5561         name style
5562   ) non_daemon_functions
5563
5564 (* Generate the client-side dispatch stubs. *)
5565 and generate_client_actions () =
5566   generate_header CStyle LGPLv2plus;
5567
5568   pr "\
5569 #include <stdio.h>
5570 #include <stdlib.h>
5571 #include <stdint.h>
5572 #include <string.h>
5573 #include <inttypes.h>
5574
5575 #include \"guestfs.h\"
5576 #include \"guestfs-internal.h\"
5577 #include \"guestfs-internal-actions.h\"
5578 #include \"guestfs_protocol.h\"
5579
5580 #define error guestfs_error
5581 //#define perrorf guestfs_perrorf
5582 #define safe_malloc guestfs_safe_malloc
5583 #define safe_realloc guestfs_safe_realloc
5584 //#define safe_strdup guestfs_safe_strdup
5585 #define safe_memdup guestfs_safe_memdup
5586
5587 /* Check the return message from a call for validity. */
5588 static int
5589 check_reply_header (guestfs_h *g,
5590                     const struct guestfs_message_header *hdr,
5591                     unsigned int proc_nr, unsigned int serial)
5592 {
5593   if (hdr->prog != GUESTFS_PROGRAM) {
5594     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5595     return -1;
5596   }
5597   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5598     error (g, \"wrong protocol version (%%d/%%d)\",
5599            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5600     return -1;
5601   }
5602   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5603     error (g, \"unexpected message direction (%%d/%%d)\",
5604            hdr->direction, GUESTFS_DIRECTION_REPLY);
5605     return -1;
5606   }
5607   if (hdr->proc != proc_nr) {
5608     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5609     return -1;
5610   }
5611   if (hdr->serial != serial) {
5612     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5613     return -1;
5614   }
5615
5616   return 0;
5617 }
5618
5619 /* Check we are in the right state to run a high-level action. */
5620 static int
5621 check_state (guestfs_h *g, const char *caller)
5622 {
5623   if (!guestfs__is_ready (g)) {
5624     if (guestfs__is_config (g) || guestfs__is_launching (g))
5625       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5626         caller);
5627     else
5628       error (g, \"%%s called from the wrong state, %%d != READY\",
5629         caller, guestfs__get_state (g));
5630     return -1;
5631   }
5632   return 0;
5633 }
5634
5635 ";
5636
5637   (* Generate code to generate guestfish call traces. *)
5638   let trace_call shortname style =
5639     pr "  if (guestfs__get_trace (g)) {\n";
5640
5641     let needs_i =
5642       List.exists (function
5643                    | StringList _ | DeviceList _ -> true
5644                    | _ -> false) (snd style) in
5645     if needs_i then (
5646       pr "    size_t i;\n";
5647       pr "\n"
5648     );
5649
5650     pr "    printf (\"%s\");\n" shortname;
5651     List.iter (
5652       function
5653       | String n                        (* strings *)
5654       | Device n
5655       | Pathname n
5656       | Dev_or_Path n
5657       | FileIn n
5658       | FileOut n ->
5659           (* guestfish doesn't support string escaping, so neither do we *)
5660           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5661       | OptString n ->                  (* string option *)
5662           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5663           pr "    else printf (\" null\");\n"
5664       | StringList n
5665       | DeviceList n ->                 (* string list *)
5666           pr "    putchar (' ');\n";
5667           pr "    putchar ('\"');\n";
5668           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5669           pr "      if (i > 0) putchar (' ');\n";
5670           pr "      fputs (%s[i], stdout);\n" n;
5671           pr "    }\n";
5672           pr "    putchar ('\"');\n";
5673       | Bool n ->                       (* boolean *)
5674           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5675       | Int n ->                        (* int *)
5676           pr "    printf (\" %%d\", %s);\n" n
5677       | Int64 n ->
5678           pr "    printf (\" %%\" PRIi64, %s);\n" n
5679     ) (snd style);
5680     pr "    putchar ('\\n');\n";
5681     pr "  }\n";
5682     pr "\n";
5683   in
5684
5685   (* For non-daemon functions, generate a wrapper around each function. *)
5686   List.iter (
5687     fun (shortname, style, _, _, _, _, _) ->
5688       let name = "guestfs_" ^ shortname in
5689
5690       generate_prototype ~extern:false ~semicolon:false ~newline:true
5691         ~handle:"g" name style;
5692       pr "{\n";
5693       trace_call shortname style;
5694       pr "  return guestfs__%s " shortname;
5695       generate_c_call_args ~handle:"g" style;
5696       pr ";\n";
5697       pr "}\n";
5698       pr "\n"
5699   ) non_daemon_functions;
5700
5701   (* Client-side stubs for each function. *)
5702   List.iter (
5703     fun (shortname, style, _, _, _, _, _) ->
5704       let name = "guestfs_" ^ shortname in
5705
5706       (* Generate the action stub. *)
5707       generate_prototype ~extern:false ~semicolon:false ~newline:true
5708         ~handle:"g" name style;
5709
5710       let error_code =
5711         match fst style with
5712         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5713         | RConstString _ | RConstOptString _ ->
5714             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5715         | RString _ | RStringList _
5716         | RStruct _ | RStructList _
5717         | RHashtable _ | RBufferOut _ ->
5718             "NULL" in
5719
5720       pr "{\n";
5721
5722       (match snd style with
5723        | [] -> ()
5724        | _ -> pr "  struct %s_args args;\n" name
5725       );
5726
5727       pr "  guestfs_message_header hdr;\n";
5728       pr "  guestfs_message_error err;\n";
5729       let has_ret =
5730         match fst style with
5731         | RErr -> false
5732         | RConstString _ | RConstOptString _ ->
5733             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5734         | RInt _ | RInt64 _
5735         | RBool _ | RString _ | RStringList _
5736         | RStruct _ | RStructList _
5737         | RHashtable _ | RBufferOut _ ->
5738             pr "  struct %s_ret ret;\n" name;
5739             true in
5740
5741       pr "  int serial;\n";
5742       pr "  int r;\n";
5743       pr "\n";
5744       trace_call shortname style;
5745       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5746       pr "  guestfs___set_busy (g);\n";
5747       pr "\n";
5748
5749       (* Send the main header and arguments. *)
5750       (match snd style with
5751        | [] ->
5752            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5753              (String.uppercase shortname)
5754        | args ->
5755            List.iter (
5756              function
5757              | Pathname n | Device n | Dev_or_Path n | String n ->
5758                  pr "  args.%s = (char *) %s;\n" n n
5759              | OptString n ->
5760                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5761              | StringList n | DeviceList n ->
5762                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5763                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5764              | Bool n ->
5765                  pr "  args.%s = %s;\n" n n
5766              | Int n ->
5767                  pr "  args.%s = %s;\n" n n
5768              | Int64 n ->
5769                  pr "  args.%s = %s;\n" n n
5770              | FileIn _ | FileOut _ -> ()
5771            ) args;
5772            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5773              (String.uppercase shortname);
5774            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5775              name;
5776       );
5777       pr "  if (serial == -1) {\n";
5778       pr "    guestfs___end_busy (g);\n";
5779       pr "    return %s;\n" error_code;
5780       pr "  }\n";
5781       pr "\n";
5782
5783       (* Send any additional files (FileIn) requested. *)
5784       let need_read_reply_label = ref false in
5785       List.iter (
5786         function
5787         | FileIn n ->
5788             pr "  r = guestfs___send_file (g, %s);\n" n;
5789             pr "  if (r == -1) {\n";
5790             pr "    guestfs___end_busy (g);\n";
5791             pr "    return %s;\n" error_code;
5792             pr "  }\n";
5793             pr "  if (r == -2) /* daemon cancelled */\n";
5794             pr "    goto read_reply;\n";
5795             need_read_reply_label := true;
5796             pr "\n";
5797         | _ -> ()
5798       ) (snd style);
5799
5800       (* Wait for the reply from the remote end. *)
5801       if !need_read_reply_label then pr " read_reply:\n";
5802       pr "  memset (&hdr, 0, sizeof hdr);\n";
5803       pr "  memset (&err, 0, sizeof err);\n";
5804       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5805       pr "\n";
5806       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5807       if not has_ret then
5808         pr "NULL, NULL"
5809       else
5810         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5811       pr ");\n";
5812
5813       pr "  if (r == -1) {\n";
5814       pr "    guestfs___end_busy (g);\n";
5815       pr "    return %s;\n" error_code;
5816       pr "  }\n";
5817       pr "\n";
5818
5819       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5820         (String.uppercase shortname);
5821       pr "    guestfs___end_busy (g);\n";
5822       pr "    return %s;\n" error_code;
5823       pr "  }\n";
5824       pr "\n";
5825
5826       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5827       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5828       pr "    free (err.error_message);\n";
5829       pr "    guestfs___end_busy (g);\n";
5830       pr "    return %s;\n" error_code;
5831       pr "  }\n";
5832       pr "\n";
5833
5834       (* Expecting to receive further files (FileOut)? *)
5835       List.iter (
5836         function
5837         | FileOut n ->
5838             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5839             pr "    guestfs___end_busy (g);\n";
5840             pr "    return %s;\n" error_code;
5841             pr "  }\n";
5842             pr "\n";
5843         | _ -> ()
5844       ) (snd style);
5845
5846       pr "  guestfs___end_busy (g);\n";
5847
5848       (match fst style with
5849        | RErr -> pr "  return 0;\n"
5850        | RInt n | RInt64 n | RBool n ->
5851            pr "  return ret.%s;\n" n
5852        | RConstString _ | RConstOptString _ ->
5853            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5854        | RString n ->
5855            pr "  return ret.%s; /* caller will free */\n" n
5856        | RStringList n | RHashtable n ->
5857            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5858            pr "  ret.%s.%s_val =\n" n n;
5859            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5860            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5861              n n;
5862            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5863            pr "  return ret.%s.%s_val;\n" n n
5864        | RStruct (n, _) ->
5865            pr "  /* caller will free this */\n";
5866            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5867        | RStructList (n, _) ->
5868            pr "  /* caller will free this */\n";
5869            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5870        | RBufferOut n ->
5871            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5872            pr "   * _val might be NULL here.  To make the API saner for\n";
5873            pr "   * callers, we turn this case into a unique pointer (using\n";
5874            pr "   * malloc(1)).\n";
5875            pr "   */\n";
5876            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5877            pr "    *size_r = ret.%s.%s_len;\n" n n;
5878            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5879            pr "  } else {\n";
5880            pr "    free (ret.%s.%s_val);\n" n n;
5881            pr "    char *p = safe_malloc (g, 1);\n";
5882            pr "    *size_r = ret.%s.%s_len;\n" n n;
5883            pr "    return p;\n";
5884            pr "  }\n";
5885       );
5886
5887       pr "}\n\n"
5888   ) daemon_functions;
5889
5890   (* Functions to free structures. *)
5891   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5892   pr " * structure format is identical to the XDR format.  See note in\n";
5893   pr " * generator.ml.\n";
5894   pr " */\n";
5895   pr "\n";
5896
5897   List.iter (
5898     fun (typ, _) ->
5899       pr "void\n";
5900       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5901       pr "{\n";
5902       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5903       pr "  free (x);\n";
5904       pr "}\n";
5905       pr "\n";
5906
5907       pr "void\n";
5908       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5909       pr "{\n";
5910       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5911       pr "  free (x);\n";
5912       pr "}\n";
5913       pr "\n";
5914
5915   ) structs;
5916
5917 (* Generate daemon/actions.h. *)
5918 and generate_daemon_actions_h () =
5919   generate_header CStyle GPLv2plus;
5920
5921   pr "#include \"../src/guestfs_protocol.h\"\n";
5922   pr "\n";
5923
5924   List.iter (
5925     fun (name, style, _, _, _, _, _) ->
5926       generate_prototype
5927         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5928         name style;
5929   ) daemon_functions
5930
5931 (* Generate the linker script which controls the visibility of
5932  * symbols in the public ABI and ensures no other symbols get
5933  * exported accidentally.
5934  *)
5935 and generate_linker_script () =
5936   generate_header HashStyle GPLv2plus;
5937
5938   let globals = [
5939     "guestfs_create";
5940     "guestfs_close";
5941     "guestfs_get_error_handler";
5942     "guestfs_get_out_of_memory_handler";
5943     "guestfs_last_error";
5944     "guestfs_set_error_handler";
5945     "guestfs_set_launch_done_callback";
5946     "guestfs_set_log_message_callback";
5947     "guestfs_set_out_of_memory_handler";
5948     "guestfs_set_subprocess_quit_callback";
5949
5950     (* Unofficial parts of the API: the bindings code use these
5951      * functions, so it is useful to export them.
5952      *)
5953     "guestfs_safe_calloc";
5954     "guestfs_safe_malloc";
5955     "guestfs_safe_strdup";
5956     "guestfs_safe_memdup";
5957   ] in
5958   let functions =
5959     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5960       all_functions in
5961   let structs =
5962     List.concat (
5963       List.map (fun (typ, _) ->
5964                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5965         structs
5966     ) in
5967   let globals = List.sort compare (globals @ functions @ structs) in
5968
5969   pr "{\n";
5970   pr "    global:\n";
5971   List.iter (pr "        %s;\n") globals;
5972   pr "\n";
5973
5974   pr "    local:\n";
5975   pr "        *;\n";
5976   pr "};\n"
5977
5978 (* Generate the server-side stubs. *)
5979 and generate_daemon_actions () =
5980   generate_header CStyle GPLv2plus;
5981
5982   pr "#include <config.h>\n";
5983   pr "\n";
5984   pr "#include <stdio.h>\n";
5985   pr "#include <stdlib.h>\n";
5986   pr "#include <string.h>\n";
5987   pr "#include <inttypes.h>\n";
5988   pr "#include <rpc/types.h>\n";
5989   pr "#include <rpc/xdr.h>\n";
5990   pr "\n";
5991   pr "#include \"daemon.h\"\n";
5992   pr "#include \"c-ctype.h\"\n";
5993   pr "#include \"../src/guestfs_protocol.h\"\n";
5994   pr "#include \"actions.h\"\n";
5995   pr "\n";
5996
5997   List.iter (
5998     fun (name, style, _, _, _, _, _) ->
5999       (* Generate server-side stubs. *)
6000       pr "static void %s_stub (XDR *xdr_in)\n" name;
6001       pr "{\n";
6002       let error_code =
6003         match fst style with
6004         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6005         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6006         | RBool _ -> pr "  int r;\n"; "-1"
6007         | RConstString _ | RConstOptString _ ->
6008             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6009         | RString _ -> pr "  char *r;\n"; "NULL"
6010         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6011         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6012         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6013         | RBufferOut _ ->
6014             pr "  size_t size = 1;\n";
6015             pr "  char *r;\n";
6016             "NULL" in
6017
6018       (match snd style with
6019        | [] -> ()
6020        | args ->
6021            pr "  struct guestfs_%s_args args;\n" name;
6022            List.iter (
6023              function
6024              | Device n | Dev_or_Path n
6025              | Pathname n
6026              | String n -> ()
6027              | OptString n -> pr "  char *%s;\n" n
6028              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6029              | Bool n -> pr "  int %s;\n" n
6030              | Int n -> pr "  int %s;\n" n
6031              | Int64 n -> pr "  int64_t %s;\n" n
6032              | FileIn _ | FileOut _ -> ()
6033            ) args
6034       );
6035       pr "\n";
6036
6037       (match snd style with
6038        | [] -> ()
6039        | args ->
6040            pr "  memset (&args, 0, sizeof args);\n";
6041            pr "\n";
6042            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6043            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6044            pr "    return;\n";
6045            pr "  }\n";
6046            let pr_args n =
6047              pr "  char *%s = args.%s;\n" n n
6048            in
6049            let pr_list_handling_code n =
6050              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6051              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6052              pr "  if (%s == NULL) {\n" n;
6053              pr "    reply_with_perror (\"realloc\");\n";
6054              pr "    goto done;\n";
6055              pr "  }\n";
6056              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6057              pr "  args.%s.%s_val = %s;\n" n n n;
6058            in
6059            List.iter (
6060              function
6061              | Pathname n ->
6062                  pr_args n;
6063                  pr "  ABS_PATH (%s, goto done);\n" n;
6064              | Device n ->
6065                  pr_args n;
6066                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6067              | Dev_or_Path n ->
6068                  pr_args n;
6069                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6070              | String n -> pr_args n
6071              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6072              | StringList n ->
6073                  pr_list_handling_code n;
6074              | DeviceList n ->
6075                  pr_list_handling_code n;
6076                  pr "  /* Ensure that each is a device,\n";
6077                  pr "   * and perform device name translation.\n";
6078                  pr "   */\n";
6079                  pr "  {\n";
6080                  pr "    size_t i;\n";
6081                  pr "    for (i = 0; %s[i] != NULL; ++i)\n" n;
6082                  pr "      RESOLVE_DEVICE (%s[i], goto done);\n" n;
6083                  pr "  }\n";
6084              | Bool n -> pr "  %s = args.%s;\n" n n
6085              | Int n -> pr "  %s = args.%s;\n" n n
6086              | Int64 n -> pr "  %s = args.%s;\n" n n
6087              | FileIn _ | FileOut _ -> ()
6088            ) args;
6089            pr "\n"
6090       );
6091
6092
6093       (* this is used at least for do_equal *)
6094       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6095         (* Emit NEED_ROOT just once, even when there are two or
6096            more Pathname args *)
6097         pr "  NEED_ROOT (goto done);\n";
6098       );
6099
6100       (* Don't want to call the impl with any FileIn or FileOut
6101        * parameters, since these go "outside" the RPC protocol.
6102        *)
6103       let args' =
6104         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6105           (snd style) in
6106       pr "  r = do_%s " name;
6107       generate_c_call_args (fst style, args');
6108       pr ";\n";
6109
6110       (match fst style with
6111        | RErr | RInt _ | RInt64 _ | RBool _
6112        | RConstString _ | RConstOptString _
6113        | RString _ | RStringList _ | RHashtable _
6114        | RStruct (_, _) | RStructList (_, _) ->
6115            pr "  if (r == %s)\n" error_code;
6116            pr "    /* do_%s has already called reply_with_error */\n" name;
6117            pr "    goto done;\n";
6118            pr "\n"
6119        | RBufferOut _ ->
6120            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6121            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6122            pr "   */\n";
6123            pr "  if (size == 1 && r == %s)\n" error_code;
6124            pr "    /* do_%s has already called reply_with_error */\n" name;
6125            pr "    goto done;\n";
6126            pr "\n"
6127       );
6128
6129       (* If there are any FileOut parameters, then the impl must
6130        * send its own reply.
6131        *)
6132       let no_reply =
6133         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6134       if no_reply then
6135         pr "  /* do_%s has already sent a reply */\n" name
6136       else (
6137         match fst style with
6138         | RErr -> pr "  reply (NULL, NULL);\n"
6139         | RInt n | RInt64 n | RBool n ->
6140             pr "  struct guestfs_%s_ret ret;\n" name;
6141             pr "  ret.%s = r;\n" n;
6142             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6143               name
6144         | RConstString _ | RConstOptString _ ->
6145             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6146         | RString n ->
6147             pr "  struct guestfs_%s_ret ret;\n" name;
6148             pr "  ret.%s = r;\n" n;
6149             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6150               name;
6151             pr "  free (r);\n"
6152         | RStringList n | RHashtable n ->
6153             pr "  struct guestfs_%s_ret ret;\n" name;
6154             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6155             pr "  ret.%s.%s_val = r;\n" n n;
6156             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6157               name;
6158             pr "  free_strings (r);\n"
6159         | RStruct (n, _) ->
6160             pr "  struct guestfs_%s_ret ret;\n" name;
6161             pr "  ret.%s = *r;\n" n;
6162             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6163               name;
6164             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6165               name
6166         | RStructList (n, _) ->
6167             pr "  struct guestfs_%s_ret ret;\n" name;
6168             pr "  ret.%s = *r;\n" n;
6169             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6170               name;
6171             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6172               name
6173         | RBufferOut n ->
6174             pr "  struct guestfs_%s_ret ret;\n" name;
6175             pr "  ret.%s.%s_val = r;\n" n n;
6176             pr "  ret.%s.%s_len = size;\n" n n;
6177             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6178               name;
6179             pr "  free (r);\n"
6180       );
6181
6182       (* Free the args. *)
6183       (match snd style with
6184        | [] ->
6185            pr "done: ;\n";
6186        | _ ->
6187            pr "done:\n";
6188            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6189              name
6190       );
6191
6192       pr "}\n\n";
6193   ) daemon_functions;
6194
6195   (* Dispatch function. *)
6196   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6197   pr "{\n";
6198   pr "  switch (proc_nr) {\n";
6199
6200   List.iter (
6201     fun (name, style, _, _, _, _, _) ->
6202       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6203       pr "      %s_stub (xdr_in);\n" name;
6204       pr "      break;\n"
6205   ) daemon_functions;
6206
6207   pr "    default:\n";
6208   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";
6209   pr "  }\n";
6210   pr "}\n";
6211   pr "\n";
6212
6213   (* LVM columns and tokenization functions. *)
6214   (* XXX This generates crap code.  We should rethink how we
6215    * do this parsing.
6216    *)
6217   List.iter (
6218     function
6219     | typ, cols ->
6220         pr "static const char *lvm_%s_cols = \"%s\";\n"
6221           typ (String.concat "," (List.map fst cols));
6222         pr "\n";
6223
6224         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6225         pr "{\n";
6226         pr "  char *tok, *p, *next;\n";
6227         pr "  size_t i, j;\n";
6228         pr "\n";
6229         (*
6230           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6231           pr "\n";
6232         *)
6233         pr "  if (!str) {\n";
6234         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6235         pr "    return -1;\n";
6236         pr "  }\n";
6237         pr "  if (!*str || c_isspace (*str)) {\n";
6238         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6239         pr "    return -1;\n";
6240         pr "  }\n";
6241         pr "  tok = str;\n";
6242         List.iter (
6243           fun (name, coltype) ->
6244             pr "  if (!tok) {\n";
6245             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6246             pr "    return -1;\n";
6247             pr "  }\n";
6248             pr "  p = strchrnul (tok, ',');\n";
6249             pr "  if (*p) next = p+1; else next = NULL;\n";
6250             pr "  *p = '\\0';\n";
6251             (match coltype with
6252              | FString ->
6253                  pr "  r->%s = strdup (tok);\n" name;
6254                  pr "  if (r->%s == NULL) {\n" name;
6255                  pr "    perror (\"strdup\");\n";
6256                  pr "    return -1;\n";
6257                  pr "  }\n"
6258              | FUUID ->
6259                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6260                  pr "    if (tok[j] == '\\0') {\n";
6261                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6262                  pr "      return -1;\n";
6263                  pr "    } else if (tok[j] != '-')\n";
6264                  pr "      r->%s[i++] = tok[j];\n" name;
6265                  pr "  }\n";
6266              | FBytes ->
6267                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6268                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6269                  pr "    return -1;\n";
6270                  pr "  }\n";
6271              | FInt64 ->
6272                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6273                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6274                  pr "    return -1;\n";
6275                  pr "  }\n";
6276              | FOptPercent ->
6277                  pr "  if (tok[0] == '\\0')\n";
6278                  pr "    r->%s = -1;\n" name;
6279                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6280                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6281                  pr "    return -1;\n";
6282                  pr "  }\n";
6283              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6284                  assert false (* can never be an LVM column *)
6285             );
6286             pr "  tok = next;\n";
6287         ) cols;
6288
6289         pr "  if (tok != NULL) {\n";
6290         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6291         pr "    return -1;\n";
6292         pr "  }\n";
6293         pr "  return 0;\n";
6294         pr "}\n";
6295         pr "\n";
6296
6297         pr "guestfs_int_lvm_%s_list *\n" typ;
6298         pr "parse_command_line_%ss (void)\n" typ;
6299         pr "{\n";
6300         pr "  char *out, *err;\n";
6301         pr "  char *p, *pend;\n";
6302         pr "  int r, i;\n";
6303         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6304         pr "  void *newp;\n";
6305         pr "\n";
6306         pr "  ret = malloc (sizeof *ret);\n";
6307         pr "  if (!ret) {\n";
6308         pr "    reply_with_perror (\"malloc\");\n";
6309         pr "    return NULL;\n";
6310         pr "  }\n";
6311         pr "\n";
6312         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6313         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6314         pr "\n";
6315         pr "  r = command (&out, &err,\n";
6316         pr "           \"lvm\", \"%ss\",\n" typ;
6317         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6318         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6319         pr "  if (r == -1) {\n";
6320         pr "    reply_with_error (\"%%s\", err);\n";
6321         pr "    free (out);\n";
6322         pr "    free (err);\n";
6323         pr "    free (ret);\n";
6324         pr "    return NULL;\n";
6325         pr "  }\n";
6326         pr "\n";
6327         pr "  free (err);\n";
6328         pr "\n";
6329         pr "  /* Tokenize each line of the output. */\n";
6330         pr "  p = out;\n";
6331         pr "  i = 0;\n";
6332         pr "  while (p) {\n";
6333         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6334         pr "    if (pend) {\n";
6335         pr "      *pend = '\\0';\n";
6336         pr "      pend++;\n";
6337         pr "    }\n";
6338         pr "\n";
6339         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6340         pr "      p++;\n";
6341         pr "\n";
6342         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6343         pr "      p = pend;\n";
6344         pr "      continue;\n";
6345         pr "    }\n";
6346         pr "\n";
6347         pr "    /* Allocate some space to store this next entry. */\n";
6348         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6349         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6350         pr "    if (newp == NULL) {\n";
6351         pr "      reply_with_perror (\"realloc\");\n";
6352         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6353         pr "      free (ret);\n";
6354         pr "      free (out);\n";
6355         pr "      return NULL;\n";
6356         pr "    }\n";
6357         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6358         pr "\n";
6359         pr "    /* Tokenize the next entry. */\n";
6360         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6361         pr "    if (r == -1) {\n";
6362         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6363         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6364         pr "      free (ret);\n";
6365         pr "      free (out);\n";
6366         pr "      return NULL;\n";
6367         pr "    }\n";
6368         pr "\n";
6369         pr "    ++i;\n";
6370         pr "    p = pend;\n";
6371         pr "  }\n";
6372         pr "\n";
6373         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6374         pr "\n";
6375         pr "  free (out);\n";
6376         pr "  return ret;\n";
6377         pr "}\n"
6378
6379   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6380
6381 (* Generate a list of function names, for debugging in the daemon.. *)
6382 and generate_daemon_names () =
6383   generate_header CStyle GPLv2plus;
6384
6385   pr "#include <config.h>\n";
6386   pr "\n";
6387   pr "#include \"daemon.h\"\n";
6388   pr "\n";
6389
6390   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6391   pr "const char *function_names[] = {\n";
6392   List.iter (
6393     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6394   ) daemon_functions;
6395   pr "};\n";
6396
6397 (* Generate the optional groups for the daemon to implement
6398  * guestfs_available.
6399  *)
6400 and generate_daemon_optgroups_c () =
6401   generate_header CStyle GPLv2plus;
6402
6403   pr "#include <config.h>\n";
6404   pr "\n";
6405   pr "#include \"daemon.h\"\n";
6406   pr "#include \"optgroups.h\"\n";
6407   pr "\n";
6408
6409   pr "struct optgroup optgroups[] = {\n";
6410   List.iter (
6411     fun (group, _) ->
6412       pr "  { \"%s\", optgroup_%s_available },\n" group group
6413   ) optgroups;
6414   pr "  { NULL, NULL }\n";
6415   pr "};\n"
6416
6417 and generate_daemon_optgroups_h () =
6418   generate_header CStyle GPLv2plus;
6419
6420   List.iter (
6421     fun (group, _) ->
6422       pr "extern int optgroup_%s_available (void);\n" group
6423   ) optgroups
6424
6425 (* Generate the tests. *)
6426 and generate_tests () =
6427   generate_header CStyle GPLv2plus;
6428
6429   pr "\
6430 #include <stdio.h>
6431 #include <stdlib.h>
6432 #include <string.h>
6433 #include <unistd.h>
6434 #include <sys/types.h>
6435 #include <fcntl.h>
6436
6437 #include \"guestfs.h\"
6438 #include \"guestfs-internal.h\"
6439
6440 static guestfs_h *g;
6441 static int suppress_error = 0;
6442
6443 static void print_error (guestfs_h *g, void *data, const char *msg)
6444 {
6445   if (!suppress_error)
6446     fprintf (stderr, \"%%s\\n\", msg);
6447 }
6448
6449 /* FIXME: nearly identical code appears in fish.c */
6450 static void print_strings (char *const *argv)
6451 {
6452   size_t argc;
6453
6454   for (argc = 0; argv[argc] != NULL; ++argc)
6455     printf (\"\\t%%s\\n\", argv[argc]);
6456 }
6457
6458 /*
6459 static void print_table (char const *const *argv)
6460 {
6461   size_t i;
6462
6463   for (i = 0; argv[i] != NULL; i += 2)
6464     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6465 }
6466 */
6467
6468 static int
6469 is_available (const char *group)
6470 {
6471   const char *groups[] = { group, NULL };
6472   int r;
6473
6474   suppress_error = 1;
6475   r = guestfs_available (g, (char **) groups);
6476   suppress_error = 0;
6477
6478   return r == 0;
6479 }
6480
6481 ";
6482
6483   (* Generate a list of commands which are not tested anywhere. *)
6484   pr "static void no_test_warnings (void)\n";
6485   pr "{\n";
6486
6487   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6488   List.iter (
6489     fun (_, _, _, _, tests, _, _) ->
6490       let tests = filter_map (
6491         function
6492         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
6493         | (_, Disabled, _) -> None
6494       ) tests in
6495       let seq = List.concat (List.map seq_of_test tests) in
6496       let cmds_tested = List.map List.hd seq in
6497       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6498   ) all_functions;
6499
6500   List.iter (
6501     fun (name, _, _, _, _, _, _) ->
6502       if not (Hashtbl.mem hash name) then
6503         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6504   ) all_functions;
6505
6506   pr "}\n";
6507   pr "\n";
6508
6509   (* Generate the actual tests.  Note that we generate the tests
6510    * in reverse order, deliberately, so that (in general) the
6511    * newest tests run first.  This makes it quicker and easier to
6512    * debug them.
6513    *)
6514   let test_names =
6515     List.map (
6516       fun (name, _, _, flags, tests, _, _) ->
6517         mapi (generate_one_test name flags) tests
6518     ) (List.rev all_functions) in
6519   let test_names = List.concat test_names in
6520   let nr_tests = List.length test_names in
6521
6522   pr "\
6523 int main (int argc, char *argv[])
6524 {
6525   char c = 0;
6526   unsigned long int n_failed = 0;
6527   const char *filename;
6528   int fd;
6529   int nr_tests, test_num = 0;
6530
6531   setbuf (stdout, NULL);
6532
6533   no_test_warnings ();
6534
6535   g = guestfs_create ();
6536   if (g == NULL) {
6537     printf (\"guestfs_create FAILED\\n\");
6538     exit (EXIT_FAILURE);
6539   }
6540
6541   guestfs_set_error_handler (g, print_error, NULL);
6542
6543   guestfs_set_path (g, \"../appliance\");
6544
6545   filename = \"test1.img\";
6546   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6547   if (fd == -1) {
6548     perror (filename);
6549     exit (EXIT_FAILURE);
6550   }
6551   if (lseek (fd, %d, SEEK_SET) == -1) {
6552     perror (\"lseek\");
6553     close (fd);
6554     unlink (filename);
6555     exit (EXIT_FAILURE);
6556   }
6557   if (write (fd, &c, 1) == -1) {
6558     perror (\"write\");
6559     close (fd);
6560     unlink (filename);
6561     exit (EXIT_FAILURE);
6562   }
6563   if (close (fd) == -1) {
6564     perror (filename);
6565     unlink (filename);
6566     exit (EXIT_FAILURE);
6567   }
6568   if (guestfs_add_drive (g, filename) == -1) {
6569     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6570     exit (EXIT_FAILURE);
6571   }
6572
6573   filename = \"test2.img\";
6574   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6575   if (fd == -1) {
6576     perror (filename);
6577     exit (EXIT_FAILURE);
6578   }
6579   if (lseek (fd, %d, SEEK_SET) == -1) {
6580     perror (\"lseek\");
6581     close (fd);
6582     unlink (filename);
6583     exit (EXIT_FAILURE);
6584   }
6585   if (write (fd, &c, 1) == -1) {
6586     perror (\"write\");
6587     close (fd);
6588     unlink (filename);
6589     exit (EXIT_FAILURE);
6590   }
6591   if (close (fd) == -1) {
6592     perror (filename);
6593     unlink (filename);
6594     exit (EXIT_FAILURE);
6595   }
6596   if (guestfs_add_drive (g, filename) == -1) {
6597     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6598     exit (EXIT_FAILURE);
6599   }
6600
6601   filename = \"test3.img\";
6602   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6603   if (fd == -1) {
6604     perror (filename);
6605     exit (EXIT_FAILURE);
6606   }
6607   if (lseek (fd, %d, SEEK_SET) == -1) {
6608     perror (\"lseek\");
6609     close (fd);
6610     unlink (filename);
6611     exit (EXIT_FAILURE);
6612   }
6613   if (write (fd, &c, 1) == -1) {
6614     perror (\"write\");
6615     close (fd);
6616     unlink (filename);
6617     exit (EXIT_FAILURE);
6618   }
6619   if (close (fd) == -1) {
6620     perror (filename);
6621     unlink (filename);
6622     exit (EXIT_FAILURE);
6623   }
6624   if (guestfs_add_drive (g, filename) == -1) {
6625     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6626     exit (EXIT_FAILURE);
6627   }
6628
6629   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6630     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6631     exit (EXIT_FAILURE);
6632   }
6633
6634   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6635   alarm (600);
6636
6637   if (guestfs_launch (g) == -1) {
6638     printf (\"guestfs_launch FAILED\\n\");
6639     exit (EXIT_FAILURE);
6640   }
6641
6642   /* Cancel previous alarm. */
6643   alarm (0);
6644
6645   nr_tests = %d;
6646
6647 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6648
6649   iteri (
6650     fun i test_name ->
6651       pr "  test_num++;\n";
6652       pr "  if (guestfs_get_verbose (g))\n";
6653       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6654       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6655       pr "  if (%s () == -1) {\n" test_name;
6656       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6657       pr "    n_failed++;\n";
6658       pr "  }\n";
6659   ) test_names;
6660   pr "\n";
6661
6662   pr "  guestfs_close (g);\n";
6663   pr "  unlink (\"test1.img\");\n";
6664   pr "  unlink (\"test2.img\");\n";
6665   pr "  unlink (\"test3.img\");\n";
6666   pr "\n";
6667
6668   pr "  if (n_failed > 0) {\n";
6669   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6670   pr "    exit (EXIT_FAILURE);\n";
6671   pr "  }\n";
6672   pr "\n";
6673
6674   pr "  exit (EXIT_SUCCESS);\n";
6675   pr "}\n"
6676
6677 and generate_one_test name flags i (init, prereq, test) =
6678   let test_name = sprintf "test_%s_%d" name i in
6679
6680   pr "\
6681 static int %s_skip (void)
6682 {
6683   const char *str;
6684
6685   str = getenv (\"TEST_ONLY\");
6686   if (str)
6687     return strstr (str, \"%s\") == NULL;
6688   str = getenv (\"SKIP_%s\");
6689   if (str && STREQ (str, \"1\")) return 1;
6690   str = getenv (\"SKIP_TEST_%s\");
6691   if (str && STREQ (str, \"1\")) return 1;
6692   return 0;
6693 }
6694
6695 " test_name name (String.uppercase test_name) (String.uppercase name);
6696
6697   (match prereq with
6698    | Disabled | Always | IfAvailable _ -> ()
6699    | If code | Unless code ->
6700        pr "static int %s_prereq (void)\n" test_name;
6701        pr "{\n";
6702        pr "  %s\n" code;
6703        pr "}\n";
6704        pr "\n";
6705   );
6706
6707   pr "\
6708 static int %s (void)
6709 {
6710   if (%s_skip ()) {
6711     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6712     return 0;
6713   }
6714
6715 " test_name test_name test_name;
6716
6717   (* Optional functions should only be tested if the relevant
6718    * support is available in the daemon.
6719    *)
6720   List.iter (
6721     function
6722     | Optional group ->
6723         pr "  if (!is_available (\"%s\")) {\n" group;
6724         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
6725         pr "    return 0;\n";
6726         pr "  }\n";
6727     | _ -> ()
6728   ) flags;
6729
6730   (match prereq with
6731    | Disabled ->
6732        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6733    | If _ ->
6734        pr "  if (! %s_prereq ()) {\n" test_name;
6735        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6736        pr "    return 0;\n";
6737        pr "  }\n";
6738        pr "\n";
6739        generate_one_test_body name i test_name init test;
6740    | Unless _ ->
6741        pr "  if (%s_prereq ()) {\n" test_name;
6742        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6743        pr "    return 0;\n";
6744        pr "  }\n";
6745        pr "\n";
6746        generate_one_test_body name i test_name init test;
6747    | IfAvailable group ->
6748        pr "  if (!is_available (\"%s\")) {\n" group;
6749        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
6750        pr "    return 0;\n";
6751        pr "  }\n";
6752        pr "\n";
6753        generate_one_test_body name i test_name init test;
6754    | Always ->
6755        generate_one_test_body name i test_name init test
6756   );
6757
6758   pr "  return 0;\n";
6759   pr "}\n";
6760   pr "\n";
6761   test_name
6762
6763 and generate_one_test_body name i test_name init test =
6764   (match init with
6765    | InitNone (* XXX at some point, InitNone and InitEmpty became
6766                * folded together as the same thing.  Really we should
6767                * make InitNone do nothing at all, but the tests may
6768                * need to be checked to make sure this is OK.
6769                *)
6770    | InitEmpty ->
6771        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6772        List.iter (generate_test_command_call test_name)
6773          [["blockdev_setrw"; "/dev/sda"];
6774           ["umount_all"];
6775           ["lvm_remove_all"]]
6776    | InitPartition ->
6777        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6778        List.iter (generate_test_command_call test_name)
6779          [["blockdev_setrw"; "/dev/sda"];
6780           ["umount_all"];
6781           ["lvm_remove_all"];
6782           ["part_disk"; "/dev/sda"; "mbr"]]
6783    | InitBasicFS ->
6784        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6785        List.iter (generate_test_command_call test_name)
6786          [["blockdev_setrw"; "/dev/sda"];
6787           ["umount_all"];
6788           ["lvm_remove_all"];
6789           ["part_disk"; "/dev/sda"; "mbr"];
6790           ["mkfs"; "ext2"; "/dev/sda1"];
6791           ["mount_options"; ""; "/dev/sda1"; "/"]]
6792    | InitBasicFSonLVM ->
6793        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6794          test_name;
6795        List.iter (generate_test_command_call test_name)
6796          [["blockdev_setrw"; "/dev/sda"];
6797           ["umount_all"];
6798           ["lvm_remove_all"];
6799           ["part_disk"; "/dev/sda"; "mbr"];
6800           ["pvcreate"; "/dev/sda1"];
6801           ["vgcreate"; "VG"; "/dev/sda1"];
6802           ["lvcreate"; "LV"; "VG"; "8"];
6803           ["mkfs"; "ext2"; "/dev/VG/LV"];
6804           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6805    | InitISOFS ->
6806        pr "  /* InitISOFS for %s */\n" test_name;
6807        List.iter (generate_test_command_call test_name)
6808          [["blockdev_setrw"; "/dev/sda"];
6809           ["umount_all"];
6810           ["lvm_remove_all"];
6811           ["mount_ro"; "/dev/sdd"; "/"]]
6812   );
6813
6814   let get_seq_last = function
6815     | [] ->
6816         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6817           test_name
6818     | seq ->
6819         let seq = List.rev seq in
6820         List.rev (List.tl seq), List.hd seq
6821   in
6822
6823   match test with
6824   | TestRun seq ->
6825       pr "  /* TestRun for %s (%d) */\n" name i;
6826       List.iter (generate_test_command_call test_name) seq
6827   | TestOutput (seq, expected) ->
6828       pr "  /* TestOutput for %s (%d) */\n" name i;
6829       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6830       let seq, last = get_seq_last seq in
6831       let test () =
6832         pr "    if (STRNEQ (r, expected)) {\n";
6833         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6834         pr "      return -1;\n";
6835         pr "    }\n"
6836       in
6837       List.iter (generate_test_command_call test_name) seq;
6838       generate_test_command_call ~test test_name last
6839   | TestOutputList (seq, expected) ->
6840       pr "  /* TestOutputList for %s (%d) */\n" name i;
6841       let seq, last = get_seq_last seq in
6842       let test () =
6843         iteri (
6844           fun i str ->
6845             pr "    if (!r[%d]) {\n" i;
6846             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6847             pr "      print_strings (r);\n";
6848             pr "      return -1;\n";
6849             pr "    }\n";
6850             pr "    {\n";
6851             pr "      const char *expected = \"%s\";\n" (c_quote str);
6852             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6853             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6854             pr "        return -1;\n";
6855             pr "      }\n";
6856             pr "    }\n"
6857         ) expected;
6858         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6859         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6860           test_name;
6861         pr "      print_strings (r);\n";
6862         pr "      return -1;\n";
6863         pr "    }\n"
6864       in
6865       List.iter (generate_test_command_call test_name) seq;
6866       generate_test_command_call ~test test_name last
6867   | TestOutputListOfDevices (seq, expected) ->
6868       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6869       let seq, last = get_seq_last seq in
6870       let test () =
6871         iteri (
6872           fun i str ->
6873             pr "    if (!r[%d]) {\n" i;
6874             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6875             pr "      print_strings (r);\n";
6876             pr "      return -1;\n";
6877             pr "    }\n";
6878             pr "    {\n";
6879             pr "      const char *expected = \"%s\";\n" (c_quote str);
6880             pr "      r[%d][5] = 's';\n" i;
6881             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6882             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6883             pr "        return -1;\n";
6884             pr "      }\n";
6885             pr "    }\n"
6886         ) expected;
6887         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6888         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6889           test_name;
6890         pr "      print_strings (r);\n";
6891         pr "      return -1;\n";
6892         pr "    }\n"
6893       in
6894       List.iter (generate_test_command_call test_name) seq;
6895       generate_test_command_call ~test test_name last
6896   | TestOutputInt (seq, expected) ->
6897       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6898       let seq, last = get_seq_last seq in
6899       let test () =
6900         pr "    if (r != %d) {\n" expected;
6901         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6902           test_name expected;
6903         pr "               (int) r);\n";
6904         pr "      return -1;\n";
6905         pr "    }\n"
6906       in
6907       List.iter (generate_test_command_call test_name) seq;
6908       generate_test_command_call ~test test_name last
6909   | TestOutputIntOp (seq, op, expected) ->
6910       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6911       let seq, last = get_seq_last seq in
6912       let test () =
6913         pr "    if (! (r %s %d)) {\n" op expected;
6914         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6915           test_name op expected;
6916         pr "               (int) r);\n";
6917         pr "      return -1;\n";
6918         pr "    }\n"
6919       in
6920       List.iter (generate_test_command_call test_name) seq;
6921       generate_test_command_call ~test test_name last
6922   | TestOutputTrue seq ->
6923       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6924       let seq, last = get_seq_last seq in
6925       let test () =
6926         pr "    if (!r) {\n";
6927         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6928           test_name;
6929         pr "      return -1;\n";
6930         pr "    }\n"
6931       in
6932       List.iter (generate_test_command_call test_name) seq;
6933       generate_test_command_call ~test test_name last
6934   | TestOutputFalse seq ->
6935       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6936       let seq, last = get_seq_last seq in
6937       let test () =
6938         pr "    if (r) {\n";
6939         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6940           test_name;
6941         pr "      return -1;\n";
6942         pr "    }\n"
6943       in
6944       List.iter (generate_test_command_call test_name) seq;
6945       generate_test_command_call ~test test_name last
6946   | TestOutputLength (seq, expected) ->
6947       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6948       let seq, last = get_seq_last seq in
6949       let test () =
6950         pr "    int j;\n";
6951         pr "    for (j = 0; j < %d; ++j)\n" expected;
6952         pr "      if (r[j] == NULL) {\n";
6953         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6954           test_name;
6955         pr "        print_strings (r);\n";
6956         pr "        return -1;\n";
6957         pr "      }\n";
6958         pr "    if (r[j] != NULL) {\n";
6959         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6960           test_name;
6961         pr "      print_strings (r);\n";
6962         pr "      return -1;\n";
6963         pr "    }\n"
6964       in
6965       List.iter (generate_test_command_call test_name) seq;
6966       generate_test_command_call ~test test_name last
6967   | TestOutputBuffer (seq, expected) ->
6968       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6969       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6970       let seq, last = get_seq_last seq in
6971       let len = String.length expected in
6972       let test () =
6973         pr "    if (size != %d) {\n" len;
6974         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6975         pr "      return -1;\n";
6976         pr "    }\n";
6977         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6978         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6979         pr "      return -1;\n";
6980         pr "    }\n"
6981       in
6982       List.iter (generate_test_command_call test_name) seq;
6983       generate_test_command_call ~test test_name last
6984   | TestOutputStruct (seq, checks) ->
6985       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6986       let seq, last = get_seq_last seq in
6987       let test () =
6988         List.iter (
6989           function
6990           | CompareWithInt (field, expected) ->
6991               pr "    if (r->%s != %d) {\n" field expected;
6992               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6993                 test_name field expected;
6994               pr "               (int) r->%s);\n" field;
6995               pr "      return -1;\n";
6996               pr "    }\n"
6997           | CompareWithIntOp (field, op, expected) ->
6998               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6999               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
7000                 test_name field op expected;
7001               pr "               (int) r->%s);\n" field;
7002               pr "      return -1;\n";
7003               pr "    }\n"
7004           | CompareWithString (field, expected) ->
7005               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7006               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7007                 test_name field expected;
7008               pr "               r->%s);\n" field;
7009               pr "      return -1;\n";
7010               pr "    }\n"
7011           | CompareFieldsIntEq (field1, field2) ->
7012               pr "    if (r->%s != r->%s) {\n" field1 field2;
7013               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7014                 test_name field1 field2;
7015               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7016               pr "      return -1;\n";
7017               pr "    }\n"
7018           | CompareFieldsStrEq (field1, field2) ->
7019               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7020               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7021                 test_name field1 field2;
7022               pr "               r->%s, r->%s);\n" field1 field2;
7023               pr "      return -1;\n";
7024               pr "    }\n"
7025         ) checks
7026       in
7027       List.iter (generate_test_command_call test_name) seq;
7028       generate_test_command_call ~test test_name last
7029   | TestLastFail seq ->
7030       pr "  /* TestLastFail for %s (%d) */\n" name i;
7031       let seq, last = get_seq_last seq in
7032       List.iter (generate_test_command_call test_name) seq;
7033       generate_test_command_call test_name ~expect_error:true last
7034
7035 (* Generate the code to run a command, leaving the result in 'r'.
7036  * If you expect to get an error then you should set expect_error:true.
7037  *)
7038 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7039   match cmd with
7040   | [] -> assert false
7041   | name :: args ->
7042       (* Look up the command to find out what args/ret it has. *)
7043       let style =
7044         try
7045           let _, style, _, _, _, _, _ =
7046             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7047           style
7048         with Not_found ->
7049           failwithf "%s: in test, command %s was not found" test_name name in
7050
7051       if List.length (snd style) <> List.length args then
7052         failwithf "%s: in test, wrong number of args given to %s"
7053           test_name name;
7054
7055       pr "  {\n";
7056
7057       List.iter (
7058         function
7059         | OptString n, "NULL" -> ()
7060         | Pathname n, arg
7061         | Device n, arg
7062         | Dev_or_Path n, arg
7063         | String n, arg
7064         | OptString n, arg ->
7065             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7066         | Int _, _
7067         | Int64 _, _
7068         | Bool _, _
7069         | FileIn _, _ | FileOut _, _ -> ()
7070         | StringList n, "" | DeviceList n, "" ->
7071             pr "    const char *const %s[1] = { NULL };\n" n
7072         | StringList n, arg | DeviceList n, arg ->
7073             let strs = string_split " " arg in
7074             iteri (
7075               fun i str ->
7076                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7077             ) strs;
7078             pr "    const char *const %s[] = {\n" n;
7079             iteri (
7080               fun i _ -> pr "      %s_%d,\n" n i
7081             ) strs;
7082             pr "      NULL\n";
7083             pr "    };\n";
7084       ) (List.combine (snd style) args);
7085
7086       let error_code =
7087         match fst style with
7088         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7089         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7090         | RConstString _ | RConstOptString _ ->
7091             pr "    const char *r;\n"; "NULL"
7092         | RString _ -> pr "    char *r;\n"; "NULL"
7093         | RStringList _ | RHashtable _ ->
7094             pr "    char **r;\n";
7095             pr "    size_t i;\n";
7096             "NULL"
7097         | RStruct (_, typ) ->
7098             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7099         | RStructList (_, typ) ->
7100             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7101         | RBufferOut _ ->
7102             pr "    char *r;\n";
7103             pr "    size_t size;\n";
7104             "NULL" in
7105
7106       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7107       pr "    r = guestfs_%s (g" name;
7108
7109       (* Generate the parameters. *)
7110       List.iter (
7111         function
7112         | OptString _, "NULL" -> pr ", NULL"
7113         | Pathname n, _
7114         | Device n, _ | Dev_or_Path n, _
7115         | String n, _
7116         | OptString n, _ ->
7117             pr ", %s" n
7118         | FileIn _, arg | FileOut _, arg ->
7119             pr ", \"%s\"" (c_quote arg)
7120         | StringList n, _ | DeviceList n, _ ->
7121             pr ", (char **) %s" n
7122         | Int _, arg ->
7123             let i =
7124               try int_of_string arg
7125               with Failure "int_of_string" ->
7126                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7127             pr ", %d" i
7128         | Int64 _, arg ->
7129             let i =
7130               try Int64.of_string arg
7131               with Failure "int_of_string" ->
7132                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7133             pr ", %Ld" i
7134         | Bool _, arg ->
7135             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7136       ) (List.combine (snd style) args);
7137
7138       (match fst style with
7139        | RBufferOut _ -> pr ", &size"
7140        | _ -> ()
7141       );
7142
7143       pr ");\n";
7144
7145       if not expect_error then
7146         pr "    if (r == %s)\n" error_code
7147       else
7148         pr "    if (r != %s)\n" error_code;
7149       pr "      return -1;\n";
7150
7151       (* Insert the test code. *)
7152       (match test with
7153        | None -> ()
7154        | Some f -> f ()
7155       );
7156
7157       (match fst style with
7158        | RErr | RInt _ | RInt64 _ | RBool _
7159        | RConstString _ | RConstOptString _ -> ()
7160        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7161        | RStringList _ | RHashtable _ ->
7162            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7163            pr "      free (r[i]);\n";
7164            pr "    free (r);\n"
7165        | RStruct (_, typ) ->
7166            pr "    guestfs_free_%s (r);\n" typ
7167        | RStructList (_, typ) ->
7168            pr "    guestfs_free_%s_list (r);\n" typ
7169       );
7170
7171       pr "  }\n"
7172
7173 and c_quote str =
7174   let str = replace_str str "\r" "\\r" in
7175   let str = replace_str str "\n" "\\n" in
7176   let str = replace_str str "\t" "\\t" in
7177   let str = replace_str str "\000" "\\0" in
7178   str
7179
7180 (* Generate a lot of different functions for guestfish. *)
7181 and generate_fish_cmds () =
7182   generate_header CStyle GPLv2plus;
7183
7184   let all_functions =
7185     List.filter (
7186       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7187     ) all_functions in
7188   let all_functions_sorted =
7189     List.filter (
7190       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7191     ) all_functions_sorted in
7192
7193   pr "#include <config.h>\n";
7194   pr "\n";
7195   pr "#include <stdio.h>\n";
7196   pr "#include <stdlib.h>\n";
7197   pr "#include <string.h>\n";
7198   pr "#include <inttypes.h>\n";
7199   pr "\n";
7200   pr "#include <guestfs.h>\n";
7201   pr "#include \"c-ctype.h\"\n";
7202   pr "#include \"full-write.h\"\n";
7203   pr "#include \"xstrtol.h\"\n";
7204   pr "#include \"fish.h\"\n";
7205   pr "\n";
7206
7207   (* list_commands function, which implements guestfish -h *)
7208   pr "void list_commands (void)\n";
7209   pr "{\n";
7210   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7211   pr "  list_builtin_commands ();\n";
7212   List.iter (
7213     fun (name, _, _, flags, _, shortdesc, _) ->
7214       let name = replace_char name '_' '-' in
7215       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7216         name shortdesc
7217   ) all_functions_sorted;
7218   pr "  printf (\"    %%s\\n\",";
7219   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7220   pr "}\n";
7221   pr "\n";
7222
7223   (* display_command function, which implements guestfish -h cmd *)
7224   pr "int display_command (const char *cmd)\n";
7225   pr "{\n";
7226   List.iter (
7227     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7228       let name2 = replace_char name '_' '-' in
7229       let alias =
7230         try find_map (function FishAlias n -> Some n | _ -> None) flags
7231         with Not_found -> name in
7232       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7233       let synopsis =
7234         match snd style with
7235         | [] -> name2
7236         | args ->
7237             sprintf "%s %s"
7238               name2 (String.concat " " (List.map name_of_argt args)) in
7239
7240       let warnings =
7241         if List.mem ProtocolLimitWarning flags then
7242           ("\n\n" ^ protocol_limit_warning)
7243         else "" in
7244
7245       (* For DangerWillRobinson commands, we should probably have
7246        * guestfish prompt before allowing you to use them (especially
7247        * in interactive mode). XXX
7248        *)
7249       let warnings =
7250         warnings ^
7251           if List.mem DangerWillRobinson flags then
7252             ("\n\n" ^ danger_will_robinson)
7253           else "" in
7254
7255       let warnings =
7256         warnings ^
7257           match deprecation_notice flags with
7258           | None -> ""
7259           | Some txt -> "\n\n" ^ txt in
7260
7261       let describe_alias =
7262         if name <> alias then
7263           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7264         else "" in
7265
7266       pr "  if (";
7267       pr "STRCASEEQ (cmd, \"%s\")" name;
7268       if name <> name2 then
7269         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7270       if name <> alias then
7271         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7272       pr ") {\n";
7273       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7274         name2 shortdesc
7275         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7276          "=head1 DESCRIPTION\n\n" ^
7277          longdesc ^ warnings ^ describe_alias);
7278       pr "    return 0;\n";
7279       pr "  }\n";
7280       pr "  else\n"
7281   ) all_functions;
7282   pr "    return display_builtin_command (cmd);\n";
7283   pr "}\n";
7284   pr "\n";
7285
7286   let emit_print_list_function typ =
7287     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7288       typ typ typ;
7289     pr "{\n";
7290     pr "  unsigned int i;\n";
7291     pr "\n";
7292     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7293     pr "    printf (\"[%%d] = {\\n\", i);\n";
7294     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7295     pr "    printf (\"}\\n\");\n";
7296     pr "  }\n";
7297     pr "}\n";
7298     pr "\n";
7299   in
7300
7301   (* print_* functions *)
7302   List.iter (
7303     fun (typ, cols) ->
7304       let needs_i =
7305         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7306
7307       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7308       pr "{\n";
7309       if needs_i then (
7310         pr "  unsigned int i;\n";
7311         pr "\n"
7312       );
7313       List.iter (
7314         function
7315         | name, FString ->
7316             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7317         | name, FUUID ->
7318             pr "  printf (\"%%s%s: \", indent);\n" name;
7319             pr "  for (i = 0; i < 32; ++i)\n";
7320             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7321             pr "  printf (\"\\n\");\n"
7322         | name, FBuffer ->
7323             pr "  printf (\"%%s%s: \", indent);\n" name;
7324             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7325             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7326             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7327             pr "    else\n";
7328             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7329             pr "  printf (\"\\n\");\n"
7330         | name, (FUInt64|FBytes) ->
7331             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7332               name typ name
7333         | name, FInt64 ->
7334             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7335               name typ name
7336         | name, FUInt32 ->
7337             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7338               name typ name
7339         | name, FInt32 ->
7340             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7341               name typ name
7342         | name, FChar ->
7343             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7344               name typ name
7345         | name, FOptPercent ->
7346             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7347               typ name name typ name;
7348             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7349       ) cols;
7350       pr "}\n";
7351       pr "\n";
7352   ) structs;
7353
7354   (* Emit a print_TYPE_list function definition only if that function is used. *)
7355   List.iter (
7356     function
7357     | typ, (RStructListOnly | RStructAndList) ->
7358         (* generate the function for typ *)
7359         emit_print_list_function typ
7360     | typ, _ -> () (* empty *)
7361   ) (rstructs_used_by all_functions);
7362
7363   (* Emit a print_TYPE function definition only if that function is used. *)
7364   List.iter (
7365     function
7366     | typ, (RStructOnly | RStructAndList) ->
7367         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7368         pr "{\n";
7369         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7370         pr "}\n";
7371         pr "\n";
7372     | typ, _ -> () (* empty *)
7373   ) (rstructs_used_by all_functions);
7374
7375   (* run_<action> actions *)
7376   List.iter (
7377     fun (name, style, _, flags, _, _, _) ->
7378       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7379       pr "{\n";
7380       (match fst style with
7381        | RErr
7382        | RInt _
7383        | RBool _ -> pr "  int r;\n"
7384        | RInt64 _ -> pr "  int64_t r;\n"
7385        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7386        | RString _ -> pr "  char *r;\n"
7387        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7388        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7389        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7390        | RBufferOut _ ->
7391            pr "  char *r;\n";
7392            pr "  size_t size;\n";
7393       );
7394       List.iter (
7395         function
7396         | Device n
7397         | String n
7398         | OptString n
7399         | FileIn n
7400         | FileOut n -> pr "  const char *%s;\n" n
7401         | Pathname n
7402         | Dev_or_Path n -> pr "  char *%s;\n" n
7403         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7404         | Bool n -> pr "  int %s;\n" n
7405         | Int n -> pr "  int %s;\n" n
7406         | Int64 n -> pr "  int64_t %s;\n" n
7407       ) (snd style);
7408
7409       (* Check and convert parameters. *)
7410       let argc_expected = List.length (snd style) in
7411       pr "  if (argc != %d) {\n" argc_expected;
7412       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7413         argc_expected;
7414       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7415       pr "    return -1;\n";
7416       pr "  }\n";
7417
7418       let parse_integer fn fntyp rtyp range name i =
7419         pr "  {\n";
7420         pr "    strtol_error xerr;\n";
7421         pr "    %s r;\n" fntyp;
7422         pr "\n";
7423         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7424         pr "    if (xerr != LONGINT_OK) {\n";
7425         pr "      fprintf (stderr,\n";
7426         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7427         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7428         pr "      return -1;\n";
7429         pr "    }\n";
7430         (match range with
7431          | None -> ()
7432          | Some (min, max, comment) ->
7433              pr "    /* %s */\n" comment;
7434              pr "    if (r < %s || r > %s) {\n" min max;
7435              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7436                name;
7437              pr "      return -1;\n";
7438              pr "    }\n";
7439              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7440         );
7441         pr "    %s = r;\n" name;
7442         pr "  }\n";
7443       in
7444
7445       iteri (
7446         fun i ->
7447           function
7448           | Device name
7449           | String name ->
7450               pr "  %s = argv[%d];\n" name i
7451           | Pathname name
7452           | Dev_or_Path name ->
7453               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7454               pr "  if (%s == NULL) return -1;\n" name
7455           | OptString name ->
7456               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7457                 name i i
7458           | FileIn name ->
7459               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7460                 name i i
7461           | FileOut name ->
7462               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7463                 name i i
7464           | StringList name | DeviceList name ->
7465               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7466               pr "  if (%s == NULL) return -1;\n" name;
7467           | Bool name ->
7468               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7469           | Int name ->
7470               let range =
7471                 let min = "(-(2LL<<30))"
7472                 and max = "((2LL<<30)-1)"
7473                 and comment =
7474                   "The Int type in the generator is a signed 31 bit int." in
7475                 Some (min, max, comment) in
7476               parse_integer "xstrtoll" "long long" "int" range name i
7477           | Int64 name ->
7478               parse_integer "xstrtoll" "long long" "int64_t" None name i
7479       ) (snd style);
7480
7481       (* Call C API function. *)
7482       let fn =
7483         try find_map (function FishAction n -> Some n | _ -> None) flags
7484         with Not_found -> sprintf "guestfs_%s" name in
7485       pr "  r = %s " fn;
7486       generate_c_call_args ~handle:"g" style;
7487       pr ";\n";
7488
7489       List.iter (
7490         function
7491         | Device _ | String _
7492         | OptString _ | Bool _
7493         | Int _ | Int64 _
7494         | FileIn _ | FileOut _ -> ()
7495         | Pathname name | Dev_or_Path name ->
7496             pr "  free (%s);\n" name
7497         | StringList name | DeviceList name ->
7498             pr "  free_strings (%s);\n" name
7499       ) (snd style);
7500
7501       (* Check return value for errors and display command results. *)
7502       (match fst style with
7503        | RErr -> pr "  return r;\n"
7504        | RInt _ ->
7505            pr "  if (r == -1) return -1;\n";
7506            pr "  printf (\"%%d\\n\", r);\n";
7507            pr "  return 0;\n"
7508        | RInt64 _ ->
7509            pr "  if (r == -1) return -1;\n";
7510            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7511            pr "  return 0;\n"
7512        | RBool _ ->
7513            pr "  if (r == -1) return -1;\n";
7514            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7515            pr "  return 0;\n"
7516        | RConstString _ ->
7517            pr "  if (r == NULL) return -1;\n";
7518            pr "  printf (\"%%s\\n\", r);\n";
7519            pr "  return 0;\n"
7520        | RConstOptString _ ->
7521            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7522            pr "  return 0;\n"
7523        | RString _ ->
7524            pr "  if (r == NULL) return -1;\n";
7525            pr "  printf (\"%%s\\n\", r);\n";
7526            pr "  free (r);\n";
7527            pr "  return 0;\n"
7528        | RStringList _ ->
7529            pr "  if (r == NULL) return -1;\n";
7530            pr "  print_strings (r);\n";
7531            pr "  free_strings (r);\n";
7532            pr "  return 0;\n"
7533        | RStruct (_, typ) ->
7534            pr "  if (r == NULL) return -1;\n";
7535            pr "  print_%s (r);\n" typ;
7536            pr "  guestfs_free_%s (r);\n" typ;
7537            pr "  return 0;\n"
7538        | RStructList (_, typ) ->
7539            pr "  if (r == NULL) return -1;\n";
7540            pr "  print_%s_list (r);\n" typ;
7541            pr "  guestfs_free_%s_list (r);\n" typ;
7542            pr "  return 0;\n"
7543        | RHashtable _ ->
7544            pr "  if (r == NULL) return -1;\n";
7545            pr "  print_table (r);\n";
7546            pr "  free_strings (r);\n";
7547            pr "  return 0;\n"
7548        | RBufferOut _ ->
7549            pr "  if (r == NULL) return -1;\n";
7550            pr "  if (full_write (1, r, size) != size) {\n";
7551            pr "    perror (\"write\");\n";
7552            pr "    free (r);\n";
7553            pr "    return -1;\n";
7554            pr "  }\n";
7555            pr "  free (r);\n";
7556            pr "  return 0;\n"
7557       );
7558       pr "}\n";
7559       pr "\n"
7560   ) all_functions;
7561
7562   (* run_action function *)
7563   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7564   pr "{\n";
7565   List.iter (
7566     fun (name, _, _, flags, _, _, _) ->
7567       let name2 = replace_char name '_' '-' in
7568       let alias =
7569         try find_map (function FishAlias n -> Some n | _ -> None) flags
7570         with Not_found -> name in
7571       pr "  if (";
7572       pr "STRCASEEQ (cmd, \"%s\")" name;
7573       if name <> name2 then
7574         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7575       if name <> alias then
7576         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7577       pr ")\n";
7578       pr "    return run_%s (cmd, argc, argv);\n" name;
7579       pr "  else\n";
7580   ) all_functions;
7581   pr "    {\n";
7582   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7583   pr "      if (command_num == 1)\n";
7584   pr "        extended_help_message ();\n";
7585   pr "      return -1;\n";
7586   pr "    }\n";
7587   pr "  return 0;\n";
7588   pr "}\n";
7589   pr "\n"
7590
7591 (* Readline completion for guestfish. *)
7592 and generate_fish_completion () =
7593   generate_header CStyle GPLv2plus;
7594
7595   let all_functions =
7596     List.filter (
7597       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7598     ) all_functions in
7599
7600   pr "\
7601 #include <config.h>
7602
7603 #include <stdio.h>
7604 #include <stdlib.h>
7605 #include <string.h>
7606
7607 #ifdef HAVE_LIBREADLINE
7608 #include <readline/readline.h>
7609 #endif
7610
7611 #include \"fish.h\"
7612
7613 #ifdef HAVE_LIBREADLINE
7614
7615 static const char *const commands[] = {
7616   BUILTIN_COMMANDS_FOR_COMPLETION,
7617 ";
7618
7619   (* Get the commands, including the aliases.  They don't need to be
7620    * sorted - the generator() function just does a dumb linear search.
7621    *)
7622   let commands =
7623     List.map (
7624       fun (name, _, _, flags, _, _, _) ->
7625         let name2 = replace_char name '_' '-' in
7626         let alias =
7627           try find_map (function FishAlias n -> Some n | _ -> None) flags
7628           with Not_found -> name in
7629
7630         if name <> alias then [name2; alias] else [name2]
7631     ) all_functions in
7632   let commands = List.flatten commands in
7633
7634   List.iter (pr "  \"%s\",\n") commands;
7635
7636   pr "  NULL
7637 };
7638
7639 static char *
7640 generator (const char *text, int state)
7641 {
7642   static size_t index, len;
7643   const char *name;
7644
7645   if (!state) {
7646     index = 0;
7647     len = strlen (text);
7648   }
7649
7650   rl_attempted_completion_over = 1;
7651
7652   while ((name = commands[index]) != NULL) {
7653     index++;
7654     if (STRCASEEQLEN (name, text, len))
7655       return strdup (name);
7656   }
7657
7658   return NULL;
7659 }
7660
7661 #endif /* HAVE_LIBREADLINE */
7662
7663 #ifdef HAVE_RL_COMPLETION_MATCHES
7664 #define RL_COMPLETION_MATCHES rl_completion_matches
7665 #else
7666 #ifdef HAVE_COMPLETION_MATCHES
7667 #define RL_COMPLETION_MATCHES completion_matches
7668 #endif
7669 #endif /* else just fail if we don't have either symbol */
7670
7671 char **
7672 do_completion (const char *text, int start, int end)
7673 {
7674   char **matches = NULL;
7675
7676 #ifdef HAVE_LIBREADLINE
7677   rl_completion_append_character = ' ';
7678
7679   if (start == 0)
7680     matches = RL_COMPLETION_MATCHES (text, generator);
7681   else if (complete_dest_paths)
7682     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7683 #endif
7684
7685   return matches;
7686 }
7687 ";
7688
7689 (* Generate the POD documentation for guestfish. *)
7690 and generate_fish_actions_pod () =
7691   let all_functions_sorted =
7692     List.filter (
7693       fun (_, _, _, flags, _, _, _) ->
7694         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7695     ) all_functions_sorted in
7696
7697   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7698
7699   List.iter (
7700     fun (name, style, _, flags, _, _, longdesc) ->
7701       let longdesc =
7702         Str.global_substitute rex (
7703           fun s ->
7704             let sub =
7705               try Str.matched_group 1 s
7706               with Not_found ->
7707                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7708             "C<" ^ replace_char sub '_' '-' ^ ">"
7709         ) longdesc in
7710       let name = replace_char name '_' '-' in
7711       let alias =
7712         try find_map (function FishAlias n -> Some n | _ -> None) flags
7713         with Not_found -> name in
7714
7715       pr "=head2 %s" name;
7716       if name <> alias then
7717         pr " | %s" alias;
7718       pr "\n";
7719       pr "\n";
7720       pr " %s" name;
7721       List.iter (
7722         function
7723         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7724         | OptString n -> pr " %s" n
7725         | StringList n | DeviceList n -> pr " '%s ...'" n
7726         | Bool _ -> pr " true|false"
7727         | Int n -> pr " %s" n
7728         | Int64 n -> pr " %s" n
7729         | FileIn n | FileOut n -> pr " (%s|-)" n
7730       ) (snd style);
7731       pr "\n";
7732       pr "\n";
7733       pr "%s\n\n" longdesc;
7734
7735       if List.exists (function FileIn _ | FileOut _ -> true
7736                       | _ -> false) (snd style) then
7737         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7738
7739       if List.mem ProtocolLimitWarning flags then
7740         pr "%s\n\n" protocol_limit_warning;
7741
7742       if List.mem DangerWillRobinson flags then
7743         pr "%s\n\n" danger_will_robinson;
7744
7745       match deprecation_notice flags with
7746       | None -> ()
7747       | Some txt -> pr "%s\n\n" txt
7748   ) all_functions_sorted
7749
7750 (* Generate a C function prototype. *)
7751 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7752     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7753     ?(prefix = "")
7754     ?handle name style =
7755   if extern then pr "extern ";
7756   if static then pr "static ";
7757   (match fst style with
7758    | RErr -> pr "int "
7759    | RInt _ -> pr "int "
7760    | RInt64 _ -> pr "int64_t "
7761    | RBool _ -> pr "int "
7762    | RConstString _ | RConstOptString _ -> pr "const char *"
7763    | RString _ | RBufferOut _ -> pr "char *"
7764    | RStringList _ | RHashtable _ -> pr "char **"
7765    | RStruct (_, typ) ->
7766        if not in_daemon then pr "struct guestfs_%s *" typ
7767        else pr "guestfs_int_%s *" typ
7768    | RStructList (_, typ) ->
7769        if not in_daemon then pr "struct guestfs_%s_list *" typ
7770        else pr "guestfs_int_%s_list *" typ
7771   );
7772   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7773   pr "%s%s (" prefix name;
7774   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7775     pr "void"
7776   else (
7777     let comma = ref false in
7778     (match handle with
7779      | None -> ()
7780      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7781     );
7782     let next () =
7783       if !comma then (
7784         if single_line then pr ", " else pr ",\n\t\t"
7785       );
7786       comma := true
7787     in
7788     List.iter (
7789       function
7790       | Pathname n
7791       | Device n | Dev_or_Path n
7792       | String n
7793       | OptString n ->
7794           next ();
7795           pr "const char *%s" n
7796       | StringList n | DeviceList n ->
7797           next ();
7798           pr "char *const *%s" n
7799       | Bool n -> next (); pr "int %s" n
7800       | Int n -> next (); pr "int %s" n
7801       | Int64 n -> next (); pr "int64_t %s" n
7802       | FileIn n
7803       | FileOut n ->
7804           if not in_daemon then (next (); pr "const char *%s" n)
7805     ) (snd style);
7806     if is_RBufferOut then (next (); pr "size_t *size_r");
7807   );
7808   pr ")";
7809   if semicolon then pr ";";
7810   if newline then pr "\n"
7811
7812 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7813 and generate_c_call_args ?handle ?(decl = false) style =
7814   pr "(";
7815   let comma = ref false in
7816   let next () =
7817     if !comma then pr ", ";
7818     comma := true
7819   in
7820   (match handle with
7821    | None -> ()
7822    | Some handle -> pr "%s" handle; comma := true
7823   );
7824   List.iter (
7825     fun arg ->
7826       next ();
7827       pr "%s" (name_of_argt arg)
7828   ) (snd style);
7829   (* For RBufferOut calls, add implicit &size parameter. *)
7830   if not decl then (
7831     match fst style with
7832     | RBufferOut _ ->
7833         next ();
7834         pr "&size"
7835     | _ -> ()
7836   );
7837   pr ")"
7838
7839 (* Generate the OCaml bindings interface. *)
7840 and generate_ocaml_mli () =
7841   generate_header OCamlStyle LGPLv2plus;
7842
7843   pr "\
7844 (** For API documentation you should refer to the C API
7845     in the guestfs(3) manual page.  The OCaml API uses almost
7846     exactly the same calls. *)
7847
7848 type t
7849 (** A [guestfs_h] handle. *)
7850
7851 exception Error of string
7852 (** This exception is raised when there is an error. *)
7853
7854 exception Handle_closed of string
7855 (** This exception is raised if you use a {!Guestfs.t} handle
7856     after calling {!close} on it.  The string is the name of
7857     the function. *)
7858
7859 val create : unit -> t
7860 (** Create a {!Guestfs.t} handle. *)
7861
7862 val close : t -> unit
7863 (** Close the {!Guestfs.t} handle and free up all resources used
7864     by it immediately.
7865
7866     Handles are closed by the garbage collector when they become
7867     unreferenced, but callers can call this in order to provide
7868     predictable cleanup. *)
7869
7870 ";
7871   generate_ocaml_structure_decls ();
7872
7873   (* The actions. *)
7874   List.iter (
7875     fun (name, style, _, _, _, shortdesc, _) ->
7876       generate_ocaml_prototype name style;
7877       pr "(** %s *)\n" shortdesc;
7878       pr "\n"
7879   ) all_functions_sorted
7880
7881 (* Generate the OCaml bindings implementation. *)
7882 and generate_ocaml_ml () =
7883   generate_header OCamlStyle LGPLv2plus;
7884
7885   pr "\
7886 type t
7887
7888 exception Error of string
7889 exception Handle_closed of string
7890
7891 external create : unit -> t = \"ocaml_guestfs_create\"
7892 external close : t -> unit = \"ocaml_guestfs_close\"
7893
7894 (* Give the exceptions names, so they can be raised from the C code. *)
7895 let () =
7896   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7897   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7898
7899 ";
7900
7901   generate_ocaml_structure_decls ();
7902
7903   (* The actions. *)
7904   List.iter (
7905     fun (name, style, _, _, _, shortdesc, _) ->
7906       generate_ocaml_prototype ~is_external:true name style;
7907   ) all_functions_sorted
7908
7909 (* Generate the OCaml bindings C implementation. *)
7910 and generate_ocaml_c () =
7911   generate_header CStyle LGPLv2plus;
7912
7913   pr "\
7914 #include <stdio.h>
7915 #include <stdlib.h>
7916 #include <string.h>
7917
7918 #include <caml/config.h>
7919 #include <caml/alloc.h>
7920 #include <caml/callback.h>
7921 #include <caml/fail.h>
7922 #include <caml/memory.h>
7923 #include <caml/mlvalues.h>
7924 #include <caml/signals.h>
7925
7926 #include \"guestfs.h\"
7927
7928 #include \"guestfs_c.h\"
7929
7930 /* Copy a hashtable of string pairs into an assoc-list.  We return
7931  * the list in reverse order, but hashtables aren't supposed to be
7932  * ordered anyway.
7933  */
7934 static CAMLprim value
7935 copy_table (char * const * argv)
7936 {
7937   CAMLparam0 ();
7938   CAMLlocal5 (rv, pairv, kv, vv, cons);
7939   size_t i;
7940
7941   rv = Val_int (0);
7942   for (i = 0; argv[i] != NULL; i += 2) {
7943     kv = caml_copy_string (argv[i]);
7944     vv = caml_copy_string (argv[i+1]);
7945     pairv = caml_alloc (2, 0);
7946     Store_field (pairv, 0, kv);
7947     Store_field (pairv, 1, vv);
7948     cons = caml_alloc (2, 0);
7949     Store_field (cons, 1, rv);
7950     rv = cons;
7951     Store_field (cons, 0, pairv);
7952   }
7953
7954   CAMLreturn (rv);
7955 }
7956
7957 ";
7958
7959   (* Struct copy functions. *)
7960
7961   let emit_ocaml_copy_list_function typ =
7962     pr "static CAMLprim value\n";
7963     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7964     pr "{\n";
7965     pr "  CAMLparam0 ();\n";
7966     pr "  CAMLlocal2 (rv, v);\n";
7967     pr "  unsigned int i;\n";
7968     pr "\n";
7969     pr "  if (%ss->len == 0)\n" typ;
7970     pr "    CAMLreturn (Atom (0));\n";
7971     pr "  else {\n";
7972     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7973     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7974     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7975     pr "      caml_modify (&Field (rv, i), v);\n";
7976     pr "    }\n";
7977     pr "    CAMLreturn (rv);\n";
7978     pr "  }\n";
7979     pr "}\n";
7980     pr "\n";
7981   in
7982
7983   List.iter (
7984     fun (typ, cols) ->
7985       let has_optpercent_col =
7986         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7987
7988       pr "static CAMLprim value\n";
7989       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7990       pr "{\n";
7991       pr "  CAMLparam0 ();\n";
7992       if has_optpercent_col then
7993         pr "  CAMLlocal3 (rv, v, v2);\n"
7994       else
7995         pr "  CAMLlocal2 (rv, v);\n";
7996       pr "\n";
7997       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7998       iteri (
7999         fun i col ->
8000           (match col with
8001            | name, FString ->
8002                pr "  v = caml_copy_string (%s->%s);\n" typ name
8003            | name, FBuffer ->
8004                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8005                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8006                  typ name typ name
8007            | name, FUUID ->
8008                pr "  v = caml_alloc_string (32);\n";
8009                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8010            | name, (FBytes|FInt64|FUInt64) ->
8011                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8012            | name, (FInt32|FUInt32) ->
8013                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8014            | name, FOptPercent ->
8015                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8016                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8017                pr "    v = caml_alloc (1, 0);\n";
8018                pr "    Store_field (v, 0, v2);\n";
8019                pr "  } else /* None */\n";
8020                pr "    v = Val_int (0);\n";
8021            | name, FChar ->
8022                pr "  v = Val_int (%s->%s);\n" typ name
8023           );
8024           pr "  Store_field (rv, %d, v);\n" i
8025       ) cols;
8026       pr "  CAMLreturn (rv);\n";
8027       pr "}\n";
8028       pr "\n";
8029   ) structs;
8030
8031   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8032   List.iter (
8033     function
8034     | typ, (RStructListOnly | RStructAndList) ->
8035         (* generate the function for typ *)
8036         emit_ocaml_copy_list_function typ
8037     | typ, _ -> () (* empty *)
8038   ) (rstructs_used_by all_functions);
8039
8040   (* The wrappers. *)
8041   List.iter (
8042     fun (name, style, _, _, _, _, _) ->
8043       pr "/* Automatically generated wrapper for function\n";
8044       pr " * ";
8045       generate_ocaml_prototype name style;
8046       pr " */\n";
8047       pr "\n";
8048
8049       let params =
8050         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8051
8052       let needs_extra_vs =
8053         match fst style with RConstOptString _ -> true | _ -> false in
8054
8055       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8056       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8057       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8058       pr "\n";
8059
8060       pr "CAMLprim value\n";
8061       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8062       List.iter (pr ", value %s") (List.tl params);
8063       pr ")\n";
8064       pr "{\n";
8065
8066       (match params with
8067        | [p1; p2; p3; p4; p5] ->
8068            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8069        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8070            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8071            pr "  CAMLxparam%d (%s);\n"
8072              (List.length rest) (String.concat ", " rest)
8073        | ps ->
8074            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8075       );
8076       if not needs_extra_vs then
8077         pr "  CAMLlocal1 (rv);\n"
8078       else
8079         pr "  CAMLlocal3 (rv, v, v2);\n";
8080       pr "\n";
8081
8082       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8083       pr "  if (g == NULL)\n";
8084       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8085       pr "\n";
8086
8087       List.iter (
8088         function
8089         | Pathname n
8090         | Device n | Dev_or_Path n
8091         | String n
8092         | FileIn n
8093         | FileOut n ->
8094             (* Copy strings in case the GC moves them: RHBZ#604691 *)
8095             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
8096         | OptString n ->
8097             pr "  char *%s =\n" n;
8098             pr "    %sv != Val_int (0) ?" n;
8099             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
8100         | StringList n | DeviceList n ->
8101             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8102         | Bool n ->
8103             pr "  int %s = Bool_val (%sv);\n" n n
8104         | Int n ->
8105             pr "  int %s = Int_val (%sv);\n" n n
8106         | Int64 n ->
8107             pr "  int64_t %s = Int64_val (%sv);\n" n n
8108       ) (snd style);
8109       let error_code =
8110         match fst style with
8111         | RErr -> pr "  int r;\n"; "-1"
8112         | RInt _ -> pr "  int r;\n"; "-1"
8113         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8114         | RBool _ -> pr "  int r;\n"; "-1"
8115         | RConstString _ | RConstOptString _ ->
8116             pr "  const char *r;\n"; "NULL"
8117         | RString _ -> pr "  char *r;\n"; "NULL"
8118         | RStringList _ ->
8119             pr "  size_t i;\n";
8120             pr "  char **r;\n";
8121             "NULL"
8122         | RStruct (_, typ) ->
8123             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8124         | RStructList (_, typ) ->
8125             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8126         | RHashtable _ ->
8127             pr "  size_t i;\n";
8128             pr "  char **r;\n";
8129             "NULL"
8130         | RBufferOut _ ->
8131             pr "  char *r;\n";
8132             pr "  size_t size;\n";
8133             "NULL" in
8134       pr "\n";
8135
8136       pr "  caml_enter_blocking_section ();\n";
8137       pr "  r = guestfs_%s " name;
8138       generate_c_call_args ~handle:"g" style;
8139       pr ";\n";
8140       pr "  caml_leave_blocking_section ();\n";
8141
8142       (* Free strings if we copied them above. *)
8143       List.iter (
8144         function
8145         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
8146         | FileIn n | FileOut n ->
8147             pr "  free (%s);\n" n
8148         | StringList n | DeviceList n ->
8149             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8150         | Bool _ | Int _ | Int64 _ -> ()
8151       ) (snd style);
8152
8153       pr "  if (r == %s)\n" error_code;
8154       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8155       pr "\n";
8156
8157       (match fst style with
8158        | RErr -> pr "  rv = Val_unit;\n"
8159        | RInt _ -> pr "  rv = Val_int (r);\n"
8160        | RInt64 _ ->
8161            pr "  rv = caml_copy_int64 (r);\n"
8162        | RBool _ -> pr "  rv = Val_bool (r);\n"
8163        | RConstString _ ->
8164            pr "  rv = caml_copy_string (r);\n"
8165        | RConstOptString _ ->
8166            pr "  if (r) { /* Some string */\n";
8167            pr "    v = caml_alloc (1, 0);\n";
8168            pr "    v2 = caml_copy_string (r);\n";
8169            pr "    Store_field (v, 0, v2);\n";
8170            pr "  } else /* None */\n";
8171            pr "    v = Val_int (0);\n";
8172        | RString _ ->
8173            pr "  rv = caml_copy_string (r);\n";
8174            pr "  free (r);\n"
8175        | RStringList _ ->
8176            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8177            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8178            pr "  free (r);\n"
8179        | RStruct (_, typ) ->
8180            pr "  rv = copy_%s (r);\n" typ;
8181            pr "  guestfs_free_%s (r);\n" typ;
8182        | RStructList (_, typ) ->
8183            pr "  rv = copy_%s_list (r);\n" typ;
8184            pr "  guestfs_free_%s_list (r);\n" typ;
8185        | RHashtable _ ->
8186            pr "  rv = copy_table (r);\n";
8187            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8188            pr "  free (r);\n";
8189        | RBufferOut _ ->
8190            pr "  rv = caml_alloc_string (size);\n";
8191            pr "  memcpy (String_val (rv), r, size);\n";
8192       );
8193
8194       pr "  CAMLreturn (rv);\n";
8195       pr "}\n";
8196       pr "\n";
8197
8198       if List.length params > 5 then (
8199         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8200         pr "CAMLprim value ";
8201         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8202         pr "CAMLprim value\n";
8203         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8204         pr "{\n";
8205         pr "  return ocaml_guestfs_%s (argv[0]" name;
8206         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8207         pr ");\n";
8208         pr "}\n";
8209         pr "\n"
8210       )
8211   ) all_functions_sorted
8212
8213 and generate_ocaml_structure_decls () =
8214   List.iter (
8215     fun (typ, cols) ->
8216       pr "type %s = {\n" typ;
8217       List.iter (
8218         function
8219         | name, FString -> pr "  %s : string;\n" name
8220         | name, FBuffer -> pr "  %s : string;\n" name
8221         | name, FUUID -> pr "  %s : string;\n" name
8222         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8223         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8224         | name, FChar -> pr "  %s : char;\n" name
8225         | name, FOptPercent -> pr "  %s : float option;\n" name
8226       ) cols;
8227       pr "}\n";
8228       pr "\n"
8229   ) structs
8230
8231 and generate_ocaml_prototype ?(is_external = false) name style =
8232   if is_external then pr "external " else pr "val ";
8233   pr "%s : t -> " name;
8234   List.iter (
8235     function
8236     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8237     | OptString _ -> pr "string option -> "
8238     | StringList _ | DeviceList _ -> pr "string array -> "
8239     | Bool _ -> pr "bool -> "
8240     | Int _ -> pr "int -> "
8241     | Int64 _ -> pr "int64 -> "
8242   ) (snd style);
8243   (match fst style with
8244    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8245    | RInt _ -> pr "int"
8246    | RInt64 _ -> pr "int64"
8247    | RBool _ -> pr "bool"
8248    | RConstString _ -> pr "string"
8249    | RConstOptString _ -> pr "string option"
8250    | RString _ | RBufferOut _ -> pr "string"
8251    | RStringList _ -> pr "string array"
8252    | RStruct (_, typ) -> pr "%s" typ
8253    | RStructList (_, typ) -> pr "%s array" typ
8254    | RHashtable _ -> pr "(string * string) list"
8255   );
8256   if is_external then (
8257     pr " = ";
8258     if List.length (snd style) + 1 > 5 then
8259       pr "\"ocaml_guestfs_%s_byte\" " name;
8260     pr "\"ocaml_guestfs_%s\"" name
8261   );
8262   pr "\n"
8263
8264 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8265 and generate_perl_xs () =
8266   generate_header CStyle LGPLv2plus;
8267
8268   pr "\
8269 #include \"EXTERN.h\"
8270 #include \"perl.h\"
8271 #include \"XSUB.h\"
8272
8273 #include <guestfs.h>
8274
8275 #ifndef PRId64
8276 #define PRId64 \"lld\"
8277 #endif
8278
8279 static SV *
8280 my_newSVll(long long val) {
8281 #ifdef USE_64_BIT_ALL
8282   return newSViv(val);
8283 #else
8284   char buf[100];
8285   int len;
8286   len = snprintf(buf, 100, \"%%\" PRId64, val);
8287   return newSVpv(buf, len);
8288 #endif
8289 }
8290
8291 #ifndef PRIu64
8292 #define PRIu64 \"llu\"
8293 #endif
8294
8295 static SV *
8296 my_newSVull(unsigned long long val) {
8297 #ifdef USE_64_BIT_ALL
8298   return newSVuv(val);
8299 #else
8300   char buf[100];
8301   int len;
8302   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8303   return newSVpv(buf, len);
8304 #endif
8305 }
8306
8307 /* http://www.perlmonks.org/?node_id=680842 */
8308 static char **
8309 XS_unpack_charPtrPtr (SV *arg) {
8310   char **ret;
8311   AV *av;
8312   I32 i;
8313
8314   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8315     croak (\"array reference expected\");
8316
8317   av = (AV *)SvRV (arg);
8318   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8319   if (!ret)
8320     croak (\"malloc failed\");
8321
8322   for (i = 0; i <= av_len (av); i++) {
8323     SV **elem = av_fetch (av, i, 0);
8324
8325     if (!elem || !*elem)
8326       croak (\"missing element in list\");
8327
8328     ret[i] = SvPV_nolen (*elem);
8329   }
8330
8331   ret[i] = NULL;
8332
8333   return ret;
8334 }
8335
8336 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8337
8338 PROTOTYPES: ENABLE
8339
8340 guestfs_h *
8341 _create ()
8342    CODE:
8343       RETVAL = guestfs_create ();
8344       if (!RETVAL)
8345         croak (\"could not create guestfs handle\");
8346       guestfs_set_error_handler (RETVAL, NULL, NULL);
8347  OUTPUT:
8348       RETVAL
8349
8350 void
8351 DESTROY (g)
8352       guestfs_h *g;
8353  PPCODE:
8354       guestfs_close (g);
8355
8356 ";
8357
8358   List.iter (
8359     fun (name, style, _, _, _, _, _) ->
8360       (match fst style with
8361        | RErr -> pr "void\n"
8362        | RInt _ -> pr "SV *\n"
8363        | RInt64 _ -> pr "SV *\n"
8364        | RBool _ -> pr "SV *\n"
8365        | RConstString _ -> pr "SV *\n"
8366        | RConstOptString _ -> pr "SV *\n"
8367        | RString _ -> pr "SV *\n"
8368        | RBufferOut _ -> pr "SV *\n"
8369        | RStringList _
8370        | RStruct _ | RStructList _
8371        | RHashtable _ ->
8372            pr "void\n" (* all lists returned implictly on the stack *)
8373       );
8374       (* Call and arguments. *)
8375       pr "%s " name;
8376       generate_c_call_args ~handle:"g" ~decl:true style;
8377       pr "\n";
8378       pr "      guestfs_h *g;\n";
8379       iteri (
8380         fun i ->
8381           function
8382           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8383               pr "      char *%s;\n" n
8384           | OptString n ->
8385               (* http://www.perlmonks.org/?node_id=554277
8386                * Note that the implicit handle argument means we have
8387                * to add 1 to the ST(x) operator.
8388                *)
8389               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8390           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8391           | Bool n -> pr "      int %s;\n" n
8392           | Int n -> pr "      int %s;\n" n
8393           | Int64 n -> pr "      int64_t %s;\n" n
8394       ) (snd style);
8395
8396       let do_cleanups () =
8397         List.iter (
8398           function
8399           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8400           | Bool _ | Int _ | Int64 _
8401           | FileIn _ | FileOut _ -> ()
8402           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8403         ) (snd style)
8404       in
8405
8406       (* Code. *)
8407       (match fst style with
8408        | RErr ->
8409            pr "PREINIT:\n";
8410            pr "      int r;\n";
8411            pr " PPCODE:\n";
8412            pr "      r = guestfs_%s " name;
8413            generate_c_call_args ~handle:"g" style;
8414            pr ";\n";
8415            do_cleanups ();
8416            pr "      if (r == -1)\n";
8417            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8418        | RInt n
8419        | RBool n ->
8420            pr "PREINIT:\n";
8421            pr "      int %s;\n" n;
8422            pr "   CODE:\n";
8423            pr "      %s = guestfs_%s " n name;
8424            generate_c_call_args ~handle:"g" style;
8425            pr ";\n";
8426            do_cleanups ();
8427            pr "      if (%s == -1)\n" n;
8428            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8429            pr "      RETVAL = newSViv (%s);\n" n;
8430            pr " OUTPUT:\n";
8431            pr "      RETVAL\n"
8432        | RInt64 n ->
8433            pr "PREINIT:\n";
8434            pr "      int64_t %s;\n" n;
8435            pr "   CODE:\n";
8436            pr "      %s = guestfs_%s " n name;
8437            generate_c_call_args ~handle:"g" style;
8438            pr ";\n";
8439            do_cleanups ();
8440            pr "      if (%s == -1)\n" n;
8441            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8442            pr "      RETVAL = my_newSVll (%s);\n" n;
8443            pr " OUTPUT:\n";
8444            pr "      RETVAL\n"
8445        | RConstString n ->
8446            pr "PREINIT:\n";
8447            pr "      const char *%s;\n" n;
8448            pr "   CODE:\n";
8449            pr "      %s = guestfs_%s " n name;
8450            generate_c_call_args ~handle:"g" style;
8451            pr ";\n";
8452            do_cleanups ();
8453            pr "      if (%s == NULL)\n" n;
8454            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8455            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8456            pr " OUTPUT:\n";
8457            pr "      RETVAL\n"
8458        | RConstOptString n ->
8459            pr "PREINIT:\n";
8460            pr "      const char *%s;\n" n;
8461            pr "   CODE:\n";
8462            pr "      %s = guestfs_%s " n name;
8463            generate_c_call_args ~handle:"g" style;
8464            pr ";\n";
8465            do_cleanups ();
8466            pr "      if (%s == NULL)\n" n;
8467            pr "        RETVAL = &PL_sv_undef;\n";
8468            pr "      else\n";
8469            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8470            pr " OUTPUT:\n";
8471            pr "      RETVAL\n"
8472        | RString n ->
8473            pr "PREINIT:\n";
8474            pr "      char *%s;\n" n;
8475            pr "   CODE:\n";
8476            pr "      %s = guestfs_%s " n name;
8477            generate_c_call_args ~handle:"g" style;
8478            pr ";\n";
8479            do_cleanups ();
8480            pr "      if (%s == NULL)\n" n;
8481            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8482            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8483            pr "      free (%s);\n" n;
8484            pr " OUTPUT:\n";
8485            pr "      RETVAL\n"
8486        | RStringList n | RHashtable n ->
8487            pr "PREINIT:\n";
8488            pr "      char **%s;\n" n;
8489            pr "      size_t i, n;\n";
8490            pr " PPCODE:\n";
8491            pr "      %s = guestfs_%s " n name;
8492            generate_c_call_args ~handle:"g" style;
8493            pr ";\n";
8494            do_cleanups ();
8495            pr "      if (%s == NULL)\n" n;
8496            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8497            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8498            pr "      EXTEND (SP, n);\n";
8499            pr "      for (i = 0; i < n; ++i) {\n";
8500            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8501            pr "        free (%s[i]);\n" n;
8502            pr "      }\n";
8503            pr "      free (%s);\n" n;
8504        | RStruct (n, typ) ->
8505            let cols = cols_of_struct typ in
8506            generate_perl_struct_code typ cols name style n do_cleanups
8507        | RStructList (n, typ) ->
8508            let cols = cols_of_struct typ in
8509            generate_perl_struct_list_code typ cols name style n do_cleanups
8510        | RBufferOut n ->
8511            pr "PREINIT:\n";
8512            pr "      char *%s;\n" n;
8513            pr "      size_t size;\n";
8514            pr "   CODE:\n";
8515            pr "      %s = guestfs_%s " n name;
8516            generate_c_call_args ~handle:"g" style;
8517            pr ";\n";
8518            do_cleanups ();
8519            pr "      if (%s == NULL)\n" n;
8520            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8521            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8522            pr "      free (%s);\n" n;
8523            pr " OUTPUT:\n";
8524            pr "      RETVAL\n"
8525       );
8526
8527       pr "\n"
8528   ) all_functions
8529
8530 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8531   pr "PREINIT:\n";
8532   pr "      struct guestfs_%s_list *%s;\n" typ n;
8533   pr "      size_t i;\n";
8534   pr "      HV *hv;\n";
8535   pr " PPCODE:\n";
8536   pr "      %s = guestfs_%s " n name;
8537   generate_c_call_args ~handle:"g" style;
8538   pr ";\n";
8539   do_cleanups ();
8540   pr "      if (%s == NULL)\n" n;
8541   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8542   pr "      EXTEND (SP, %s->len);\n" n;
8543   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8544   pr "        hv = newHV ();\n";
8545   List.iter (
8546     function
8547     | name, FString ->
8548         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8549           name (String.length name) n name
8550     | name, FUUID ->
8551         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8552           name (String.length name) n name
8553     | name, FBuffer ->
8554         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8555           name (String.length name) n name n name
8556     | name, (FBytes|FUInt64) ->
8557         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8558           name (String.length name) n name
8559     | name, FInt64 ->
8560         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8561           name (String.length name) n name
8562     | name, (FInt32|FUInt32) ->
8563         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8564           name (String.length name) n name
8565     | name, FChar ->
8566         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8567           name (String.length name) n name
8568     | name, FOptPercent ->
8569         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8570           name (String.length name) n name
8571   ) cols;
8572   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8573   pr "      }\n";
8574   pr "      guestfs_free_%s_list (%s);\n" typ n
8575
8576 and generate_perl_struct_code typ cols name style n do_cleanups =
8577   pr "PREINIT:\n";
8578   pr "      struct guestfs_%s *%s;\n" typ n;
8579   pr " PPCODE:\n";
8580   pr "      %s = guestfs_%s " n name;
8581   generate_c_call_args ~handle:"g" style;
8582   pr ";\n";
8583   do_cleanups ();
8584   pr "      if (%s == NULL)\n" n;
8585   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8586   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8587   List.iter (
8588     fun ((name, _) as col) ->
8589       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8590
8591       match col with
8592       | name, FString ->
8593           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8594             n name
8595       | name, FBuffer ->
8596           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8597             n name n name
8598       | name, FUUID ->
8599           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8600             n name
8601       | name, (FBytes|FUInt64) ->
8602           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8603             n name
8604       | name, FInt64 ->
8605           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8606             n name
8607       | name, (FInt32|FUInt32) ->
8608           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8609             n name
8610       | name, FChar ->
8611           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8612             n name
8613       | name, FOptPercent ->
8614           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8615             n name
8616   ) cols;
8617   pr "      free (%s);\n" n
8618
8619 (* Generate Sys/Guestfs.pm. *)
8620 and generate_perl_pm () =
8621   generate_header HashStyle LGPLv2plus;
8622
8623   pr "\
8624 =pod
8625
8626 =head1 NAME
8627
8628 Sys::Guestfs - Perl bindings for libguestfs
8629
8630 =head1 SYNOPSIS
8631
8632  use Sys::Guestfs;
8633
8634  my $h = Sys::Guestfs->new ();
8635  $h->add_drive ('guest.img');
8636  $h->launch ();
8637  $h->mount ('/dev/sda1', '/');
8638  $h->touch ('/hello');
8639  $h->sync ();
8640
8641 =head1 DESCRIPTION
8642
8643 The C<Sys::Guestfs> module provides a Perl XS binding to the
8644 libguestfs API for examining and modifying virtual machine
8645 disk images.
8646
8647 Amongst the things this is good for: making batch configuration
8648 changes to guests, getting disk used/free statistics (see also:
8649 virt-df), migrating between virtualization systems (see also:
8650 virt-p2v), performing partial backups, performing partial guest
8651 clones, cloning guests and changing registry/UUID/hostname info, and
8652 much else besides.
8653
8654 Libguestfs uses Linux kernel and qemu code, and can access any type of
8655 guest filesystem that Linux and qemu can, including but not limited
8656 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8657 schemes, qcow, qcow2, vmdk.
8658
8659 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8660 LVs, what filesystem is in each LV, etc.).  It can also run commands
8661 in the context of the guest.  Also you can access filesystems over
8662 FUSE.
8663
8664 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8665 functions for using libguestfs from Perl, including integration
8666 with libvirt.
8667
8668 =head1 ERRORS
8669
8670 All errors turn into calls to C<croak> (see L<Carp(3)>).
8671
8672 =head1 METHODS
8673
8674 =over 4
8675
8676 =cut
8677
8678 package Sys::Guestfs;
8679
8680 use strict;
8681 use warnings;
8682
8683 require XSLoader;
8684 XSLoader::load ('Sys::Guestfs');
8685
8686 =item $h = Sys::Guestfs->new ();
8687
8688 Create a new guestfs handle.
8689
8690 =cut
8691
8692 sub new {
8693   my $proto = shift;
8694   my $class = ref ($proto) || $proto;
8695
8696   my $self = Sys::Guestfs::_create ();
8697   bless $self, $class;
8698   return $self;
8699 }
8700
8701 ";
8702
8703   (* Actions.  We only need to print documentation for these as
8704    * they are pulled in from the XS code automatically.
8705    *)
8706   List.iter (
8707     fun (name, style, _, flags, _, _, longdesc) ->
8708       if not (List.mem NotInDocs flags) then (
8709         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8710         pr "=item ";
8711         generate_perl_prototype name style;
8712         pr "\n\n";
8713         pr "%s\n\n" longdesc;
8714         if List.mem ProtocolLimitWarning flags then
8715           pr "%s\n\n" protocol_limit_warning;
8716         if List.mem DangerWillRobinson flags then
8717           pr "%s\n\n" danger_will_robinson;
8718         match deprecation_notice flags with
8719         | None -> ()
8720         | Some txt -> pr "%s\n\n" txt
8721       )
8722   ) all_functions_sorted;
8723
8724   (* End of file. *)
8725   pr "\
8726 =cut
8727
8728 1;
8729
8730 =back
8731
8732 =head1 AVAILABILITY
8733
8734 From time to time we add new libguestfs APIs.  Also some libguestfs
8735 APIs won't be available in all builds of libguestfs (the Fedora
8736 build is full-featured, but other builds may disable features).
8737 How do you test whether the APIs that your Perl program needs are
8738 available in the version of C<Sys::Guestfs> that you are using?
8739
8740 To test if a particular function is available in the C<Sys::Guestfs>
8741 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
8742 (see L<perlobj(1)>).  For example:
8743
8744  use Sys::Guestfs;
8745  if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
8746    print \"\\$h->set_verbose is available\\n\";
8747  }
8748
8749 To test if particular features are supported by the current
8750 build, use the L</available> method like the example below.  Note
8751 that the appliance must be launched first.
8752
8753  $h->available ( [\"augeas\"] );
8754
8755 Since the L</available> method croaks if the feature is not supported,
8756 you might also want to wrap this in an eval and return a boolean.
8757 In fact this has already been done for you: use
8758 L<Sys::Guestfs::Lib(3)/feature_available>.
8759
8760 For further discussion on this topic, refer to
8761 L<guestfs(3)/AVAILABILITY>.
8762
8763 =head1 COPYRIGHT
8764
8765 Copyright (C) %s Red Hat Inc.
8766
8767 =head1 LICENSE
8768
8769 Please see the file COPYING.LIB for the full license.
8770
8771 =head1 SEE ALSO
8772
8773 L<guestfs(3)>,
8774 L<guestfish(1)>,
8775 L<http://libguestfs.org>,
8776 L<Sys::Guestfs::Lib(3)>.
8777
8778 =cut
8779 " copyright_years
8780
8781 and generate_perl_prototype name style =
8782   (match fst style with
8783    | RErr -> ()
8784    | RBool n
8785    | RInt n
8786    | RInt64 n
8787    | RConstString n
8788    | RConstOptString n
8789    | RString n
8790    | RBufferOut n -> pr "$%s = " n
8791    | RStruct (n,_)
8792    | RHashtable n -> pr "%%%s = " n
8793    | RStringList n
8794    | RStructList (n,_) -> pr "@%s = " n
8795   );
8796   pr "$h->%s (" name;
8797   let comma = ref false in
8798   List.iter (
8799     fun arg ->
8800       if !comma then pr ", ";
8801       comma := true;
8802       match arg with
8803       | Pathname n | Device n | Dev_or_Path n | String n
8804       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8805           pr "$%s" n
8806       | StringList n | DeviceList n ->
8807           pr "\\@%s" n
8808   ) (snd style);
8809   pr ");"
8810
8811 (* Generate Python C module. *)
8812 and generate_python_c () =
8813   generate_header CStyle LGPLv2plus;
8814
8815   pr "\
8816 #include <Python.h>
8817
8818 #if PY_VERSION_HEX < 0x02050000
8819 typedef int Py_ssize_t;
8820 #define PY_SSIZE_T_MAX INT_MAX
8821 #define PY_SSIZE_T_MIN INT_MIN
8822 #endif
8823
8824 #include <stdio.h>
8825 #include <stdlib.h>
8826 #include <assert.h>
8827
8828 #include \"guestfs.h\"
8829
8830 typedef struct {
8831   PyObject_HEAD
8832   guestfs_h *g;
8833 } Pyguestfs_Object;
8834
8835 static guestfs_h *
8836 get_handle (PyObject *obj)
8837 {
8838   assert (obj);
8839   assert (obj != Py_None);
8840   return ((Pyguestfs_Object *) obj)->g;
8841 }
8842
8843 static PyObject *
8844 put_handle (guestfs_h *g)
8845 {
8846   assert (g);
8847   return
8848     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8849 }
8850
8851 /* This list should be freed (but not the strings) after use. */
8852 static char **
8853 get_string_list (PyObject *obj)
8854 {
8855   size_t i, len;
8856   char **r;
8857
8858   assert (obj);
8859
8860   if (!PyList_Check (obj)) {
8861     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8862     return NULL;
8863   }
8864
8865   Py_ssize_t slen = PyList_Size (obj);
8866   if (slen == -1) {
8867     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
8868     return NULL;
8869   }
8870   len = (size_t) slen;
8871   r = malloc (sizeof (char *) * (len+1));
8872   if (r == NULL) {
8873     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8874     return NULL;
8875   }
8876
8877   for (i = 0; i < len; ++i)
8878     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8879   r[len] = NULL;
8880
8881   return r;
8882 }
8883
8884 static PyObject *
8885 put_string_list (char * const * const argv)
8886 {
8887   PyObject *list;
8888   int argc, i;
8889
8890   for (argc = 0; argv[argc] != NULL; ++argc)
8891     ;
8892
8893   list = PyList_New (argc);
8894   for (i = 0; i < argc; ++i)
8895     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8896
8897   return list;
8898 }
8899
8900 static PyObject *
8901 put_table (char * const * const argv)
8902 {
8903   PyObject *list, *item;
8904   int argc, i;
8905
8906   for (argc = 0; argv[argc] != NULL; ++argc)
8907     ;
8908
8909   list = PyList_New (argc >> 1);
8910   for (i = 0; i < argc; i += 2) {
8911     item = PyTuple_New (2);
8912     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8913     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8914     PyList_SetItem (list, i >> 1, item);
8915   }
8916
8917   return list;
8918 }
8919
8920 static void
8921 free_strings (char **argv)
8922 {
8923   int argc;
8924
8925   for (argc = 0; argv[argc] != NULL; ++argc)
8926     free (argv[argc]);
8927   free (argv);
8928 }
8929
8930 static PyObject *
8931 py_guestfs_create (PyObject *self, PyObject *args)
8932 {
8933   guestfs_h *g;
8934
8935   g = guestfs_create ();
8936   if (g == NULL) {
8937     PyErr_SetString (PyExc_RuntimeError,
8938                      \"guestfs.create: failed to allocate handle\");
8939     return NULL;
8940   }
8941   guestfs_set_error_handler (g, NULL, NULL);
8942   return put_handle (g);
8943 }
8944
8945 static PyObject *
8946 py_guestfs_close (PyObject *self, PyObject *args)
8947 {
8948   PyObject *py_g;
8949   guestfs_h *g;
8950
8951   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8952     return NULL;
8953   g = get_handle (py_g);
8954
8955   guestfs_close (g);
8956
8957   Py_INCREF (Py_None);
8958   return Py_None;
8959 }
8960
8961 ";
8962
8963   let emit_put_list_function typ =
8964     pr "static PyObject *\n";
8965     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8966     pr "{\n";
8967     pr "  PyObject *list;\n";
8968     pr "  size_t i;\n";
8969     pr "\n";
8970     pr "  list = PyList_New (%ss->len);\n" typ;
8971     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8972     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8973     pr "  return list;\n";
8974     pr "};\n";
8975     pr "\n"
8976   in
8977
8978   (* Structures, turned into Python dictionaries. *)
8979   List.iter (
8980     fun (typ, cols) ->
8981       pr "static PyObject *\n";
8982       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8983       pr "{\n";
8984       pr "  PyObject *dict;\n";
8985       pr "\n";
8986       pr "  dict = PyDict_New ();\n";
8987       List.iter (
8988         function
8989         | name, FString ->
8990             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8991             pr "                        PyString_FromString (%s->%s));\n"
8992               typ name
8993         | name, FBuffer ->
8994             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8995             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8996               typ name typ name
8997         | name, FUUID ->
8998             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8999             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
9000               typ name
9001         | name, (FBytes|FUInt64) ->
9002             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9003             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
9004               typ name
9005         | name, FInt64 ->
9006             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9007             pr "                        PyLong_FromLongLong (%s->%s));\n"
9008               typ name
9009         | name, FUInt32 ->
9010             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9011             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
9012               typ name
9013         | name, FInt32 ->
9014             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9015             pr "                        PyLong_FromLong (%s->%s));\n"
9016               typ name
9017         | name, FOptPercent ->
9018             pr "  if (%s->%s >= 0)\n" typ name;
9019             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
9020             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
9021               typ name;
9022             pr "  else {\n";
9023             pr "    Py_INCREF (Py_None);\n";
9024             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
9025             pr "  }\n"
9026         | name, FChar ->
9027             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9028             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
9029       ) cols;
9030       pr "  return dict;\n";
9031       pr "};\n";
9032       pr "\n";
9033
9034   ) structs;
9035
9036   (* Emit a put_TYPE_list function definition only if that function is used. *)
9037   List.iter (
9038     function
9039     | typ, (RStructListOnly | RStructAndList) ->
9040         (* generate the function for typ *)
9041         emit_put_list_function typ
9042     | typ, _ -> () (* empty *)
9043   ) (rstructs_used_by all_functions);
9044
9045   (* Python wrapper functions. *)
9046   List.iter (
9047     fun (name, style, _, _, _, _, _) ->
9048       pr "static PyObject *\n";
9049       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9050       pr "{\n";
9051
9052       pr "  PyObject *py_g;\n";
9053       pr "  guestfs_h *g;\n";
9054       pr "  PyObject *py_r;\n";
9055
9056       let error_code =
9057         match fst style with
9058         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9059         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9060         | RConstString _ | RConstOptString _ ->
9061             pr "  const char *r;\n"; "NULL"
9062         | RString _ -> pr "  char *r;\n"; "NULL"
9063         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9064         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9065         | RStructList (_, typ) ->
9066             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9067         | RBufferOut _ ->
9068             pr "  char *r;\n";
9069             pr "  size_t size;\n";
9070             "NULL" in
9071
9072       List.iter (
9073         function
9074         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9075             pr "  const char *%s;\n" n
9076         | OptString n -> pr "  const char *%s;\n" n
9077         | StringList n | DeviceList n ->
9078             pr "  PyObject *py_%s;\n" n;
9079             pr "  char **%s;\n" n
9080         | Bool n -> pr "  int %s;\n" n
9081         | Int n -> pr "  int %s;\n" n
9082         | Int64 n -> pr "  long long %s;\n" n
9083       ) (snd style);
9084
9085       pr "\n";
9086
9087       (* Convert the parameters. *)
9088       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9089       List.iter (
9090         function
9091         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9092         | OptString _ -> pr "z"
9093         | StringList _ | DeviceList _ -> pr "O"
9094         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9095         | Int _ -> pr "i"
9096         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9097                              * emulate C's int/long/long long in Python?
9098                              *)
9099       ) (snd style);
9100       pr ":guestfs_%s\",\n" name;
9101       pr "                         &py_g";
9102       List.iter (
9103         function
9104         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9105         | OptString n -> pr ", &%s" n
9106         | StringList n | DeviceList n -> pr ", &py_%s" n
9107         | Bool n -> pr ", &%s" n
9108         | Int n -> pr ", &%s" n
9109         | Int64 n -> pr ", &%s" n
9110       ) (snd style);
9111
9112       pr "))\n";
9113       pr "    return NULL;\n";
9114
9115       pr "  g = get_handle (py_g);\n";
9116       List.iter (
9117         function
9118         | Pathname _ | Device _ | Dev_or_Path _ | String _
9119         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9120         | StringList n | DeviceList n ->
9121             pr "  %s = get_string_list (py_%s);\n" n n;
9122             pr "  if (!%s) return NULL;\n" n
9123       ) (snd style);
9124
9125       pr "\n";
9126
9127       pr "  r = guestfs_%s " name;
9128       generate_c_call_args ~handle:"g" style;
9129       pr ";\n";
9130
9131       List.iter (
9132         function
9133         | Pathname _ | Device _ | Dev_or_Path _ | String _
9134         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9135         | StringList n | DeviceList n ->
9136             pr "  free (%s);\n" n
9137       ) (snd style);
9138
9139       pr "  if (r == %s) {\n" error_code;
9140       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9141       pr "    return NULL;\n";
9142       pr "  }\n";
9143       pr "\n";
9144
9145       (match fst style with
9146        | RErr ->
9147            pr "  Py_INCREF (Py_None);\n";
9148            pr "  py_r = Py_None;\n"
9149        | RInt _
9150        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9151        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9152        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9153        | RConstOptString _ ->
9154            pr "  if (r)\n";
9155            pr "    py_r = PyString_FromString (r);\n";
9156            pr "  else {\n";
9157            pr "    Py_INCREF (Py_None);\n";
9158            pr "    py_r = Py_None;\n";
9159            pr "  }\n"
9160        | RString _ ->
9161            pr "  py_r = PyString_FromString (r);\n";
9162            pr "  free (r);\n"
9163        | RStringList _ ->
9164            pr "  py_r = put_string_list (r);\n";
9165            pr "  free_strings (r);\n"
9166        | RStruct (_, typ) ->
9167            pr "  py_r = put_%s (r);\n" typ;
9168            pr "  guestfs_free_%s (r);\n" typ
9169        | RStructList (_, typ) ->
9170            pr "  py_r = put_%s_list (r);\n" typ;
9171            pr "  guestfs_free_%s_list (r);\n" typ
9172        | RHashtable n ->
9173            pr "  py_r = put_table (r);\n";
9174            pr "  free_strings (r);\n"
9175        | RBufferOut _ ->
9176            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9177            pr "  free (r);\n"
9178       );
9179
9180       pr "  return py_r;\n";
9181       pr "}\n";
9182       pr "\n"
9183   ) all_functions;
9184
9185   (* Table of functions. *)
9186   pr "static PyMethodDef methods[] = {\n";
9187   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9188   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9189   List.iter (
9190     fun (name, _, _, _, _, _, _) ->
9191       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9192         name name
9193   ) all_functions;
9194   pr "  { NULL, NULL, 0, NULL }\n";
9195   pr "};\n";
9196   pr "\n";
9197
9198   (* Init function. *)
9199   pr "\
9200 void
9201 initlibguestfsmod (void)
9202 {
9203   static int initialized = 0;
9204
9205   if (initialized) return;
9206   Py_InitModule ((char *) \"libguestfsmod\", methods);
9207   initialized = 1;
9208 }
9209 "
9210
9211 (* Generate Python module. *)
9212 and generate_python_py () =
9213   generate_header HashStyle LGPLv2plus;
9214
9215   pr "\
9216 u\"\"\"Python bindings for libguestfs
9217
9218 import guestfs
9219 g = guestfs.GuestFS ()
9220 g.add_drive (\"guest.img\")
9221 g.launch ()
9222 parts = g.list_partitions ()
9223
9224 The guestfs module provides a Python binding to the libguestfs API
9225 for examining and modifying virtual machine disk images.
9226
9227 Amongst the things this is good for: making batch configuration
9228 changes to guests, getting disk used/free statistics (see also:
9229 virt-df), migrating between virtualization systems (see also:
9230 virt-p2v), performing partial backups, performing partial guest
9231 clones, cloning guests and changing registry/UUID/hostname info, and
9232 much else besides.
9233
9234 Libguestfs uses Linux kernel and qemu code, and can access any type of
9235 guest filesystem that Linux and qemu can, including but not limited
9236 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9237 schemes, qcow, qcow2, vmdk.
9238
9239 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9240 LVs, what filesystem is in each LV, etc.).  It can also run commands
9241 in the context of the guest.  Also you can access filesystems over
9242 FUSE.
9243
9244 Errors which happen while using the API are turned into Python
9245 RuntimeError exceptions.
9246
9247 To create a guestfs handle you usually have to perform the following
9248 sequence of calls:
9249
9250 # Create the handle, call add_drive at least once, and possibly
9251 # several times if the guest has multiple block devices:
9252 g = guestfs.GuestFS ()
9253 g.add_drive (\"guest.img\")
9254
9255 # Launch the qemu subprocess and wait for it to become ready:
9256 g.launch ()
9257
9258 # Now you can issue commands, for example:
9259 logvols = g.lvs ()
9260
9261 \"\"\"
9262
9263 import libguestfsmod
9264
9265 class GuestFS:
9266     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9267
9268     def __init__ (self):
9269         \"\"\"Create a new libguestfs handle.\"\"\"
9270         self._o = libguestfsmod.create ()
9271
9272     def __del__ (self):
9273         libguestfsmod.close (self._o)
9274
9275 ";
9276
9277   List.iter (
9278     fun (name, style, _, flags, _, _, longdesc) ->
9279       pr "    def %s " name;
9280       generate_py_call_args ~handle:"self" (snd style);
9281       pr ":\n";
9282
9283       if not (List.mem NotInDocs flags) then (
9284         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9285         let doc =
9286           match fst style with
9287           | RErr | RInt _ | RInt64 _ | RBool _
9288           | RConstOptString _ | RConstString _
9289           | RString _ | RBufferOut _ -> doc
9290           | RStringList _ ->
9291               doc ^ "\n\nThis function returns a list of strings."
9292           | RStruct (_, typ) ->
9293               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9294           | RStructList (_, typ) ->
9295               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9296           | RHashtable _ ->
9297               doc ^ "\n\nThis function returns a dictionary." in
9298         let doc =
9299           if List.mem ProtocolLimitWarning flags then
9300             doc ^ "\n\n" ^ protocol_limit_warning
9301           else doc in
9302         let doc =
9303           if List.mem DangerWillRobinson flags then
9304             doc ^ "\n\n" ^ danger_will_robinson
9305           else doc in
9306         let doc =
9307           match deprecation_notice flags with
9308           | None -> doc
9309           | Some txt -> doc ^ "\n\n" ^ txt in
9310         let doc = pod2text ~width:60 name doc in
9311         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9312         let doc = String.concat "\n        " doc in
9313         pr "        u\"\"\"%s\"\"\"\n" doc;
9314       );
9315       pr "        return libguestfsmod.%s " name;
9316       generate_py_call_args ~handle:"self._o" (snd style);
9317       pr "\n";
9318       pr "\n";
9319   ) all_functions
9320
9321 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9322 and generate_py_call_args ~handle args =
9323   pr "(%s" handle;
9324   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9325   pr ")"
9326
9327 (* Useful if you need the longdesc POD text as plain text.  Returns a
9328  * list of lines.
9329  *
9330  * Because this is very slow (the slowest part of autogeneration),
9331  * we memoize the results.
9332  *)
9333 and pod2text ~width name longdesc =
9334   let key = width, name, longdesc in
9335   try Hashtbl.find pod2text_memo key
9336   with Not_found ->
9337     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9338     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9339     close_out chan;
9340     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9341     let chan = open_process_in cmd in
9342     let lines = ref [] in
9343     let rec loop i =
9344       let line = input_line chan in
9345       if i = 1 then             (* discard the first line of output *)
9346         loop (i+1)
9347       else (
9348         let line = triml line in
9349         lines := line :: !lines;
9350         loop (i+1)
9351       ) in
9352     let lines = try loop 1 with End_of_file -> List.rev !lines in
9353     unlink filename;
9354     (match close_process_in chan with
9355      | WEXITED 0 -> ()
9356      | WEXITED i ->
9357          failwithf "pod2text: process exited with non-zero status (%d)" i
9358      | WSIGNALED i | WSTOPPED i ->
9359          failwithf "pod2text: process signalled or stopped by signal %d" i
9360     );
9361     Hashtbl.add pod2text_memo key lines;
9362     pod2text_memo_updated ();
9363     lines
9364
9365 (* Generate ruby bindings. *)
9366 and generate_ruby_c () =
9367   generate_header CStyle LGPLv2plus;
9368
9369   pr "\
9370 #include <stdio.h>
9371 #include <stdlib.h>
9372
9373 #include <ruby.h>
9374
9375 #include \"guestfs.h\"
9376
9377 #include \"extconf.h\"
9378
9379 /* For Ruby < 1.9 */
9380 #ifndef RARRAY_LEN
9381 #define RARRAY_LEN(r) (RARRAY((r))->len)
9382 #endif
9383
9384 static VALUE m_guestfs;                 /* guestfs module */
9385 static VALUE c_guestfs;                 /* guestfs_h handle */
9386 static VALUE e_Error;                   /* used for all errors */
9387
9388 static void ruby_guestfs_free (void *p)
9389 {
9390   if (!p) return;
9391   guestfs_close ((guestfs_h *) p);
9392 }
9393
9394 static VALUE ruby_guestfs_create (VALUE m)
9395 {
9396   guestfs_h *g;
9397
9398   g = guestfs_create ();
9399   if (!g)
9400     rb_raise (e_Error, \"failed to create guestfs handle\");
9401
9402   /* Don't print error messages to stderr by default. */
9403   guestfs_set_error_handler (g, NULL, NULL);
9404
9405   /* Wrap it, and make sure the close function is called when the
9406    * handle goes away.
9407    */
9408   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9409 }
9410
9411 static VALUE ruby_guestfs_close (VALUE gv)
9412 {
9413   guestfs_h *g;
9414   Data_Get_Struct (gv, guestfs_h, g);
9415
9416   ruby_guestfs_free (g);
9417   DATA_PTR (gv) = NULL;
9418
9419   return Qnil;
9420 }
9421
9422 ";
9423
9424   List.iter (
9425     fun (name, style, _, _, _, _, _) ->
9426       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9427       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9428       pr ")\n";
9429       pr "{\n";
9430       pr "  guestfs_h *g;\n";
9431       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9432       pr "  if (!g)\n";
9433       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9434         name;
9435       pr "\n";
9436
9437       List.iter (
9438         function
9439         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9440             pr "  Check_Type (%sv, T_STRING);\n" n;
9441             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9442             pr "  if (!%s)\n" n;
9443             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9444             pr "              \"%s\", \"%s\");\n" n name
9445         | OptString n ->
9446             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9447         | StringList n | DeviceList n ->
9448             pr "  char **%s;\n" n;
9449             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9450             pr "  {\n";
9451             pr "    size_t i, len;\n";
9452             pr "    len = RARRAY_LEN (%sv);\n" n;
9453             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9454               n;
9455             pr "    for (i = 0; i < len; ++i) {\n";
9456             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9457             pr "      %s[i] = StringValueCStr (v);\n" n;
9458             pr "    }\n";
9459             pr "    %s[len] = NULL;\n" n;
9460             pr "  }\n";
9461         | Bool n ->
9462             pr "  int %s = RTEST (%sv);\n" n n
9463         | Int n ->
9464             pr "  int %s = NUM2INT (%sv);\n" n n
9465         | Int64 n ->
9466             pr "  long long %s = NUM2LL (%sv);\n" n n
9467       ) (snd style);
9468       pr "\n";
9469
9470       let error_code =
9471         match fst style with
9472         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9473         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9474         | RConstString _ | RConstOptString _ ->
9475             pr "  const char *r;\n"; "NULL"
9476         | RString _ -> pr "  char *r;\n"; "NULL"
9477         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9478         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9479         | RStructList (_, typ) ->
9480             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9481         | RBufferOut _ ->
9482             pr "  char *r;\n";
9483             pr "  size_t size;\n";
9484             "NULL" in
9485       pr "\n";
9486
9487       pr "  r = guestfs_%s " name;
9488       generate_c_call_args ~handle:"g" style;
9489       pr ";\n";
9490
9491       List.iter (
9492         function
9493         | Pathname _ | Device _ | Dev_or_Path _ | String _
9494         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9495         | StringList n | DeviceList n ->
9496             pr "  free (%s);\n" n
9497       ) (snd style);
9498
9499       pr "  if (r == %s)\n" error_code;
9500       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9501       pr "\n";
9502
9503       (match fst style with
9504        | RErr ->
9505            pr "  return Qnil;\n"
9506        | RInt _ | RBool _ ->
9507            pr "  return INT2NUM (r);\n"
9508        | RInt64 _ ->
9509            pr "  return ULL2NUM (r);\n"
9510        | RConstString _ ->
9511            pr "  return rb_str_new2 (r);\n";
9512        | RConstOptString _ ->
9513            pr "  if (r)\n";
9514            pr "    return rb_str_new2 (r);\n";
9515            pr "  else\n";
9516            pr "    return Qnil;\n";
9517        | RString _ ->
9518            pr "  VALUE rv = rb_str_new2 (r);\n";
9519            pr "  free (r);\n";
9520            pr "  return rv;\n";
9521        | RStringList _ ->
9522            pr "  size_t i, len = 0;\n";
9523            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9524            pr "  VALUE rv = rb_ary_new2 (len);\n";
9525            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9526            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9527            pr "    free (r[i]);\n";
9528            pr "  }\n";
9529            pr "  free (r);\n";
9530            pr "  return rv;\n"
9531        | RStruct (_, typ) ->
9532            let cols = cols_of_struct typ in
9533            generate_ruby_struct_code typ cols
9534        | RStructList (_, typ) ->
9535            let cols = cols_of_struct typ in
9536            generate_ruby_struct_list_code typ cols
9537        | RHashtable _ ->
9538            pr "  VALUE rv = rb_hash_new ();\n";
9539            pr "  size_t i;\n";
9540            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9541            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9542            pr "    free (r[i]);\n";
9543            pr "    free (r[i+1]);\n";
9544            pr "  }\n";
9545            pr "  free (r);\n";
9546            pr "  return rv;\n"
9547        | RBufferOut _ ->
9548            pr "  VALUE rv = rb_str_new (r, size);\n";
9549            pr "  free (r);\n";
9550            pr "  return rv;\n";
9551       );
9552
9553       pr "}\n";
9554       pr "\n"
9555   ) all_functions;
9556
9557   pr "\
9558 /* Initialize the module. */
9559 void Init__guestfs ()
9560 {
9561   m_guestfs = rb_define_module (\"Guestfs\");
9562   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9563   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9564
9565   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9566   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9567
9568 ";
9569   (* Define the rest of the methods. *)
9570   List.iter (
9571     fun (name, style, _, _, _, _, _) ->
9572       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9573       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9574   ) all_functions;
9575
9576   pr "}\n"
9577
9578 (* Ruby code to return a struct. *)
9579 and generate_ruby_struct_code typ cols =
9580   pr "  VALUE rv = rb_hash_new ();\n";
9581   List.iter (
9582     function
9583     | name, FString ->
9584         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9585     | name, FBuffer ->
9586         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9587     | name, FUUID ->
9588         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9589     | name, (FBytes|FUInt64) ->
9590         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9591     | name, FInt64 ->
9592         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9593     | name, FUInt32 ->
9594         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9595     | name, FInt32 ->
9596         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9597     | name, FOptPercent ->
9598         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9599     | name, FChar -> (* XXX wrong? *)
9600         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9601   ) cols;
9602   pr "  guestfs_free_%s (r);\n" typ;
9603   pr "  return rv;\n"
9604
9605 (* Ruby code to return a struct list. *)
9606 and generate_ruby_struct_list_code typ cols =
9607   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9608   pr "  size_t i;\n";
9609   pr "  for (i = 0; i < r->len; ++i) {\n";
9610   pr "    VALUE hv = rb_hash_new ();\n";
9611   List.iter (
9612     function
9613     | name, FString ->
9614         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9615     | name, FBuffer ->
9616         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
9617     | name, FUUID ->
9618         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9619     | name, (FBytes|FUInt64) ->
9620         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9621     | name, FInt64 ->
9622         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9623     | name, FUInt32 ->
9624         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9625     | name, FInt32 ->
9626         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9627     | name, FOptPercent ->
9628         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9629     | name, FChar -> (* XXX wrong? *)
9630         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9631   ) cols;
9632   pr "    rb_ary_push (rv, hv);\n";
9633   pr "  }\n";
9634   pr "  guestfs_free_%s_list (r);\n" typ;
9635   pr "  return rv;\n"
9636
9637 (* Generate Java bindings GuestFS.java file. *)
9638 and generate_java_java () =
9639   generate_header CStyle LGPLv2plus;
9640
9641   pr "\
9642 package com.redhat.et.libguestfs;
9643
9644 import java.util.HashMap;
9645 import com.redhat.et.libguestfs.LibGuestFSException;
9646 import com.redhat.et.libguestfs.PV;
9647 import com.redhat.et.libguestfs.VG;
9648 import com.redhat.et.libguestfs.LV;
9649 import com.redhat.et.libguestfs.Stat;
9650 import com.redhat.et.libguestfs.StatVFS;
9651 import com.redhat.et.libguestfs.IntBool;
9652 import com.redhat.et.libguestfs.Dirent;
9653
9654 /**
9655  * The GuestFS object is a libguestfs handle.
9656  *
9657  * @author rjones
9658  */
9659 public class GuestFS {
9660   // Load the native code.
9661   static {
9662     System.loadLibrary (\"guestfs_jni\");
9663   }
9664
9665   /**
9666    * The native guestfs_h pointer.
9667    */
9668   long g;
9669
9670   /**
9671    * Create a libguestfs handle.
9672    *
9673    * @throws LibGuestFSException
9674    */
9675   public GuestFS () throws LibGuestFSException
9676   {
9677     g = _create ();
9678   }
9679   private native long _create () throws LibGuestFSException;
9680
9681   /**
9682    * Close a libguestfs handle.
9683    *
9684    * You can also leave handles to be collected by the garbage
9685    * collector, but this method ensures that the resources used
9686    * by the handle are freed up immediately.  If you call any
9687    * other methods after closing the handle, you will get an
9688    * exception.
9689    *
9690    * @throws LibGuestFSException
9691    */
9692   public void close () throws LibGuestFSException
9693   {
9694     if (g != 0)
9695       _close (g);
9696     g = 0;
9697   }
9698   private native void _close (long g) throws LibGuestFSException;
9699
9700   public void finalize () throws LibGuestFSException
9701   {
9702     close ();
9703   }
9704
9705 ";
9706
9707   List.iter (
9708     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9709       if not (List.mem NotInDocs flags); then (
9710         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9711         let doc =
9712           if List.mem ProtocolLimitWarning flags then
9713             doc ^ "\n\n" ^ protocol_limit_warning
9714           else doc in
9715         let doc =
9716           if List.mem DangerWillRobinson flags then
9717             doc ^ "\n\n" ^ danger_will_robinson
9718           else doc in
9719         let doc =
9720           match deprecation_notice flags with
9721           | None -> doc
9722           | Some txt -> doc ^ "\n\n" ^ txt in
9723         let doc = pod2text ~width:60 name doc in
9724         let doc = List.map (            (* RHBZ#501883 *)
9725           function
9726           | "" -> "<p>"
9727           | nonempty -> nonempty
9728         ) doc in
9729         let doc = String.concat "\n   * " doc in
9730
9731         pr "  /**\n";
9732         pr "   * %s\n" shortdesc;
9733         pr "   * <p>\n";
9734         pr "   * %s\n" doc;
9735         pr "   * @throws LibGuestFSException\n";
9736         pr "   */\n";
9737         pr "  ";
9738       );
9739       generate_java_prototype ~public:true ~semicolon:false name style;
9740       pr "\n";
9741       pr "  {\n";
9742       pr "    if (g == 0)\n";
9743       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9744         name;
9745       pr "    ";
9746       if fst style <> RErr then pr "return ";
9747       pr "_%s " name;
9748       generate_java_call_args ~handle:"g" (snd style);
9749       pr ";\n";
9750       pr "  }\n";
9751       pr "  ";
9752       generate_java_prototype ~privat:true ~native:true name style;
9753       pr "\n";
9754       pr "\n";
9755   ) all_functions;
9756
9757   pr "}\n"
9758
9759 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9760 and generate_java_call_args ~handle args =
9761   pr "(%s" handle;
9762   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9763   pr ")"
9764
9765 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9766     ?(semicolon=true) name style =
9767   if privat then pr "private ";
9768   if public then pr "public ";
9769   if native then pr "native ";
9770
9771   (* return type *)
9772   (match fst style with
9773    | RErr -> pr "void ";
9774    | RInt _ -> pr "int ";
9775    | RInt64 _ -> pr "long ";
9776    | RBool _ -> pr "boolean ";
9777    | RConstString _ | RConstOptString _ | RString _
9778    | RBufferOut _ -> pr "String ";
9779    | RStringList _ -> pr "String[] ";
9780    | RStruct (_, typ) ->
9781        let name = java_name_of_struct typ in
9782        pr "%s " name;
9783    | RStructList (_, typ) ->
9784        let name = java_name_of_struct typ in
9785        pr "%s[] " name;
9786    | RHashtable _ -> pr "HashMap<String,String> ";
9787   );
9788
9789   if native then pr "_%s " name else pr "%s " name;
9790   pr "(";
9791   let needs_comma = ref false in
9792   if native then (
9793     pr "long g";
9794     needs_comma := true
9795   );
9796
9797   (* args *)
9798   List.iter (
9799     fun arg ->
9800       if !needs_comma then pr ", ";
9801       needs_comma := true;
9802
9803       match arg with
9804       | Pathname n
9805       | Device n | Dev_or_Path n
9806       | String n
9807       | OptString n
9808       | FileIn n
9809       | FileOut n ->
9810           pr "String %s" n
9811       | StringList n | DeviceList n ->
9812           pr "String[] %s" n
9813       | Bool n ->
9814           pr "boolean %s" n
9815       | Int n ->
9816           pr "int %s" n
9817       | Int64 n ->
9818           pr "long %s" n
9819   ) (snd style);
9820
9821   pr ")\n";
9822   pr "    throws LibGuestFSException";
9823   if semicolon then pr ";"
9824
9825 and generate_java_struct jtyp cols () =
9826   generate_header CStyle LGPLv2plus;
9827
9828   pr "\
9829 package com.redhat.et.libguestfs;
9830
9831 /**
9832  * Libguestfs %s structure.
9833  *
9834  * @author rjones
9835  * @see GuestFS
9836  */
9837 public class %s {
9838 " jtyp jtyp;
9839
9840   List.iter (
9841     function
9842     | name, FString
9843     | name, FUUID
9844     | name, FBuffer -> pr "  public String %s;\n" name
9845     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9846     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9847     | name, FChar -> pr "  public char %s;\n" name
9848     | name, FOptPercent ->
9849         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9850         pr "  public float %s;\n" name
9851   ) cols;
9852
9853   pr "}\n"
9854
9855 and generate_java_c () =
9856   generate_header CStyle LGPLv2plus;
9857
9858   pr "\
9859 #include <stdio.h>
9860 #include <stdlib.h>
9861 #include <string.h>
9862
9863 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9864 #include \"guestfs.h\"
9865
9866 /* Note that this function returns.  The exception is not thrown
9867  * until after the wrapper function returns.
9868  */
9869 static void
9870 throw_exception (JNIEnv *env, const char *msg)
9871 {
9872   jclass cl;
9873   cl = (*env)->FindClass (env,
9874                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9875   (*env)->ThrowNew (env, cl, msg);
9876 }
9877
9878 JNIEXPORT jlong JNICALL
9879 Java_com_redhat_et_libguestfs_GuestFS__1create
9880   (JNIEnv *env, jobject obj)
9881 {
9882   guestfs_h *g;
9883
9884   g = guestfs_create ();
9885   if (g == NULL) {
9886     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9887     return 0;
9888   }
9889   guestfs_set_error_handler (g, NULL, NULL);
9890   return (jlong) (long) g;
9891 }
9892
9893 JNIEXPORT void JNICALL
9894 Java_com_redhat_et_libguestfs_GuestFS__1close
9895   (JNIEnv *env, jobject obj, jlong jg)
9896 {
9897   guestfs_h *g = (guestfs_h *) (long) jg;
9898   guestfs_close (g);
9899 }
9900
9901 ";
9902
9903   List.iter (
9904     fun (name, style, _, _, _, _, _) ->
9905       pr "JNIEXPORT ";
9906       (match fst style with
9907        | RErr -> pr "void ";
9908        | RInt _ -> pr "jint ";
9909        | RInt64 _ -> pr "jlong ";
9910        | RBool _ -> pr "jboolean ";
9911        | RConstString _ | RConstOptString _ | RString _
9912        | RBufferOut _ -> pr "jstring ";
9913        | RStruct _ | RHashtable _ ->
9914            pr "jobject ";
9915        | RStringList _ | RStructList _ ->
9916            pr "jobjectArray ";
9917       );
9918       pr "JNICALL\n";
9919       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9920       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9921       pr "\n";
9922       pr "  (JNIEnv *env, jobject obj, jlong jg";
9923       List.iter (
9924         function
9925         | Pathname n
9926         | Device n | Dev_or_Path n
9927         | String n
9928         | OptString n
9929         | FileIn n
9930         | FileOut n ->
9931             pr ", jstring j%s" n
9932         | StringList n | DeviceList n ->
9933             pr ", jobjectArray j%s" n
9934         | Bool n ->
9935             pr ", jboolean j%s" n
9936         | Int n ->
9937             pr ", jint j%s" n
9938         | Int64 n ->
9939             pr ", jlong j%s" n
9940       ) (snd style);
9941       pr ")\n";
9942       pr "{\n";
9943       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9944       let error_code, no_ret =
9945         match fst style with
9946         | RErr -> pr "  int r;\n"; "-1", ""
9947         | RBool _
9948         | RInt _ -> pr "  int r;\n"; "-1", "0"
9949         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9950         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9951         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9952         | RString _ ->
9953             pr "  jstring jr;\n";
9954             pr "  char *r;\n"; "NULL", "NULL"
9955         | RStringList _ ->
9956             pr "  jobjectArray jr;\n";
9957             pr "  int r_len;\n";
9958             pr "  jclass cl;\n";
9959             pr "  jstring jstr;\n";
9960             pr "  char **r;\n"; "NULL", "NULL"
9961         | RStruct (_, typ) ->
9962             pr "  jobject jr;\n";
9963             pr "  jclass cl;\n";
9964             pr "  jfieldID fl;\n";
9965             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9966         | RStructList (_, typ) ->
9967             pr "  jobjectArray jr;\n";
9968             pr "  jclass cl;\n";
9969             pr "  jfieldID fl;\n";
9970             pr "  jobject jfl;\n";
9971             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9972         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9973         | RBufferOut _ ->
9974             pr "  jstring jr;\n";
9975             pr "  char *r;\n";
9976             pr "  size_t size;\n";
9977             "NULL", "NULL" in
9978       List.iter (
9979         function
9980         | Pathname n
9981         | Device n | Dev_or_Path n
9982         | String n
9983         | OptString n
9984         | FileIn n
9985         | FileOut n ->
9986             pr "  const char *%s;\n" n
9987         | StringList n | DeviceList n ->
9988             pr "  int %s_len;\n" n;
9989             pr "  const char **%s;\n" n
9990         | Bool n
9991         | Int n ->
9992             pr "  int %s;\n" n
9993         | Int64 n ->
9994             pr "  int64_t %s;\n" n
9995       ) (snd style);
9996
9997       let needs_i =
9998         (match fst style with
9999          | RStringList _ | RStructList _ -> true
10000          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
10001          | RConstOptString _
10002          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
10003           List.exists (function
10004                        | StringList _ -> true
10005                        | DeviceList _ -> true
10006                        | _ -> false) (snd style) in
10007       if needs_i then
10008         pr "  size_t i;\n";
10009
10010       pr "\n";
10011
10012       (* Get the parameters. *)
10013       List.iter (
10014         function
10015         | Pathname n
10016         | Device n | Dev_or_Path n
10017         | String n
10018         | FileIn n
10019         | FileOut n ->
10020             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
10021         | OptString n ->
10022             (* This is completely undocumented, but Java null becomes
10023              * a NULL parameter.
10024              *)
10025             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
10026         | StringList n | DeviceList n ->
10027             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
10028             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
10029             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10030             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10031               n;
10032             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
10033             pr "  }\n";
10034             pr "  %s[%s_len] = NULL;\n" n n;
10035         | Bool n
10036         | Int n
10037         | Int64 n ->
10038             pr "  %s = j%s;\n" n n
10039       ) (snd style);
10040
10041       (* Make the call. *)
10042       pr "  r = guestfs_%s " name;
10043       generate_c_call_args ~handle:"g" style;
10044       pr ";\n";
10045
10046       (* Release the parameters. *)
10047       List.iter (
10048         function
10049         | Pathname n
10050         | Device n | Dev_or_Path n
10051         | String n
10052         | FileIn n
10053         | FileOut n ->
10054             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10055         | OptString n ->
10056             pr "  if (j%s)\n" n;
10057             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10058         | StringList n | DeviceList n ->
10059             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10060             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10061               n;
10062             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10063             pr "  }\n";
10064             pr "  free (%s);\n" n
10065         | Bool n
10066         | Int n
10067         | Int64 n -> ()
10068       ) (snd style);
10069
10070       (* Check for errors. *)
10071       pr "  if (r == %s) {\n" error_code;
10072       pr "    throw_exception (env, guestfs_last_error (g));\n";
10073       pr "    return %s;\n" no_ret;
10074       pr "  }\n";
10075
10076       (* Return value. *)
10077       (match fst style with
10078        | RErr -> ()
10079        | RInt _ -> pr "  return (jint) r;\n"
10080        | RBool _ -> pr "  return (jboolean) r;\n"
10081        | RInt64 _ -> pr "  return (jlong) r;\n"
10082        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10083        | RConstOptString _ ->
10084            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10085        | RString _ ->
10086            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10087            pr "  free (r);\n";
10088            pr "  return jr;\n"
10089        | RStringList _ ->
10090            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10091            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10092            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10093            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10094            pr "  for (i = 0; i < r_len; ++i) {\n";
10095            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10096            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10097            pr "    free (r[i]);\n";
10098            pr "  }\n";
10099            pr "  free (r);\n";
10100            pr "  return jr;\n"
10101        | RStruct (_, typ) ->
10102            let jtyp = java_name_of_struct typ in
10103            let cols = cols_of_struct typ in
10104            generate_java_struct_return typ jtyp cols
10105        | RStructList (_, typ) ->
10106            let jtyp = java_name_of_struct typ in
10107            let cols = cols_of_struct typ in
10108            generate_java_struct_list_return typ jtyp cols
10109        | RHashtable _ ->
10110            (* XXX *)
10111            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10112            pr "  return NULL;\n"
10113        | RBufferOut _ ->
10114            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10115            pr "  free (r);\n";
10116            pr "  return jr;\n"
10117       );
10118
10119       pr "}\n";
10120       pr "\n"
10121   ) all_functions
10122
10123 and generate_java_struct_return typ jtyp cols =
10124   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10125   pr "  jr = (*env)->AllocObject (env, cl);\n";
10126   List.iter (
10127     function
10128     | name, FString ->
10129         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10130         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10131     | name, FUUID ->
10132         pr "  {\n";
10133         pr "    char s[33];\n";
10134         pr "    memcpy (s, r->%s, 32);\n" name;
10135         pr "    s[32] = 0;\n";
10136         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10137         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10138         pr "  }\n";
10139     | name, FBuffer ->
10140         pr "  {\n";
10141         pr "    int len = r->%s_len;\n" name;
10142         pr "    char s[len+1];\n";
10143         pr "    memcpy (s, r->%s, len);\n" name;
10144         pr "    s[len] = 0;\n";
10145         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10146         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10147         pr "  }\n";
10148     | name, (FBytes|FUInt64|FInt64) ->
10149         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10150         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10151     | name, (FUInt32|FInt32) ->
10152         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10153         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10154     | name, FOptPercent ->
10155         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10156         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10157     | name, FChar ->
10158         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10159         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10160   ) cols;
10161   pr "  free (r);\n";
10162   pr "  return jr;\n"
10163
10164 and generate_java_struct_list_return typ jtyp cols =
10165   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10166   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10167   pr "  for (i = 0; i < r->len; ++i) {\n";
10168   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10169   List.iter (
10170     function
10171     | name, FString ->
10172         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10173         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10174     | name, FUUID ->
10175         pr "    {\n";
10176         pr "      char s[33];\n";
10177         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10178         pr "      s[32] = 0;\n";
10179         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10180         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10181         pr "    }\n";
10182     | name, FBuffer ->
10183         pr "    {\n";
10184         pr "      int len = r->val[i].%s_len;\n" name;
10185         pr "      char s[len+1];\n";
10186         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10187         pr "      s[len] = 0;\n";
10188         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10189         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10190         pr "    }\n";
10191     | name, (FBytes|FUInt64|FInt64) ->
10192         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10193         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10194     | name, (FUInt32|FInt32) ->
10195         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10196         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10197     | name, FOptPercent ->
10198         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10199         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10200     | name, FChar ->
10201         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10202         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10203   ) cols;
10204   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10205   pr "  }\n";
10206   pr "  guestfs_free_%s_list (r);\n" typ;
10207   pr "  return jr;\n"
10208
10209 and generate_java_makefile_inc () =
10210   generate_header HashStyle GPLv2plus;
10211
10212   pr "java_built_sources = \\\n";
10213   List.iter (
10214     fun (typ, jtyp) ->
10215         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10216   ) java_structs;
10217   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10218
10219 and generate_haskell_hs () =
10220   generate_header HaskellStyle LGPLv2plus;
10221
10222   (* XXX We only know how to generate partial FFI for Haskell
10223    * at the moment.  Please help out!
10224    *)
10225   let can_generate style =
10226     match style with
10227     | RErr, _
10228     | RInt _, _
10229     | RInt64 _, _ -> true
10230     | RBool _, _
10231     | RConstString _, _
10232     | RConstOptString _, _
10233     | RString _, _
10234     | RStringList _, _
10235     | RStruct _, _
10236     | RStructList _, _
10237     | RHashtable _, _
10238     | RBufferOut _, _ -> false in
10239
10240   pr "\
10241 {-# INCLUDE <guestfs.h> #-}
10242 {-# LANGUAGE ForeignFunctionInterface #-}
10243
10244 module Guestfs (
10245   create";
10246
10247   (* List out the names of the actions we want to export. *)
10248   List.iter (
10249     fun (name, style, _, _, _, _, _) ->
10250       if can_generate style then pr ",\n  %s" name
10251   ) all_functions;
10252
10253   pr "
10254   ) where
10255
10256 -- Unfortunately some symbols duplicate ones already present
10257 -- in Prelude.  We don't know which, so we hard-code a list
10258 -- here.
10259 import Prelude hiding (truncate)
10260
10261 import Foreign
10262 import Foreign.C
10263 import Foreign.C.Types
10264 import IO
10265 import Control.Exception
10266 import Data.Typeable
10267
10268 data GuestfsS = GuestfsS            -- represents the opaque C struct
10269 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10270 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10271
10272 -- XXX define properly later XXX
10273 data PV = PV
10274 data VG = VG
10275 data LV = LV
10276 data IntBool = IntBool
10277 data Stat = Stat
10278 data StatVFS = StatVFS
10279 data Hashtable = Hashtable
10280
10281 foreign import ccall unsafe \"guestfs_create\" c_create
10282   :: IO GuestfsP
10283 foreign import ccall unsafe \"&guestfs_close\" c_close
10284   :: FunPtr (GuestfsP -> IO ())
10285 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10286   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10287
10288 create :: IO GuestfsH
10289 create = do
10290   p <- c_create
10291   c_set_error_handler p nullPtr nullPtr
10292   h <- newForeignPtr c_close p
10293   return h
10294
10295 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10296   :: GuestfsP -> IO CString
10297
10298 -- last_error :: GuestfsH -> IO (Maybe String)
10299 -- last_error h = do
10300 --   str <- withForeignPtr h (\\p -> c_last_error p)
10301 --   maybePeek peekCString str
10302
10303 last_error :: GuestfsH -> IO (String)
10304 last_error h = do
10305   str <- withForeignPtr h (\\p -> c_last_error p)
10306   if (str == nullPtr)
10307     then return \"no error\"
10308     else peekCString str
10309
10310 ";
10311
10312   (* Generate wrappers for each foreign function. *)
10313   List.iter (
10314     fun (name, style, _, _, _, _, _) ->
10315       if can_generate style then (
10316         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10317         pr "  :: ";
10318         generate_haskell_prototype ~handle:"GuestfsP" style;
10319         pr "\n";
10320         pr "\n";
10321         pr "%s :: " name;
10322         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10323         pr "\n";
10324         pr "%s %s = do\n" name
10325           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10326         pr "  r <- ";
10327         (* Convert pointer arguments using with* functions. *)
10328         List.iter (
10329           function
10330           | FileIn n
10331           | FileOut n
10332           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10333           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10334           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10335           | Bool _ | Int _ | Int64 _ -> ()
10336         ) (snd style);
10337         (* Convert integer arguments. *)
10338         let args =
10339           List.map (
10340             function
10341             | Bool n -> sprintf "(fromBool %s)" n
10342             | Int n -> sprintf "(fromIntegral %s)" n
10343             | Int64 n -> sprintf "(fromIntegral %s)" n
10344             | FileIn n | FileOut n
10345             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10346           ) (snd style) in
10347         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10348           (String.concat " " ("p" :: args));
10349         (match fst style with
10350          | RErr | RInt _ | RInt64 _ | RBool _ ->
10351              pr "  if (r == -1)\n";
10352              pr "    then do\n";
10353              pr "      err <- last_error h\n";
10354              pr "      fail err\n";
10355          | RConstString _ | RConstOptString _ | RString _
10356          | RStringList _ | RStruct _
10357          | RStructList _ | RHashtable _ | RBufferOut _ ->
10358              pr "  if (r == nullPtr)\n";
10359              pr "    then do\n";
10360              pr "      err <- last_error h\n";
10361              pr "      fail err\n";
10362         );
10363         (match fst style with
10364          | RErr ->
10365              pr "    else return ()\n"
10366          | RInt _ ->
10367              pr "    else return (fromIntegral r)\n"
10368          | RInt64 _ ->
10369              pr "    else return (fromIntegral r)\n"
10370          | RBool _ ->
10371              pr "    else return (toBool r)\n"
10372          | RConstString _
10373          | RConstOptString _
10374          | RString _
10375          | RStringList _
10376          | RStruct _
10377          | RStructList _
10378          | RHashtable _
10379          | RBufferOut _ ->
10380              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10381         );
10382         pr "\n";
10383       )
10384   ) all_functions
10385
10386 and generate_haskell_prototype ~handle ?(hs = false) style =
10387   pr "%s -> " handle;
10388   let string = if hs then "String" else "CString" in
10389   let int = if hs then "Int" else "CInt" in
10390   let bool = if hs then "Bool" else "CInt" in
10391   let int64 = if hs then "Integer" else "Int64" in
10392   List.iter (
10393     fun arg ->
10394       (match arg with
10395        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10396        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10397        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10398        | Bool _ -> pr "%s" bool
10399        | Int _ -> pr "%s" int
10400        | Int64 _ -> pr "%s" int
10401        | FileIn _ -> pr "%s" string
10402        | FileOut _ -> pr "%s" string
10403       );
10404       pr " -> ";
10405   ) (snd style);
10406   pr "IO (";
10407   (match fst style with
10408    | RErr -> if not hs then pr "CInt"
10409    | RInt _ -> pr "%s" int
10410    | RInt64 _ -> pr "%s" int64
10411    | RBool _ -> pr "%s" bool
10412    | RConstString _ -> pr "%s" string
10413    | RConstOptString _ -> pr "Maybe %s" string
10414    | RString _ -> pr "%s" string
10415    | RStringList _ -> pr "[%s]" string
10416    | RStruct (_, typ) ->
10417        let name = java_name_of_struct typ in
10418        pr "%s" name
10419    | RStructList (_, typ) ->
10420        let name = java_name_of_struct typ in
10421        pr "[%s]" name
10422    | RHashtable _ -> pr "Hashtable"
10423    | RBufferOut _ -> pr "%s" string
10424   );
10425   pr ")"
10426
10427 and generate_csharp () =
10428   generate_header CPlusPlusStyle LGPLv2plus;
10429
10430   (* XXX Make this configurable by the C# assembly users. *)
10431   let library = "libguestfs.so.0" in
10432
10433   pr "\
10434 // These C# bindings are highly experimental at present.
10435 //
10436 // Firstly they only work on Linux (ie. Mono).  In order to get them
10437 // to work on Windows (ie. .Net) you would need to port the library
10438 // itself to Windows first.
10439 //
10440 // The second issue is that some calls are known to be incorrect and
10441 // can cause Mono to segfault.  Particularly: calls which pass or
10442 // return string[], or return any structure value.  This is because
10443 // we haven't worked out the correct way to do this from C#.
10444 //
10445 // The third issue is that when compiling you get a lot of warnings.
10446 // We are not sure whether the warnings are important or not.
10447 //
10448 // Fourthly we do not routinely build or test these bindings as part
10449 // of the make && make check cycle, which means that regressions might
10450 // go unnoticed.
10451 //
10452 // Suggestions and patches are welcome.
10453
10454 // To compile:
10455 //
10456 // gmcs Libguestfs.cs
10457 // mono Libguestfs.exe
10458 //
10459 // (You'll probably want to add a Test class / static main function
10460 // otherwise this won't do anything useful).
10461
10462 using System;
10463 using System.IO;
10464 using System.Runtime.InteropServices;
10465 using System.Runtime.Serialization;
10466 using System.Collections;
10467
10468 namespace Guestfs
10469 {
10470   class Error : System.ApplicationException
10471   {
10472     public Error (string message) : base (message) {}
10473     protected Error (SerializationInfo info, StreamingContext context) {}
10474   }
10475
10476   class Guestfs
10477   {
10478     IntPtr _handle;
10479
10480     [DllImport (\"%s\")]
10481     static extern IntPtr guestfs_create ();
10482
10483     public Guestfs ()
10484     {
10485       _handle = guestfs_create ();
10486       if (_handle == IntPtr.Zero)
10487         throw new Error (\"could not create guestfs handle\");
10488     }
10489
10490     [DllImport (\"%s\")]
10491     static extern void guestfs_close (IntPtr h);
10492
10493     ~Guestfs ()
10494     {
10495       guestfs_close (_handle);
10496     }
10497
10498     [DllImport (\"%s\")]
10499     static extern string guestfs_last_error (IntPtr h);
10500
10501 " library library library;
10502
10503   (* Generate C# structure bindings.  We prefix struct names with
10504    * underscore because C# cannot have conflicting struct names and
10505    * method names (eg. "class stat" and "stat").
10506    *)
10507   List.iter (
10508     fun (typ, cols) ->
10509       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10510       pr "    public class _%s {\n" typ;
10511       List.iter (
10512         function
10513         | name, FChar -> pr "      char %s;\n" name
10514         | name, FString -> pr "      string %s;\n" name
10515         | name, FBuffer ->
10516             pr "      uint %s_len;\n" name;
10517             pr "      string %s;\n" name
10518         | name, FUUID ->
10519             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10520             pr "      string %s;\n" name
10521         | name, FUInt32 -> pr "      uint %s;\n" name
10522         | name, FInt32 -> pr "      int %s;\n" name
10523         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10524         | name, FInt64 -> pr "      long %s;\n" name
10525         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10526       ) cols;
10527       pr "    }\n";
10528       pr "\n"
10529   ) structs;
10530
10531   (* Generate C# function bindings. *)
10532   List.iter (
10533     fun (name, style, _, _, _, shortdesc, _) ->
10534       let rec csharp_return_type () =
10535         match fst style with
10536         | RErr -> "void"
10537         | RBool n -> "bool"
10538         | RInt n -> "int"
10539         | RInt64 n -> "long"
10540         | RConstString n
10541         | RConstOptString n
10542         | RString n
10543         | RBufferOut n -> "string"
10544         | RStruct (_,n) -> "_" ^ n
10545         | RHashtable n -> "Hashtable"
10546         | RStringList n -> "string[]"
10547         | RStructList (_,n) -> sprintf "_%s[]" n
10548
10549       and c_return_type () =
10550         match fst style with
10551         | RErr
10552         | RBool _
10553         | RInt _ -> "int"
10554         | RInt64 _ -> "long"
10555         | RConstString _
10556         | RConstOptString _
10557         | RString _
10558         | RBufferOut _ -> "string"
10559         | RStruct (_,n) -> "_" ^ n
10560         | RHashtable _
10561         | RStringList _ -> "string[]"
10562         | RStructList (_,n) -> sprintf "_%s[]" n
10563
10564       and c_error_comparison () =
10565         match fst style with
10566         | RErr
10567         | RBool _
10568         | RInt _
10569         | RInt64 _ -> "== -1"
10570         | RConstString _
10571         | RConstOptString _
10572         | RString _
10573         | RBufferOut _
10574         | RStruct (_,_)
10575         | RHashtable _
10576         | RStringList _
10577         | RStructList (_,_) -> "== null"
10578
10579       and generate_extern_prototype () =
10580         pr "    static extern %s guestfs_%s (IntPtr h"
10581           (c_return_type ()) name;
10582         List.iter (
10583           function
10584           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10585           | FileIn n | FileOut n ->
10586               pr ", [In] string %s" n
10587           | StringList n | DeviceList n ->
10588               pr ", [In] string[] %s" n
10589           | Bool n ->
10590               pr ", bool %s" n
10591           | Int n ->
10592               pr ", int %s" n
10593           | Int64 n ->
10594               pr ", long %s" n
10595         ) (snd style);
10596         pr ");\n"
10597
10598       and generate_public_prototype () =
10599         pr "    public %s %s (" (csharp_return_type ()) name;
10600         let comma = ref false in
10601         let next () =
10602           if !comma then pr ", ";
10603           comma := true
10604         in
10605         List.iter (
10606           function
10607           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10608           | FileIn n | FileOut n ->
10609               next (); pr "string %s" n
10610           | StringList n | DeviceList n ->
10611               next (); pr "string[] %s" n
10612           | Bool n ->
10613               next (); pr "bool %s" n
10614           | Int n ->
10615               next (); pr "int %s" n
10616           | Int64 n ->
10617               next (); pr "long %s" n
10618         ) (snd style);
10619         pr ")\n"
10620
10621       and generate_call () =
10622         pr "guestfs_%s (_handle" name;
10623         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10624         pr ");\n";
10625       in
10626
10627       pr "    [DllImport (\"%s\")]\n" library;
10628       generate_extern_prototype ();
10629       pr "\n";
10630       pr "    /// <summary>\n";
10631       pr "    /// %s\n" shortdesc;
10632       pr "    /// </summary>\n";
10633       generate_public_prototype ();
10634       pr "    {\n";
10635       pr "      %s r;\n" (c_return_type ());
10636       pr "      r = ";
10637       generate_call ();
10638       pr "      if (r %s)\n" (c_error_comparison ());
10639       pr "        throw new Error (guestfs_last_error (_handle));\n";
10640       (match fst style with
10641        | RErr -> ()
10642        | RBool _ ->
10643            pr "      return r != 0 ? true : false;\n"
10644        | RHashtable _ ->
10645            pr "      Hashtable rr = new Hashtable ();\n";
10646            pr "      for (size_t i = 0; i < r.Length; i += 2)\n";
10647            pr "        rr.Add (r[i], r[i+1]);\n";
10648            pr "      return rr;\n"
10649        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10650        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10651        | RStructList _ ->
10652            pr "      return r;\n"
10653       );
10654       pr "    }\n";
10655       pr "\n";
10656   ) all_functions_sorted;
10657
10658   pr "  }
10659 }
10660 "
10661
10662 and generate_bindtests () =
10663   generate_header CStyle LGPLv2plus;
10664
10665   pr "\
10666 #include <stdio.h>
10667 #include <stdlib.h>
10668 #include <inttypes.h>
10669 #include <string.h>
10670
10671 #include \"guestfs.h\"
10672 #include \"guestfs-internal.h\"
10673 #include \"guestfs-internal-actions.h\"
10674 #include \"guestfs_protocol.h\"
10675
10676 #define error guestfs_error
10677 #define safe_calloc guestfs_safe_calloc
10678 #define safe_malloc guestfs_safe_malloc
10679
10680 static void
10681 print_strings (char *const *argv)
10682 {
10683   size_t argc;
10684
10685   printf (\"[\");
10686   for (argc = 0; argv[argc] != NULL; ++argc) {
10687     if (argc > 0) printf (\", \");
10688     printf (\"\\\"%%s\\\"\", argv[argc]);
10689   }
10690   printf (\"]\\n\");
10691 }
10692
10693 /* The test0 function prints its parameters to stdout. */
10694 ";
10695
10696   let test0, tests =
10697     match test_functions with
10698     | [] -> assert false
10699     | test0 :: tests -> test0, tests in
10700
10701   let () =
10702     let (name, style, _, _, _, _, _) = test0 in
10703     generate_prototype ~extern:false ~semicolon:false ~newline:true
10704       ~handle:"g" ~prefix:"guestfs__" name style;
10705     pr "{\n";
10706     List.iter (
10707       function
10708       | Pathname n
10709       | Device n | Dev_or_Path n
10710       | String n
10711       | FileIn n
10712       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10713       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10714       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10715       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10716       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10717       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10718     ) (snd style);
10719     pr "  /* Java changes stdout line buffering so we need this: */\n";
10720     pr "  fflush (stdout);\n";
10721     pr "  return 0;\n";
10722     pr "}\n";
10723     pr "\n" in
10724
10725   List.iter (
10726     fun (name, style, _, _, _, _, _) ->
10727       if String.sub name (String.length name - 3) 3 <> "err" then (
10728         pr "/* Test normal return. */\n";
10729         generate_prototype ~extern:false ~semicolon:false ~newline:true
10730           ~handle:"g" ~prefix:"guestfs__" name style;
10731         pr "{\n";
10732         (match fst style with
10733          | RErr ->
10734              pr "  return 0;\n"
10735          | RInt _ ->
10736              pr "  int r;\n";
10737              pr "  sscanf (val, \"%%d\", &r);\n";
10738              pr "  return r;\n"
10739          | RInt64 _ ->
10740              pr "  int64_t r;\n";
10741              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10742              pr "  return r;\n"
10743          | RBool _ ->
10744              pr "  return STREQ (val, \"true\");\n"
10745          | RConstString _
10746          | RConstOptString _ ->
10747              (* Can't return the input string here.  Return a static
10748               * string so we ensure we get a segfault if the caller
10749               * tries to free it.
10750               *)
10751              pr "  return \"static string\";\n"
10752          | RString _ ->
10753              pr "  return strdup (val);\n"
10754          | RStringList _ ->
10755              pr "  char **strs;\n";
10756              pr "  int n, i;\n";
10757              pr "  sscanf (val, \"%%d\", &n);\n";
10758              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10759              pr "  for (i = 0; i < n; ++i) {\n";
10760              pr "    strs[i] = safe_malloc (g, 16);\n";
10761              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10762              pr "  }\n";
10763              pr "  strs[n] = NULL;\n";
10764              pr "  return strs;\n"
10765          | RStruct (_, typ) ->
10766              pr "  struct guestfs_%s *r;\n" typ;
10767              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10768              pr "  return r;\n"
10769          | RStructList (_, typ) ->
10770              pr "  struct guestfs_%s_list *r;\n" typ;
10771              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10772              pr "  sscanf (val, \"%%d\", &r->len);\n";
10773              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10774              pr "  return r;\n"
10775          | RHashtable _ ->
10776              pr "  char **strs;\n";
10777              pr "  int n, i;\n";
10778              pr "  sscanf (val, \"%%d\", &n);\n";
10779              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10780              pr "  for (i = 0; i < n; ++i) {\n";
10781              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10782              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10783              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10784              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10785              pr "  }\n";
10786              pr "  strs[n*2] = NULL;\n";
10787              pr "  return strs;\n"
10788          | RBufferOut _ ->
10789              pr "  return strdup (val);\n"
10790         );
10791         pr "}\n";
10792         pr "\n"
10793       ) else (
10794         pr "/* Test error return. */\n";
10795         generate_prototype ~extern:false ~semicolon:false ~newline:true
10796           ~handle:"g" ~prefix:"guestfs__" name style;
10797         pr "{\n";
10798         pr "  error (g, \"error\");\n";
10799         (match fst style with
10800          | RErr | RInt _ | RInt64 _ | RBool _ ->
10801              pr "  return -1;\n"
10802          | RConstString _ | RConstOptString _
10803          | RString _ | RStringList _ | RStruct _
10804          | RStructList _
10805          | RHashtable _
10806          | RBufferOut _ ->
10807              pr "  return NULL;\n"
10808         );
10809         pr "}\n";
10810         pr "\n"
10811       )
10812   ) tests
10813
10814 and generate_ocaml_bindtests () =
10815   generate_header OCamlStyle GPLv2plus;
10816
10817   pr "\
10818 let () =
10819   let g = Guestfs.create () in
10820 ";
10821
10822   let mkargs args =
10823     String.concat " " (
10824       List.map (
10825         function
10826         | CallString s -> "\"" ^ s ^ "\""
10827         | CallOptString None -> "None"
10828         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10829         | CallStringList xs ->
10830             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10831         | CallInt i when i >= 0 -> string_of_int i
10832         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10833         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10834         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10835         | CallBool b -> string_of_bool b
10836       ) args
10837     )
10838   in
10839
10840   generate_lang_bindtests (
10841     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10842   );
10843
10844   pr "print_endline \"EOF\"\n"
10845
10846 and generate_perl_bindtests () =
10847   pr "#!/usr/bin/perl -w\n";
10848   generate_header HashStyle GPLv2plus;
10849
10850   pr "\
10851 use strict;
10852
10853 use Sys::Guestfs;
10854
10855 my $g = Sys::Guestfs->new ();
10856 ";
10857
10858   let mkargs args =
10859     String.concat ", " (
10860       List.map (
10861         function
10862         | CallString s -> "\"" ^ s ^ "\""
10863         | CallOptString None -> "undef"
10864         | CallOptString (Some s) -> sprintf "\"%s\"" s
10865         | CallStringList xs ->
10866             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10867         | CallInt i -> string_of_int i
10868         | CallInt64 i -> Int64.to_string i
10869         | CallBool b -> if b then "1" else "0"
10870       ) args
10871     )
10872   in
10873
10874   generate_lang_bindtests (
10875     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10876   );
10877
10878   pr "print \"EOF\\n\"\n"
10879
10880 and generate_python_bindtests () =
10881   generate_header HashStyle GPLv2plus;
10882
10883   pr "\
10884 import guestfs
10885
10886 g = guestfs.GuestFS ()
10887 ";
10888
10889   let mkargs args =
10890     String.concat ", " (
10891       List.map (
10892         function
10893         | CallString s -> "\"" ^ s ^ "\""
10894         | CallOptString None -> "None"
10895         | CallOptString (Some s) -> sprintf "\"%s\"" s
10896         | CallStringList xs ->
10897             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10898         | CallInt i -> string_of_int i
10899         | CallInt64 i -> Int64.to_string i
10900         | CallBool b -> if b then "1" else "0"
10901       ) args
10902     )
10903   in
10904
10905   generate_lang_bindtests (
10906     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10907   );
10908
10909   pr "print \"EOF\"\n"
10910
10911 and generate_ruby_bindtests () =
10912   generate_header HashStyle GPLv2plus;
10913
10914   pr "\
10915 require 'guestfs'
10916
10917 g = Guestfs::create()
10918 ";
10919
10920   let mkargs args =
10921     String.concat ", " (
10922       List.map (
10923         function
10924         | CallString s -> "\"" ^ s ^ "\""
10925         | CallOptString None -> "nil"
10926         | CallOptString (Some s) -> sprintf "\"%s\"" s
10927         | CallStringList xs ->
10928             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10929         | CallInt i -> string_of_int i
10930         | CallInt64 i -> Int64.to_string i
10931         | CallBool b -> string_of_bool b
10932       ) args
10933     )
10934   in
10935
10936   generate_lang_bindtests (
10937     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10938   );
10939
10940   pr "print \"EOF\\n\"\n"
10941
10942 and generate_java_bindtests () =
10943   generate_header CStyle GPLv2plus;
10944
10945   pr "\
10946 import com.redhat.et.libguestfs.*;
10947
10948 public class Bindtests {
10949     public static void main (String[] argv)
10950     {
10951         try {
10952             GuestFS g = new GuestFS ();
10953 ";
10954
10955   let mkargs args =
10956     String.concat ", " (
10957       List.map (
10958         function
10959         | CallString s -> "\"" ^ s ^ "\""
10960         | CallOptString None -> "null"
10961         | CallOptString (Some s) -> sprintf "\"%s\"" s
10962         | CallStringList xs ->
10963             "new String[]{" ^
10964               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10965         | CallInt i -> string_of_int i
10966         | CallInt64 i -> Int64.to_string i
10967         | CallBool b -> string_of_bool b
10968       ) args
10969     )
10970   in
10971
10972   generate_lang_bindtests (
10973     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10974   );
10975
10976   pr "
10977             System.out.println (\"EOF\");
10978         }
10979         catch (Exception exn) {
10980             System.err.println (exn);
10981             System.exit (1);
10982         }
10983     }
10984 }
10985 "
10986
10987 and generate_haskell_bindtests () =
10988   generate_header HaskellStyle GPLv2plus;
10989
10990   pr "\
10991 module Bindtests where
10992 import qualified Guestfs
10993
10994 main = do
10995   g <- Guestfs.create
10996 ";
10997
10998   let mkargs args =
10999     String.concat " " (
11000       List.map (
11001         function
11002         | CallString s -> "\"" ^ s ^ "\""
11003         | CallOptString None -> "Nothing"
11004         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
11005         | CallStringList xs ->
11006             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11007         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
11008         | CallInt i -> string_of_int i
11009         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
11010         | CallInt64 i -> Int64.to_string i
11011         | CallBool true -> "True"
11012         | CallBool false -> "False"
11013       ) args
11014     )
11015   in
11016
11017   generate_lang_bindtests (
11018     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
11019   );
11020
11021   pr "  putStrLn \"EOF\"\n"
11022
11023 (* Language-independent bindings tests - we do it this way to
11024  * ensure there is parity in testing bindings across all languages.
11025  *)
11026 and generate_lang_bindtests call =
11027   call "test0" [CallString "abc"; CallOptString (Some "def");
11028                 CallStringList []; CallBool false;
11029                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11030   call "test0" [CallString "abc"; CallOptString None;
11031                 CallStringList []; CallBool false;
11032                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11033   call "test0" [CallString ""; CallOptString (Some "def");
11034                 CallStringList []; CallBool false;
11035                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11036   call "test0" [CallString ""; CallOptString (Some "");
11037                 CallStringList []; CallBool false;
11038                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11039   call "test0" [CallString "abc"; CallOptString (Some "def");
11040                 CallStringList ["1"]; CallBool false;
11041                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11042   call "test0" [CallString "abc"; CallOptString (Some "def");
11043                 CallStringList ["1"; "2"]; CallBool false;
11044                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11045   call "test0" [CallString "abc"; CallOptString (Some "def");
11046                 CallStringList ["1"]; CallBool true;
11047                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11048   call "test0" [CallString "abc"; CallOptString (Some "def");
11049                 CallStringList ["1"]; CallBool false;
11050                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
11051   call "test0" [CallString "abc"; CallOptString (Some "def");
11052                 CallStringList ["1"]; CallBool false;
11053                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
11054   call "test0" [CallString "abc"; CallOptString (Some "def");
11055                 CallStringList ["1"]; CallBool false;
11056                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
11057   call "test0" [CallString "abc"; CallOptString (Some "def");
11058                 CallStringList ["1"]; CallBool false;
11059                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11060   call "test0" [CallString "abc"; CallOptString (Some "def");
11061                 CallStringList ["1"]; CallBool false;
11062                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11063   call "test0" [CallString "abc"; CallOptString (Some "def");
11064                 CallStringList ["1"]; CallBool false;
11065                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11066
11067 (* XXX Add here tests of the return and error functions. *)
11068
11069 (* Code to generator bindings for virt-inspector.  Currently only
11070  * implemented for OCaml code (for virt-p2v 2.0).
11071  *)
11072 let rng_input = "inspector/virt-inspector.rng"
11073
11074 (* Read the input file and parse it into internal structures.  This is
11075  * by no means a complete RELAX NG parser, but is just enough to be
11076  * able to parse the specific input file.
11077  *)
11078 type rng =
11079   | Element of string * rng list        (* <element name=name/> *)
11080   | Attribute of string * rng list        (* <attribute name=name/> *)
11081   | Interleave of rng list                (* <interleave/> *)
11082   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11083   | OneOrMore of rng                        (* <oneOrMore/> *)
11084   | Optional of rng                        (* <optional/> *)
11085   | Choice of string list                (* <choice><value/>*</choice> *)
11086   | Value of string                        (* <value>str</value> *)
11087   | Text                                (* <text/> *)
11088
11089 let rec string_of_rng = function
11090   | Element (name, xs) ->
11091       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11092   | Attribute (name, xs) ->
11093       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11094   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11095   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11096   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11097   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11098   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11099   | Value value -> "Value \"" ^ value ^ "\""
11100   | Text -> "Text"
11101
11102 and string_of_rng_list xs =
11103   String.concat ", " (List.map string_of_rng xs)
11104
11105 let rec parse_rng ?defines context = function
11106   | [] -> []
11107   | Xml.Element ("element", ["name", name], children) :: rest ->
11108       Element (name, parse_rng ?defines context children)
11109       :: parse_rng ?defines context rest
11110   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11111       Attribute (name, parse_rng ?defines context children)
11112       :: parse_rng ?defines context rest
11113   | Xml.Element ("interleave", [], children) :: rest ->
11114       Interleave (parse_rng ?defines context children)
11115       :: parse_rng ?defines context rest
11116   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11117       let rng = parse_rng ?defines context [child] in
11118       (match rng with
11119        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11120        | _ ->
11121            failwithf "%s: <zeroOrMore> contains more than one child element"
11122              context
11123       )
11124   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11125       let rng = parse_rng ?defines context [child] in
11126       (match rng with
11127        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11128        | _ ->
11129            failwithf "%s: <oneOrMore> contains more than one child element"
11130              context
11131       )
11132   | Xml.Element ("optional", [], [child]) :: rest ->
11133       let rng = parse_rng ?defines context [child] in
11134       (match rng with
11135        | [child] -> Optional child :: parse_rng ?defines context rest
11136        | _ ->
11137            failwithf "%s: <optional> contains more than one child element"
11138              context
11139       )
11140   | Xml.Element ("choice", [], children) :: rest ->
11141       let values = List.map (
11142         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11143         | _ ->
11144             failwithf "%s: can't handle anything except <value> in <choice>"
11145               context
11146       ) children in
11147       Choice values
11148       :: parse_rng ?defines context rest
11149   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11150       Value value :: parse_rng ?defines context rest
11151   | Xml.Element ("text", [], []) :: rest ->
11152       Text :: parse_rng ?defines context rest
11153   | Xml.Element ("ref", ["name", name], []) :: rest ->
11154       (* Look up the reference.  Because of limitations in this parser,
11155        * we can't handle arbitrarily nested <ref> yet.  You can only
11156        * use <ref> from inside <start>.
11157        *)
11158       (match defines with
11159        | None ->
11160            failwithf "%s: contains <ref>, but no refs are defined yet" context
11161        | Some map ->
11162            let rng = StringMap.find name map in
11163            rng @ parse_rng ?defines context rest
11164       )
11165   | x :: _ ->
11166       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11167
11168 let grammar =
11169   let xml = Xml.parse_file rng_input in
11170   match xml with
11171   | Xml.Element ("grammar", _,
11172                  Xml.Element ("start", _, gram) :: defines) ->
11173       (* The <define/> elements are referenced in the <start> section,
11174        * so build a map of those first.
11175        *)
11176       let defines = List.fold_left (
11177         fun map ->
11178           function Xml.Element ("define", ["name", name], defn) ->
11179             StringMap.add name defn map
11180           | _ ->
11181               failwithf "%s: expected <define name=name/>" rng_input
11182       ) StringMap.empty defines in
11183       let defines = StringMap.mapi parse_rng defines in
11184
11185       (* Parse the <start> clause, passing the defines. *)
11186       parse_rng ~defines "<start>" gram
11187   | _ ->
11188       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11189         rng_input
11190
11191 let name_of_field = function
11192   | Element (name, _) | Attribute (name, _)
11193   | ZeroOrMore (Element (name, _))
11194   | OneOrMore (Element (name, _))
11195   | Optional (Element (name, _)) -> name
11196   | Optional (Attribute (name, _)) -> name
11197   | Text -> (* an unnamed field in an element *)
11198       "data"
11199   | rng ->
11200       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11201
11202 (* At the moment this function only generates OCaml types.  However we
11203  * should parameterize it later so it can generate types/structs in a
11204  * variety of languages.
11205  *)
11206 let generate_types xs =
11207   (* A simple type is one that can be printed out directly, eg.
11208    * "string option".  A complex type is one which has a name and has
11209    * to be defined via another toplevel definition, eg. a struct.
11210    *
11211    * generate_type generates code for either simple or complex types.
11212    * In the simple case, it returns the string ("string option").  In
11213    * the complex case, it returns the name ("mountpoint").  In the
11214    * complex case it has to print out the definition before returning,
11215    * so it should only be called when we are at the beginning of a
11216    * new line (BOL context).
11217    *)
11218   let rec generate_type = function
11219     | Text ->                                (* string *)
11220         "string", true
11221     | Choice values ->                        (* [`val1|`val2|...] *)
11222         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11223     | ZeroOrMore rng ->                        (* <rng> list *)
11224         let t, is_simple = generate_type rng in
11225         t ^ " list (* 0 or more *)", is_simple
11226     | OneOrMore rng ->                        (* <rng> list *)
11227         let t, is_simple = generate_type rng in
11228         t ^ " list (* 1 or more *)", is_simple
11229                                         (* virt-inspector hack: bool *)
11230     | Optional (Attribute (name, [Value "1"])) ->
11231         "bool", true
11232     | Optional rng ->                        (* <rng> list *)
11233         let t, is_simple = generate_type rng in
11234         t ^ " option", is_simple
11235                                         (* type name = { fields ... } *)
11236     | Element (name, fields) when is_attrs_interleave fields ->
11237         generate_type_struct name (get_attrs_interleave fields)
11238     | Element (name, [field])                (* type name = field *)
11239     | Attribute (name, [field]) ->
11240         let t, is_simple = generate_type field in
11241         if is_simple then (t, true)
11242         else (
11243           pr "type %s = %s\n" name t;
11244           name, false
11245         )
11246     | Element (name, fields) ->              (* type name = { fields ... } *)
11247         generate_type_struct name fields
11248     | rng ->
11249         failwithf "generate_type failed at: %s" (string_of_rng rng)
11250
11251   and is_attrs_interleave = function
11252     | [Interleave _] -> true
11253     | Attribute _ :: fields -> is_attrs_interleave fields
11254     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11255     | _ -> false
11256
11257   and get_attrs_interleave = function
11258     | [Interleave fields] -> fields
11259     | ((Attribute _) as field) :: fields
11260     | ((Optional (Attribute _)) as field) :: fields ->
11261         field :: get_attrs_interleave fields
11262     | _ -> assert false
11263
11264   and generate_types xs =
11265     List.iter (fun x -> ignore (generate_type x)) xs
11266
11267   and generate_type_struct name fields =
11268     (* Calculate the types of the fields first.  We have to do this
11269      * before printing anything so we are still in BOL context.
11270      *)
11271     let types = List.map fst (List.map generate_type fields) in
11272
11273     (* Special case of a struct containing just a string and another
11274      * field.  Turn it into an assoc list.
11275      *)
11276     match types with
11277     | ["string"; other] ->
11278         let fname1, fname2 =
11279           match fields with
11280           | [f1; f2] -> name_of_field f1, name_of_field f2
11281           | _ -> assert false in
11282         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11283         name, false
11284
11285     | types ->
11286         pr "type %s = {\n" name;
11287         List.iter (
11288           fun (field, ftype) ->
11289             let fname = name_of_field field in
11290             pr "  %s_%s : %s;\n" name fname ftype
11291         ) (List.combine fields types);
11292         pr "}\n";
11293         (* Return the name of this type, and
11294          * false because it's not a simple type.
11295          *)
11296         name, false
11297   in
11298
11299   generate_types xs
11300
11301 let generate_parsers xs =
11302   (* As for generate_type above, generate_parser makes a parser for
11303    * some type, and returns the name of the parser it has generated.
11304    * Because it (may) need to print something, it should always be
11305    * called in BOL context.
11306    *)
11307   let rec generate_parser = function
11308     | Text ->                                (* string *)
11309         "string_child_or_empty"
11310     | Choice values ->                        (* [`val1|`val2|...] *)
11311         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11312           (String.concat "|"
11313              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11314     | ZeroOrMore rng ->                        (* <rng> list *)
11315         let pa = generate_parser rng in
11316         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11317     | OneOrMore rng ->                        (* <rng> list *)
11318         let pa = generate_parser rng in
11319         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11320                                         (* virt-inspector hack: bool *)
11321     | Optional (Attribute (name, [Value "1"])) ->
11322         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11323     | Optional rng ->                        (* <rng> list *)
11324         let pa = generate_parser rng in
11325         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11326                                         (* type name = { fields ... } *)
11327     | Element (name, fields) when is_attrs_interleave fields ->
11328         generate_parser_struct name (get_attrs_interleave fields)
11329     | Element (name, [field]) ->        (* type name = field *)
11330         let pa = generate_parser field in
11331         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11332         pr "let %s =\n" parser_name;
11333         pr "  %s\n" pa;
11334         pr "let parse_%s = %s\n" name parser_name;
11335         parser_name
11336     | Attribute (name, [field]) ->
11337         let pa = generate_parser field in
11338         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11339         pr "let %s =\n" parser_name;
11340         pr "  %s\n" pa;
11341         pr "let parse_%s = %s\n" name parser_name;
11342         parser_name
11343     | Element (name, fields) ->              (* type name = { fields ... } *)
11344         generate_parser_struct name ([], fields)
11345     | rng ->
11346         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11347
11348   and is_attrs_interleave = function
11349     | [Interleave _] -> true
11350     | Attribute _ :: fields -> is_attrs_interleave fields
11351     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11352     | _ -> false
11353
11354   and get_attrs_interleave = function
11355     | [Interleave fields] -> [], fields
11356     | ((Attribute _) as field) :: fields
11357     | ((Optional (Attribute _)) as field) :: fields ->
11358         let attrs, interleaves = get_attrs_interleave fields in
11359         (field :: attrs), interleaves
11360     | _ -> assert false
11361
11362   and generate_parsers xs =
11363     List.iter (fun x -> ignore (generate_parser x)) xs
11364
11365   and generate_parser_struct name (attrs, interleaves) =
11366     (* Generate parsers for the fields first.  We have to do this
11367      * before printing anything so we are still in BOL context.
11368      *)
11369     let fields = attrs @ interleaves in
11370     let pas = List.map generate_parser fields in
11371
11372     (* Generate an intermediate tuple from all the fields first.
11373      * If the type is just a string + another field, then we will
11374      * return this directly, otherwise it is turned into a record.
11375      *
11376      * RELAX NG note: This code treats <interleave> and plain lists of
11377      * fields the same.  In other words, it doesn't bother enforcing
11378      * any ordering of fields in the XML.
11379      *)
11380     pr "let parse_%s x =\n" name;
11381     pr "  let t = (\n    ";
11382     let comma = ref false in
11383     List.iter (
11384       fun x ->
11385         if !comma then pr ",\n    ";
11386         comma := true;
11387         match x with
11388         | Optional (Attribute (fname, [field])), pa ->
11389             pr "%s x" pa
11390         | Optional (Element (fname, [field])), pa ->
11391             pr "%s (optional_child %S x)" pa fname
11392         | Attribute (fname, [Text]), _ ->
11393             pr "attribute %S x" fname
11394         | (ZeroOrMore _ | OneOrMore _), pa ->
11395             pr "%s x" pa
11396         | Text, pa ->
11397             pr "%s x" pa
11398         | (field, pa) ->
11399             let fname = name_of_field field in
11400             pr "%s (child %S x)" pa fname
11401     ) (List.combine fields pas);
11402     pr "\n  ) in\n";
11403
11404     (match fields with
11405      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11406          pr "  t\n"
11407
11408      | _ ->
11409          pr "  (Obj.magic t : %s)\n" name
11410 (*
11411          List.iter (
11412            function
11413            | (Optional (Attribute (fname, [field])), pa) ->
11414                pr "  %s_%s =\n" name fname;
11415                pr "    %s x;\n" pa
11416            | (Optional (Element (fname, [field])), pa) ->
11417                pr "  %s_%s =\n" name fname;
11418                pr "    (let x = optional_child %S x in\n" fname;
11419                pr "     %s x);\n" pa
11420            | (field, pa) ->
11421                let fname = name_of_field field in
11422                pr "  %s_%s =\n" name fname;
11423                pr "    (let x = child %S x in\n" fname;
11424                pr "     %s x);\n" pa
11425          ) (List.combine fields pas);
11426          pr "}\n"
11427 *)
11428     );
11429     sprintf "parse_%s" name
11430   in
11431
11432   generate_parsers xs
11433
11434 (* Generate ocaml/guestfs_inspector.mli. *)
11435 let generate_ocaml_inspector_mli () =
11436   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11437
11438   pr "\
11439 (** This is an OCaml language binding to the external [virt-inspector]
11440     program.
11441
11442     For more information, please read the man page [virt-inspector(1)].
11443 *)
11444
11445 ";
11446
11447   generate_types grammar;
11448   pr "(** The nested information returned from the {!inspect} function. *)\n";
11449   pr "\n";
11450
11451   pr "\
11452 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11453 (** To inspect a libvirt domain called [name], pass a singleton
11454     list: [inspect [name]].  When using libvirt only, you may
11455     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11456
11457     To inspect a disk image or images, pass a list of the filenames
11458     of the disk images: [inspect filenames]
11459
11460     This function inspects the given guest or disk images and
11461     returns a list of operating system(s) found and a large amount
11462     of information about them.  In the vast majority of cases,
11463     a virtual machine only contains a single operating system.
11464
11465     If the optional [~xml] parameter is given, then this function
11466     skips running the external virt-inspector program and just
11467     parses the given XML directly (which is expected to be XML
11468     produced from a previous run of virt-inspector).  The list of
11469     names and connect URI are ignored in this case.
11470
11471     This function can throw a wide variety of exceptions, for example
11472     if the external virt-inspector program cannot be found, or if
11473     it doesn't generate valid XML.
11474 *)
11475 "
11476
11477 (* Generate ocaml/guestfs_inspector.ml. *)
11478 let generate_ocaml_inspector_ml () =
11479   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11480
11481   pr "open Unix\n";
11482   pr "\n";
11483
11484   generate_types grammar;
11485   pr "\n";
11486
11487   pr "\
11488 (* Misc functions which are used by the parser code below. *)
11489 let first_child = function
11490   | Xml.Element (_, _, c::_) -> c
11491   | Xml.Element (name, _, []) ->
11492       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11493   | Xml.PCData str ->
11494       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11495
11496 let string_child_or_empty = function
11497   | Xml.Element (_, _, [Xml.PCData s]) -> s
11498   | Xml.Element (_, _, []) -> \"\"
11499   | Xml.Element (x, _, _) ->
11500       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11501                 x ^ \" instead\")
11502   | Xml.PCData str ->
11503       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11504
11505 let optional_child name xml =
11506   let children = Xml.children xml in
11507   try
11508     Some (List.find (function
11509                      | Xml.Element (n, _, _) when n = name -> true
11510                      | _ -> false) children)
11511   with
11512     Not_found -> None
11513
11514 let child name xml =
11515   match optional_child name xml with
11516   | Some c -> c
11517   | None ->
11518       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11519
11520 let attribute name xml =
11521   try Xml.attrib xml name
11522   with Xml.No_attribute _ ->
11523     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11524
11525 ";
11526
11527   generate_parsers grammar;
11528   pr "\n";
11529
11530   pr "\
11531 (* Run external virt-inspector, then use parser to parse the XML. *)
11532 let inspect ?connect ?xml names =
11533   let xml =
11534     match xml with
11535     | None ->
11536         if names = [] then invalid_arg \"inspect: no names given\";
11537         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11538           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11539           names in
11540         let cmd = List.map Filename.quote cmd in
11541         let cmd = String.concat \" \" cmd in
11542         let chan = open_process_in cmd in
11543         let xml = Xml.parse_in chan in
11544         (match close_process_in chan with
11545          | WEXITED 0 -> ()
11546          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11547          | WSIGNALED i | WSTOPPED i ->
11548              failwith (\"external virt-inspector command died or stopped on sig \" ^
11549                        string_of_int i)
11550         );
11551         xml
11552     | Some doc ->
11553         Xml.parse_string doc in
11554   parse_operatingsystems xml
11555 "
11556
11557 (* This is used to generate the src/MAX_PROC_NR file which
11558  * contains the maximum procedure number, a surrogate for the
11559  * ABI version number.  See src/Makefile.am for the details.
11560  *)
11561 and generate_max_proc_nr () =
11562   let proc_nrs = List.map (
11563     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11564   ) daemon_functions in
11565
11566   let max_proc_nr = List.fold_left max 0 proc_nrs in
11567
11568   pr "%d\n" max_proc_nr
11569
11570 let output_to filename k =
11571   let filename_new = filename ^ ".new" in
11572   chan := open_out filename_new;
11573   k ();
11574   close_out !chan;
11575   chan := Pervasives.stdout;
11576
11577   (* Is the new file different from the current file? *)
11578   if Sys.file_exists filename && files_equal filename filename_new then
11579     unlink filename_new                 (* same, so skip it *)
11580   else (
11581     (* different, overwrite old one *)
11582     (try chmod filename 0o644 with Unix_error _ -> ());
11583     rename filename_new filename;
11584     chmod filename 0o444;
11585     printf "written %s\n%!" filename;
11586   )
11587
11588 let perror msg = function
11589   | Unix_error (err, _, _) ->
11590       eprintf "%s: %s\n" msg (error_message err)
11591   | exn ->
11592       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11593
11594 (* Main program. *)
11595 let () =
11596   let lock_fd =
11597     try openfile "HACKING" [O_RDWR] 0
11598     with
11599     | Unix_error (ENOENT, _, _) ->
11600         eprintf "\
11601 You are probably running this from the wrong directory.
11602 Run it from the top source directory using the command
11603   src/generator.ml
11604 ";
11605         exit 1
11606     | exn ->
11607         perror "open: HACKING" exn;
11608         exit 1 in
11609
11610   (* Acquire a lock so parallel builds won't try to run the generator
11611    * twice at the same time.  Subsequent builds will wait for the first
11612    * one to finish.  Note the lock is released implicitly when the
11613    * program exits.
11614    *)
11615   (try lockf lock_fd F_LOCK 1
11616    with exn ->
11617      perror "lock: HACKING" exn;
11618      exit 1);
11619
11620   check_functions ();
11621
11622   output_to "src/guestfs_protocol.x" generate_xdr;
11623   output_to "src/guestfs-structs.h" generate_structs_h;
11624   output_to "src/guestfs-actions.h" generate_actions_h;
11625   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11626   output_to "src/guestfs-actions.c" generate_client_actions;
11627   output_to "src/guestfs-bindtests.c" generate_bindtests;
11628   output_to "src/guestfs-structs.pod" generate_structs_pod;
11629   output_to "src/guestfs-actions.pod" generate_actions_pod;
11630   output_to "src/guestfs-availability.pod" generate_availability_pod;
11631   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11632   output_to "src/libguestfs.syms" generate_linker_script;
11633   output_to "daemon/actions.h" generate_daemon_actions_h;
11634   output_to "daemon/stubs.c" generate_daemon_actions;
11635   output_to "daemon/names.c" generate_daemon_names;
11636   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11637   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11638   output_to "capitests/tests.c" generate_tests;
11639   output_to "fish/cmds.c" generate_fish_cmds;
11640   output_to "fish/completion.c" generate_fish_completion;
11641   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11642   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11643   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11644   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11645   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11646   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11647   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11648   output_to "perl/Guestfs.xs" generate_perl_xs;
11649   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11650   output_to "perl/bindtests.pl" generate_perl_bindtests;
11651   output_to "python/guestfs-py.c" generate_python_c;
11652   output_to "python/guestfs.py" generate_python_py;
11653   output_to "python/bindtests.py" generate_python_bindtests;
11654   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11655   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11656   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11657
11658   List.iter (
11659     fun (typ, jtyp) ->
11660       let cols = cols_of_struct typ in
11661       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11662       output_to filename (generate_java_struct jtyp cols);
11663   ) java_structs;
11664
11665   output_to "java/Makefile.inc" generate_java_makefile_inc;
11666   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11667   output_to "java/Bindtests.java" generate_java_bindtests;
11668   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11669   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11670   output_to "csharp/Libguestfs.cs" generate_csharp;
11671
11672   (* Always generate this file last, and unconditionally.  It's used
11673    * by the Makefile to know when we must re-run the generator.
11674    *)
11675   let chan = open_out "src/stamp-generator" in
11676   fprintf chan "1\n";
11677   close_out chan;
11678
11679   printf "generated %d lines of code\n" !lines