generator: Don't hard-code name in DeviceList check.
[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,readonly=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 C<readonly=on> is only added where qemu supports this option.
559
560 Note that this call checks for the existence of C<filename>.  This
561 stops you from specifying other types of drive which are supported
562 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
563 the general C<guestfs_config> call instead.");
564
565   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
566    [],
567    "add qemu parameters",
568    "\
569 This can be used to add arbitrary qemu command line parameters
570 of the form C<-param value>.  Actually it's not quite arbitrary - we
571 prevent you from setting some parameters which would interfere with
572 parameters that we use.
573
574 The first character of C<param> string must be a C<-> (dash).
575
576 C<value> can be NULL.");
577
578   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
579    [],
580    "set the qemu binary",
581    "\
582 Set the qemu binary that we will use.
583
584 The default is chosen when the library was compiled by the
585 configure script.
586
587 You can also override this by setting the C<LIBGUESTFS_QEMU>
588 environment variable.
589
590 Setting C<qemu> to C<NULL> restores the default qemu binary.
591
592 Note that you should call this function as early as possible
593 after creating the handle.  This is because some pre-launch
594 operations depend on testing qemu features (by running C<qemu -help>).
595 If the qemu binary changes, we don't retest features, and
596 so you might see inconsistent results.  Using the environment
597 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
598 the qemu binary at the same time as the handle is created.");
599
600   ("get_qemu", (RConstString "qemu", []), -1, [],
601    [InitNone, Always, TestRun (
602       [["get_qemu"]])],
603    "get the qemu binary",
604    "\
605 Return the current qemu binary.
606
607 This is always non-NULL.  If it wasn't set already, then this will
608 return the default qemu binary name.");
609
610   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
611    [],
612    "set the search path",
613    "\
614 Set the path that libguestfs searches for kernel and initrd.img.
615
616 The default is C<$libdir/guestfs> unless overridden by setting
617 C<LIBGUESTFS_PATH> environment variable.
618
619 Setting C<path> to C<NULL> restores the default path.");
620
621   ("get_path", (RConstString "path", []), -1, [],
622    [InitNone, Always, TestRun (
623       [["get_path"]])],
624    "get the search path",
625    "\
626 Return the current search path.
627
628 This is always non-NULL.  If it wasn't set already, then this will
629 return the default path.");
630
631   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
632    [],
633    "add options to kernel command line",
634    "\
635 This function is used to add additional options to the
636 guest kernel command line.
637
638 The default is C<NULL> unless overridden by setting
639 C<LIBGUESTFS_APPEND> environment variable.
640
641 Setting C<append> to C<NULL> means I<no> additional options
642 are passed (libguestfs always adds a few of its own).");
643
644   ("get_append", (RConstOptString "append", []), -1, [],
645    (* This cannot be tested with the current framework.  The
646     * function can return NULL in normal operations, which the
647     * test framework interprets as an error.
648     *)
649    [],
650    "get the additional kernel options",
651    "\
652 Return the additional kernel options which are added to the
653 guest kernel command line.
654
655 If C<NULL> then no options are added.");
656
657   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
658    [],
659    "set autosync mode",
660    "\
661 If C<autosync> is true, this enables autosync.  Libguestfs will make a
662 best effort attempt to run C<guestfs_umount_all> followed by
663 C<guestfs_sync> when the handle is closed
664 (also if the program exits without closing handles).
665
666 This is disabled by default (except in guestfish where it is
667 enabled by default).");
668
669   ("get_autosync", (RBool "autosync", []), -1, [],
670    [InitNone, Always, TestRun (
671       [["get_autosync"]])],
672    "get autosync mode",
673    "\
674 Get the autosync flag.");
675
676   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
677    [],
678    "set verbose mode",
679    "\
680 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
681
682 Verbose messages are disabled unless the environment variable
683 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
684
685   ("get_verbose", (RBool "verbose", []), -1, [],
686    [],
687    "get verbose mode",
688    "\
689 This returns the verbose messages flag.");
690
691   ("is_ready", (RBool "ready", []), -1, [],
692    [InitNone, Always, TestOutputTrue (
693       [["is_ready"]])],
694    "is ready to accept commands",
695    "\
696 This returns true iff this handle is ready to accept commands
697 (in the C<READY> state).
698
699 For more information on states, see L<guestfs(3)>.");
700
701   ("is_config", (RBool "config", []), -1, [],
702    [InitNone, Always, TestOutputFalse (
703       [["is_config"]])],
704    "is in configuration state",
705    "\
706 This returns true iff this handle is being configured
707 (in the C<CONFIG> state).
708
709 For more information on states, see L<guestfs(3)>.");
710
711   ("is_launching", (RBool "launching", []), -1, [],
712    [InitNone, Always, TestOutputFalse (
713       [["is_launching"]])],
714    "is launching subprocess",
715    "\
716 This returns true iff this handle is launching the subprocess
717 (in the C<LAUNCHING> state).
718
719 For more information on states, see L<guestfs(3)>.");
720
721   ("is_busy", (RBool "busy", []), -1, [],
722    [InitNone, Always, TestOutputFalse (
723       [["is_busy"]])],
724    "is busy processing a command",
725    "\
726 This returns true iff this handle is busy processing a command
727 (in the C<BUSY> state).
728
729 For more information on states, see L<guestfs(3)>.");
730
731   ("get_state", (RInt "state", []), -1, [],
732    [],
733    "get the current state",
734    "\
735 This returns the current state as an opaque integer.  This is
736 only useful for printing debug and internal error messages.
737
738 For more information on states, see L<guestfs(3)>.");
739
740   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
741    [InitNone, Always, TestOutputInt (
742       [["set_memsize"; "500"];
743        ["get_memsize"]], 500)],
744    "set memory allocated to the qemu subprocess",
745    "\
746 This sets the memory size in megabytes allocated to the
747 qemu subprocess.  This only has any effect if called before
748 C<guestfs_launch>.
749
750 You can also change this by setting the environment
751 variable C<LIBGUESTFS_MEMSIZE> before the handle is
752 created.
753
754 For more information on the architecture of libguestfs,
755 see L<guestfs(3)>.");
756
757   ("get_memsize", (RInt "memsize", []), -1, [],
758    [InitNone, Always, TestOutputIntOp (
759       [["get_memsize"]], ">=", 256)],
760    "get memory allocated to the qemu subprocess",
761    "\
762 This gets the memory size in megabytes allocated to the
763 qemu subprocess.
764
765 If C<guestfs_set_memsize> was not called
766 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
767 then this returns the compiled-in default value for memsize.
768
769 For more information on the architecture of libguestfs,
770 see L<guestfs(3)>.");
771
772   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
773    [InitNone, Always, TestOutputIntOp (
774       [["get_pid"]], ">=", 1)],
775    "get PID of qemu subprocess",
776    "\
777 Return the process ID of the qemu subprocess.  If there is no
778 qemu subprocess, then this will return an error.
779
780 This is an internal call used for debugging and testing.");
781
782   ("version", (RStruct ("version", "version"), []), -1, [],
783    [InitNone, Always, TestOutputStruct (
784       [["version"]], [CompareWithInt ("major", 1)])],
785    "get the library version number",
786    "\
787 Return the libguestfs version number that the program is linked
788 against.
789
790 Note that because of dynamic linking this is not necessarily
791 the version of libguestfs that you compiled against.  You can
792 compile the program, and then at runtime dynamically link
793 against a completely different C<libguestfs.so> library.
794
795 This call was added in version C<1.0.58>.  In previous
796 versions of libguestfs there was no way to get the version
797 number.  From C code you can use dynamic linker functions
798 to find out if this symbol exists (if it doesn't, then
799 it's an earlier version).
800
801 The call returns a structure with four elements.  The first
802 three (C<major>, C<minor> and C<release>) are numbers and
803 correspond to the usual version triplet.  The fourth element
804 (C<extra>) is a string and is normally empty, but may be
805 used for distro-specific information.
806
807 To construct the original version string:
808 C<$major.$minor.$release$extra>
809
810 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
811
812 I<Note:> Don't use this call to test for availability
813 of features.  In enterprise distributions we backport
814 features from later versions into earlier versions,
815 making this an unreliable way to test for features.
816 Use C<guestfs_available> instead.");
817
818   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
819    [InitNone, Always, TestOutputTrue (
820       [["set_selinux"; "true"];
821        ["get_selinux"]])],
822    "set SELinux enabled or disabled at appliance boot",
823    "\
824 This sets the selinux flag that is passed to the appliance
825 at boot time.  The default is C<selinux=0> (disabled).
826
827 Note that if SELinux is enabled, it is always in
828 Permissive mode (C<enforcing=0>).
829
830 For more information on the architecture of libguestfs,
831 see L<guestfs(3)>.");
832
833   ("get_selinux", (RBool "selinux", []), -1, [],
834    [],
835    "get SELinux enabled flag",
836    "\
837 This returns the current setting of the selinux flag which
838 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
839
840 For more information on the architecture of libguestfs,
841 see L<guestfs(3)>.");
842
843   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
844    [InitNone, Always, TestOutputFalse (
845       [["set_trace"; "false"];
846        ["get_trace"]])],
847    "enable or disable command traces",
848    "\
849 If the command trace flag is set to 1, then commands are
850 printed on stdout before they are executed in a format
851 which is very similar to the one used by guestfish.  In
852 other words, you can run a program with this enabled, and
853 you will get out a script which you can feed to guestfish
854 to perform the same set of actions.
855
856 If you want to trace C API calls into libguestfs (and
857 other libraries) then possibly a better way is to use
858 the external ltrace(1) command.
859
860 Command traces are disabled unless the environment variable
861 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
862
863   ("get_trace", (RBool "trace", []), -1, [],
864    [],
865    "get command trace enabled flag",
866    "\
867 Return the command trace flag.");
868
869   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
870    [InitNone, Always, TestOutputFalse (
871       [["set_direct"; "false"];
872        ["get_direct"]])],
873    "enable or disable direct appliance mode",
874    "\
875 If the direct appliance mode flag is enabled, then stdin and
876 stdout are passed directly through to the appliance once it
877 is launched.
878
879 One consequence of this is that log messages aren't caught
880 by the library and handled by C<guestfs_set_log_message_callback>,
881 but go straight to stdout.
882
883 You probably don't want to use this unless you know what you
884 are doing.
885
886 The default is disabled.");
887
888   ("get_direct", (RBool "direct", []), -1, [],
889    [],
890    "get direct appliance mode flag",
891    "\
892 Return the direct appliance mode flag.");
893
894   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
895    [InitNone, Always, TestOutputTrue (
896       [["set_recovery_proc"; "true"];
897        ["get_recovery_proc"]])],
898    "enable or disable the recovery process",
899    "\
900 If this is called with the parameter C<false> then
901 C<guestfs_launch> does not create a recovery process.  The
902 purpose of the recovery process is to stop runaway qemu
903 processes in the case where the main program aborts abruptly.
904
905 This only has any effect if called before C<guestfs_launch>,
906 and the default is true.
907
908 About the only time when you would want to disable this is
909 if the main process will fork itself into the background
910 (\"daemonize\" itself).  In this case the recovery process
911 thinks that the main program has disappeared and so kills
912 qemu, which is not very helpful.");
913
914   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
915    [],
916    "get recovery process enabled flag",
917    "\
918 Return the recovery process enabled flag.");
919
920   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
921    [],
922    "add a drive specifying the QEMU block emulation to use",
923    "\
924 This is the same as C<guestfs_add_drive> but it allows you
925 to specify the QEMU interface emulation to use at run time.");
926
927   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
928    [],
929    "add a drive read-only specifying the QEMU block emulation to use",
930    "\
931 This is the same as C<guestfs_add_drive_ro> but it allows you
932 to specify the QEMU interface emulation to use at run time.");
933
934 ]
935
936 (* daemon_functions are any functions which cause some action
937  * to take place in the daemon.
938  *)
939
940 let daemon_functions = [
941   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
942    [InitEmpty, Always, TestOutput (
943       [["part_disk"; "/dev/sda"; "mbr"];
944        ["mkfs"; "ext2"; "/dev/sda1"];
945        ["mount"; "/dev/sda1"; "/"];
946        ["write_file"; "/new"; "new file contents"; "0"];
947        ["cat"; "/new"]], "new file contents")],
948    "mount a guest disk at a position in the filesystem",
949    "\
950 Mount a guest disk at a position in the filesystem.  Block devices
951 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
952 the guest.  If those block devices contain partitions, they will have
953 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
954 names can be used.
955
956 The rules are the same as for L<mount(2)>:  A filesystem must
957 first be mounted on C</> before others can be mounted.  Other
958 filesystems can only be mounted on directories which already
959 exist.
960
961 The mounted filesystem is writable, if we have sufficient permissions
962 on the underlying device.
963
964 B<Important note:>
965 When you use this call, the filesystem options C<sync> and C<noatime>
966 are set implicitly.  This was originally done because we thought it
967 would improve reliability, but it turns out that I<-o sync> has a
968 very large negative performance impact and negligible effect on
969 reliability.  Therefore we recommend that you avoid using
970 C<guestfs_mount> in any code that needs performance, and instead
971 use C<guestfs_mount_options> (use an empty string for the first
972 parameter if you don't want any options).");
973
974   ("sync", (RErr, []), 2, [],
975    [ InitEmpty, Always, TestRun [["sync"]]],
976    "sync disks, writes are flushed through to the disk image",
977    "\
978 This syncs the disk, so that any writes are flushed through to the
979 underlying disk image.
980
981 You should always call this if you have modified a disk image, before
982 closing the handle.");
983
984   ("touch", (RErr, [Pathname "path"]), 3, [],
985    [InitBasicFS, Always, TestOutputTrue (
986       [["touch"; "/new"];
987        ["exists"; "/new"]])],
988    "update file timestamps or create a new file",
989    "\
990 Touch acts like the L<touch(1)> command.  It can be used to
991 update the timestamps on a file, or, if the file does not exist,
992 to create a new zero-length file.");
993
994   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
995    [InitISOFS, Always, TestOutput (
996       [["cat"; "/known-2"]], "abcdef\n")],
997    "list the contents of a file",
998    "\
999 Return the contents of the file named C<path>.
1000
1001 Note that this function cannot correctly handle binary files
1002 (specifically, files containing C<\\0> character which is treated
1003 as end of string).  For those you need to use the C<guestfs_read_file>
1004 or C<guestfs_download> functions which have a more complex interface.");
1005
1006   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1007    [], (* XXX Tricky to test because it depends on the exact format
1008         * of the 'ls -l' command, which changes between F10 and F11.
1009         *)
1010    "list the files in a directory (long format)",
1011    "\
1012 List the files in C<directory> (relative to the root directory,
1013 there is no cwd) in the format of 'ls -la'.
1014
1015 This command is mostly useful for interactive sessions.  It
1016 is I<not> intended that you try to parse the output string.");
1017
1018   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1019    [InitBasicFS, Always, TestOutputList (
1020       [["touch"; "/new"];
1021        ["touch"; "/newer"];
1022        ["touch"; "/newest"];
1023        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1024    "list the files in a directory",
1025    "\
1026 List the files in C<directory> (relative to the root directory,
1027 there is no cwd).  The '.' and '..' entries are not returned, but
1028 hidden files are shown.
1029
1030 This command is mostly useful for interactive sessions.  Programs
1031 should probably use C<guestfs_readdir> instead.");
1032
1033   ("list_devices", (RStringList "devices", []), 7, [],
1034    [InitEmpty, Always, TestOutputListOfDevices (
1035       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1036    "list the block devices",
1037    "\
1038 List all the block devices.
1039
1040 The full block device names are returned, eg. C</dev/sda>");
1041
1042   ("list_partitions", (RStringList "partitions", []), 8, [],
1043    [InitBasicFS, Always, TestOutputListOfDevices (
1044       [["list_partitions"]], ["/dev/sda1"]);
1045     InitEmpty, Always, TestOutputListOfDevices (
1046       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1047        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1048    "list the partitions",
1049    "\
1050 List all the partitions detected on all block devices.
1051
1052 The full partition device names are returned, eg. C</dev/sda1>
1053
1054 This does not return logical volumes.  For that you will need to
1055 call C<guestfs_lvs>.");
1056
1057   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1058    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1059       [["pvs"]], ["/dev/sda1"]);
1060     InitEmpty, Always, TestOutputListOfDevices (
1061       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1062        ["pvcreate"; "/dev/sda1"];
1063        ["pvcreate"; "/dev/sda2"];
1064        ["pvcreate"; "/dev/sda3"];
1065        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1066    "list the LVM physical volumes (PVs)",
1067    "\
1068 List all the physical volumes detected.  This is the equivalent
1069 of the L<pvs(8)> command.
1070
1071 This returns a list of just the device names that contain
1072 PVs (eg. C</dev/sda2>).
1073
1074 See also C<guestfs_pvs_full>.");
1075
1076   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1077    [InitBasicFSonLVM, Always, TestOutputList (
1078       [["vgs"]], ["VG"]);
1079     InitEmpty, Always, TestOutputList (
1080       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1081        ["pvcreate"; "/dev/sda1"];
1082        ["pvcreate"; "/dev/sda2"];
1083        ["pvcreate"; "/dev/sda3"];
1084        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1085        ["vgcreate"; "VG2"; "/dev/sda3"];
1086        ["vgs"]], ["VG1"; "VG2"])],
1087    "list the LVM volume groups (VGs)",
1088    "\
1089 List all the volumes groups detected.  This is the equivalent
1090 of the L<vgs(8)> command.
1091
1092 This returns a list of just the volume group names that were
1093 detected (eg. C<VolGroup00>).
1094
1095 See also C<guestfs_vgs_full>.");
1096
1097   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1098    [InitBasicFSonLVM, Always, TestOutputList (
1099       [["lvs"]], ["/dev/VG/LV"]);
1100     InitEmpty, Always, TestOutputList (
1101       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1102        ["pvcreate"; "/dev/sda1"];
1103        ["pvcreate"; "/dev/sda2"];
1104        ["pvcreate"; "/dev/sda3"];
1105        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1106        ["vgcreate"; "VG2"; "/dev/sda3"];
1107        ["lvcreate"; "LV1"; "VG1"; "50"];
1108        ["lvcreate"; "LV2"; "VG1"; "50"];
1109        ["lvcreate"; "LV3"; "VG2"; "50"];
1110        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1111    "list the LVM logical volumes (LVs)",
1112    "\
1113 List all the logical volumes detected.  This is the equivalent
1114 of the L<lvs(8)> command.
1115
1116 This returns a list of the logical volume device names
1117 (eg. C</dev/VolGroup00/LogVol00>).
1118
1119 See also C<guestfs_lvs_full>.");
1120
1121   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1122    [], (* XXX how to test? *)
1123    "list the LVM physical volumes (PVs)",
1124    "\
1125 List all the physical volumes detected.  This is the equivalent
1126 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1127
1128   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1129    [], (* XXX how to test? *)
1130    "list the LVM volume groups (VGs)",
1131    "\
1132 List all the volumes groups detected.  This is the equivalent
1133 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1134
1135   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1136    [], (* XXX how to test? *)
1137    "list the LVM logical volumes (LVs)",
1138    "\
1139 List all the logical volumes detected.  This is the equivalent
1140 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1141
1142   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1143    [InitISOFS, Always, TestOutputList (
1144       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1145     InitISOFS, Always, TestOutputList (
1146       [["read_lines"; "/empty"]], [])],
1147    "read file as lines",
1148    "\
1149 Return the contents of the file named C<path>.
1150
1151 The file contents are returned as a list of lines.  Trailing
1152 C<LF> and C<CRLF> character sequences are I<not> returned.
1153
1154 Note that this function cannot correctly handle binary files
1155 (specifically, files containing C<\\0> character which is treated
1156 as end of line).  For those you need to use the C<guestfs_read_file>
1157 function which has a more complex interface.");
1158
1159   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1160    [], (* XXX Augeas code needs tests. *)
1161    "create a new Augeas handle",
1162    "\
1163 Create a new Augeas handle for editing configuration files.
1164 If there was any previous Augeas handle associated with this
1165 guestfs session, then it is closed.
1166
1167 You must call this before using any other C<guestfs_aug_*>
1168 commands.
1169
1170 C<root> is the filesystem root.  C<root> must not be NULL,
1171 use C</> instead.
1172
1173 The flags are the same as the flags defined in
1174 E<lt>augeas.hE<gt>, the logical I<or> of the following
1175 integers:
1176
1177 =over 4
1178
1179 =item C<AUG_SAVE_BACKUP> = 1
1180
1181 Keep the original file with a C<.augsave> extension.
1182
1183 =item C<AUG_SAVE_NEWFILE> = 2
1184
1185 Save changes into a file with extension C<.augnew>, and
1186 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1187
1188 =item C<AUG_TYPE_CHECK> = 4
1189
1190 Typecheck lenses (can be expensive).
1191
1192 =item C<AUG_NO_STDINC> = 8
1193
1194 Do not use standard load path for modules.
1195
1196 =item C<AUG_SAVE_NOOP> = 16
1197
1198 Make save a no-op, just record what would have been changed.
1199
1200 =item C<AUG_NO_LOAD> = 32
1201
1202 Do not load the tree in C<guestfs_aug_init>.
1203
1204 =back
1205
1206 To close the handle, you can call C<guestfs_aug_close>.
1207
1208 To find out more about Augeas, see L<http://augeas.net/>.");
1209
1210   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1211    [], (* XXX Augeas code needs tests. *)
1212    "close the current Augeas handle",
1213    "\
1214 Close the current Augeas handle and free up any resources
1215 used by it.  After calling this, you have to call
1216 C<guestfs_aug_init> again before you can use any other
1217 Augeas functions.");
1218
1219   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1220    [], (* XXX Augeas code needs tests. *)
1221    "define an Augeas variable",
1222    "\
1223 Defines an Augeas variable C<name> whose value is the result
1224 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1225 undefined.
1226
1227 On success this returns the number of nodes in C<expr>, or
1228 C<0> if C<expr> evaluates to something which is not a nodeset.");
1229
1230   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1231    [], (* XXX Augeas code needs tests. *)
1232    "define an Augeas node",
1233    "\
1234 Defines a variable C<name> whose value is the result of
1235 evaluating C<expr>.
1236
1237 If C<expr> evaluates to an empty nodeset, a node is created,
1238 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1239 C<name> will be the nodeset containing that single node.
1240
1241 On success this returns a pair containing the
1242 number of nodes in the nodeset, and a boolean flag
1243 if a node was created.");
1244
1245   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1246    [], (* XXX Augeas code needs tests. *)
1247    "look up the value of an Augeas path",
1248    "\
1249 Look up the value associated with C<path>.  If C<path>
1250 matches exactly one node, the C<value> is returned.");
1251
1252   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1253    [], (* XXX Augeas code needs tests. *)
1254    "set Augeas path to value",
1255    "\
1256 Set the value associated with C<path> to C<value>.");
1257
1258   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1259    [], (* XXX Augeas code needs tests. *)
1260    "insert a sibling Augeas node",
1261    "\
1262 Create a new sibling C<label> for C<path>, inserting it into
1263 the tree before or after C<path> (depending on the boolean
1264 flag C<before>).
1265
1266 C<path> must match exactly one existing node in the tree, and
1267 C<label> must be a label, ie. not contain C</>, C<*> or end
1268 with a bracketed index C<[N]>.");
1269
1270   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1271    [], (* XXX Augeas code needs tests. *)
1272    "remove an Augeas path",
1273    "\
1274 Remove C<path> and all of its children.
1275
1276 On success this returns the number of entries which were removed.");
1277
1278   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1279    [], (* XXX Augeas code needs tests. *)
1280    "move Augeas node",
1281    "\
1282 Move the node C<src> to C<dest>.  C<src> must match exactly
1283 one node.  C<dest> is overwritten if it exists.");
1284
1285   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1286    [], (* XXX Augeas code needs tests. *)
1287    "return Augeas nodes which match augpath",
1288    "\
1289 Returns a list of paths which match the path expression C<path>.
1290 The returned paths are sufficiently qualified so that they match
1291 exactly one node in the current tree.");
1292
1293   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1294    [], (* XXX Augeas code needs tests. *)
1295    "write all pending Augeas changes to disk",
1296    "\
1297 This writes all pending changes to disk.
1298
1299 The flags which were passed to C<guestfs_aug_init> affect exactly
1300 how files are saved.");
1301
1302   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1303    [], (* XXX Augeas code needs tests. *)
1304    "load files into the tree",
1305    "\
1306 Load files into the tree.
1307
1308 See C<aug_load> in the Augeas documentation for the full gory
1309 details.");
1310
1311   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1312    [], (* XXX Augeas code needs tests. *)
1313    "list Augeas nodes under augpath",
1314    "\
1315 This is just a shortcut for listing C<guestfs_aug_match>
1316 C<path/*> and sorting the resulting nodes into alphabetical order.");
1317
1318   ("rm", (RErr, [Pathname "path"]), 29, [],
1319    [InitBasicFS, Always, TestRun
1320       [["touch"; "/new"];
1321        ["rm"; "/new"]];
1322     InitBasicFS, Always, TestLastFail
1323       [["rm"; "/new"]];
1324     InitBasicFS, Always, TestLastFail
1325       [["mkdir"; "/new"];
1326        ["rm"; "/new"]]],
1327    "remove a file",
1328    "\
1329 Remove the single file C<path>.");
1330
1331   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1332    [InitBasicFS, Always, TestRun
1333       [["mkdir"; "/new"];
1334        ["rmdir"; "/new"]];
1335     InitBasicFS, Always, TestLastFail
1336       [["rmdir"; "/new"]];
1337     InitBasicFS, Always, TestLastFail
1338       [["touch"; "/new"];
1339        ["rmdir"; "/new"]]],
1340    "remove a directory",
1341    "\
1342 Remove the single directory C<path>.");
1343
1344   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1345    [InitBasicFS, Always, TestOutputFalse
1346       [["mkdir"; "/new"];
1347        ["mkdir"; "/new/foo"];
1348        ["touch"; "/new/foo/bar"];
1349        ["rm_rf"; "/new"];
1350        ["exists"; "/new"]]],
1351    "remove a file or directory recursively",
1352    "\
1353 Remove the file or directory C<path>, recursively removing the
1354 contents if its a directory.  This is like the C<rm -rf> shell
1355 command.");
1356
1357   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1358    [InitBasicFS, Always, TestOutputTrue
1359       [["mkdir"; "/new"];
1360        ["is_dir"; "/new"]];
1361     InitBasicFS, Always, TestLastFail
1362       [["mkdir"; "/new/foo/bar"]]],
1363    "create a directory",
1364    "\
1365 Create a directory named C<path>.");
1366
1367   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1368    [InitBasicFS, Always, TestOutputTrue
1369       [["mkdir_p"; "/new/foo/bar"];
1370        ["is_dir"; "/new/foo/bar"]];
1371     InitBasicFS, Always, TestOutputTrue
1372       [["mkdir_p"; "/new/foo/bar"];
1373        ["is_dir"; "/new/foo"]];
1374     InitBasicFS, Always, TestOutputTrue
1375       [["mkdir_p"; "/new/foo/bar"];
1376        ["is_dir"; "/new"]];
1377     (* Regression tests for RHBZ#503133: *)
1378     InitBasicFS, Always, TestRun
1379       [["mkdir"; "/new"];
1380        ["mkdir_p"; "/new"]];
1381     InitBasicFS, Always, TestLastFail
1382       [["touch"; "/new"];
1383        ["mkdir_p"; "/new"]]],
1384    "create a directory and parents",
1385    "\
1386 Create a directory named C<path>, creating any parent directories
1387 as necessary.  This is like the C<mkdir -p> shell command.");
1388
1389   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1390    [], (* XXX Need stat command to test *)
1391    "change file mode",
1392    "\
1393 Change the mode (permissions) of C<path> to C<mode>.  Only
1394 numeric modes are supported.
1395
1396 I<Note>: When using this command from guestfish, C<mode>
1397 by default would be decimal, unless you prefix it with
1398 C<0> to get octal, ie. use C<0700> not C<700>.
1399
1400 The mode actually set is affected by the umask.");
1401
1402   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1403    [], (* XXX Need stat command to test *)
1404    "change file owner and group",
1405    "\
1406 Change the file owner to C<owner> and group to C<group>.
1407
1408 Only numeric uid and gid are supported.  If you want to use
1409 names, you will need to locate and parse the password file
1410 yourself (Augeas support makes this relatively easy).");
1411
1412   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1413    [InitISOFS, Always, TestOutputTrue (
1414       [["exists"; "/empty"]]);
1415     InitISOFS, Always, TestOutputTrue (
1416       [["exists"; "/directory"]])],
1417    "test if file or directory exists",
1418    "\
1419 This returns C<true> if and only if there is a file, directory
1420 (or anything) with the given C<path> name.
1421
1422 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1423
1424   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1425    [InitISOFS, Always, TestOutputTrue (
1426       [["is_file"; "/known-1"]]);
1427     InitISOFS, Always, TestOutputFalse (
1428       [["is_file"; "/directory"]])],
1429    "test if file exists",
1430    "\
1431 This returns C<true> if and only if there is a file
1432 with the given C<path> name.  Note that it returns false for
1433 other objects like directories.
1434
1435 See also C<guestfs_stat>.");
1436
1437   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1438    [InitISOFS, Always, TestOutputFalse (
1439       [["is_dir"; "/known-3"]]);
1440     InitISOFS, Always, TestOutputTrue (
1441       [["is_dir"; "/directory"]])],
1442    "test if file exists",
1443    "\
1444 This returns C<true> if and only if there is a directory
1445 with the given C<path> name.  Note that it returns false for
1446 other objects like files.
1447
1448 See also C<guestfs_stat>.");
1449
1450   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1451    [InitEmpty, Always, TestOutputListOfDevices (
1452       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1453        ["pvcreate"; "/dev/sda1"];
1454        ["pvcreate"; "/dev/sda2"];
1455        ["pvcreate"; "/dev/sda3"];
1456        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1457    "create an LVM physical volume",
1458    "\
1459 This creates an LVM physical volume on the named C<device>,
1460 where C<device> should usually be a partition name such
1461 as C</dev/sda1>.");
1462
1463   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1464    [InitEmpty, Always, TestOutputList (
1465       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1466        ["pvcreate"; "/dev/sda1"];
1467        ["pvcreate"; "/dev/sda2"];
1468        ["pvcreate"; "/dev/sda3"];
1469        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1470        ["vgcreate"; "VG2"; "/dev/sda3"];
1471        ["vgs"]], ["VG1"; "VG2"])],
1472    "create an LVM volume group",
1473    "\
1474 This creates an LVM volume group called C<volgroup>
1475 from the non-empty list of physical volumes C<physvols>.");
1476
1477   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1478    [InitEmpty, Always, TestOutputList (
1479       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1480        ["pvcreate"; "/dev/sda1"];
1481        ["pvcreate"; "/dev/sda2"];
1482        ["pvcreate"; "/dev/sda3"];
1483        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1484        ["vgcreate"; "VG2"; "/dev/sda3"];
1485        ["lvcreate"; "LV1"; "VG1"; "50"];
1486        ["lvcreate"; "LV2"; "VG1"; "50"];
1487        ["lvcreate"; "LV3"; "VG2"; "50"];
1488        ["lvcreate"; "LV4"; "VG2"; "50"];
1489        ["lvcreate"; "LV5"; "VG2"; "50"];
1490        ["lvs"]],
1491       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1492        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1493    "create an LVM logical volume",
1494    "\
1495 This creates an LVM logical volume called C<logvol>
1496 on the volume group C<volgroup>, with C<size> megabytes.");
1497
1498   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1499    [InitEmpty, Always, TestOutput (
1500       [["part_disk"; "/dev/sda"; "mbr"];
1501        ["mkfs"; "ext2"; "/dev/sda1"];
1502        ["mount_options"; ""; "/dev/sda1"; "/"];
1503        ["write_file"; "/new"; "new file contents"; "0"];
1504        ["cat"; "/new"]], "new file contents")],
1505    "make a filesystem",
1506    "\
1507 This creates a filesystem on C<device> (usually a partition
1508 or LVM logical volume).  The filesystem type is C<fstype>, for
1509 example C<ext3>.");
1510
1511   ("sfdisk", (RErr, [Device "device";
1512                      Int "cyls"; Int "heads"; Int "sectors";
1513                      StringList "lines"]), 43, [DangerWillRobinson],
1514    [],
1515    "create partitions on a block device",
1516    "\
1517 This is a direct interface to the L<sfdisk(8)> program for creating
1518 partitions on block devices.
1519
1520 C<device> should be a block device, for example C</dev/sda>.
1521
1522 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1523 and sectors on the device, which are passed directly to sfdisk as
1524 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1525 of these, then the corresponding parameter is omitted.  Usually for
1526 'large' disks, you can just pass C<0> for these, but for small
1527 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1528 out the right geometry and you will need to tell it.
1529
1530 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1531 information refer to the L<sfdisk(8)> manpage.
1532
1533 To create a single partition occupying the whole disk, you would
1534 pass C<lines> as a single element list, when the single element being
1535 the string C<,> (comma).
1536
1537 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1538 C<guestfs_part_init>");
1539
1540   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1541    [InitBasicFS, Always, TestOutput (
1542       [["write_file"; "/new"; "new file contents"; "0"];
1543        ["cat"; "/new"]], "new file contents");
1544     InitBasicFS, Always, TestOutput (
1545       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1546        ["cat"; "/new"]], "\nnew file contents\n");
1547     InitBasicFS, Always, TestOutput (
1548       [["write_file"; "/new"; "\n\n"; "0"];
1549        ["cat"; "/new"]], "\n\n");
1550     InitBasicFS, Always, TestOutput (
1551       [["write_file"; "/new"; ""; "0"];
1552        ["cat"; "/new"]], "");
1553     InitBasicFS, Always, TestOutput (
1554       [["write_file"; "/new"; "\n\n\n"; "0"];
1555        ["cat"; "/new"]], "\n\n\n");
1556     InitBasicFS, Always, TestOutput (
1557       [["write_file"; "/new"; "\n"; "0"];
1558        ["cat"; "/new"]], "\n");
1559     (* Regression test for RHBZ#597135. *)
1560     InitBasicFS, Always, TestLastFail
1561       [["write_file"; "/new"; "abc"; "10000"]]],
1562    "create a file",
1563    "\
1564 This call creates a file called C<path>.  The contents of the
1565 file is the string C<content> (which can contain any 8 bit data),
1566 with length C<size>.
1567
1568 As a special case, if C<size> is C<0>
1569 then the length is calculated using C<strlen> (so in this case
1570 the content cannot contain embedded ASCII NULs).
1571
1572 I<NB.> Owing to a bug, writing content containing ASCII NUL
1573 characters does I<not> work, even if the length is specified.
1574 We hope to resolve this bug in a future version.  In the meantime
1575 use C<guestfs_upload>.");
1576
1577   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1578    [InitEmpty, Always, TestOutputListOfDevices (
1579       [["part_disk"; "/dev/sda"; "mbr"];
1580        ["mkfs"; "ext2"; "/dev/sda1"];
1581        ["mount_options"; ""; "/dev/sda1"; "/"];
1582        ["mounts"]], ["/dev/sda1"]);
1583     InitEmpty, Always, TestOutputList (
1584       [["part_disk"; "/dev/sda"; "mbr"];
1585        ["mkfs"; "ext2"; "/dev/sda1"];
1586        ["mount_options"; ""; "/dev/sda1"; "/"];
1587        ["umount"; "/"];
1588        ["mounts"]], [])],
1589    "unmount a filesystem",
1590    "\
1591 This unmounts the given filesystem.  The filesystem may be
1592 specified either by its mountpoint (path) or the device which
1593 contains the filesystem.");
1594
1595   ("mounts", (RStringList "devices", []), 46, [],
1596    [InitBasicFS, Always, TestOutputListOfDevices (
1597       [["mounts"]], ["/dev/sda1"])],
1598    "show mounted filesystems",
1599    "\
1600 This returns the list of currently mounted filesystems.  It returns
1601 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1602
1603 Some internal mounts are not shown.
1604
1605 See also: C<guestfs_mountpoints>");
1606
1607   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1608    [InitBasicFS, Always, TestOutputList (
1609       [["umount_all"];
1610        ["mounts"]], []);
1611     (* check that umount_all can unmount nested mounts correctly: *)
1612     InitEmpty, Always, TestOutputList (
1613       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1614        ["mkfs"; "ext2"; "/dev/sda1"];
1615        ["mkfs"; "ext2"; "/dev/sda2"];
1616        ["mkfs"; "ext2"; "/dev/sda3"];
1617        ["mount_options"; ""; "/dev/sda1"; "/"];
1618        ["mkdir"; "/mp1"];
1619        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1620        ["mkdir"; "/mp1/mp2"];
1621        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1622        ["mkdir"; "/mp1/mp2/mp3"];
1623        ["umount_all"];
1624        ["mounts"]], [])],
1625    "unmount all filesystems",
1626    "\
1627 This unmounts all mounted filesystems.
1628
1629 Some internal mounts are not unmounted by this call.");
1630
1631   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1632    [],
1633    "remove all LVM LVs, VGs and PVs",
1634    "\
1635 This command removes all LVM logical volumes, volume groups
1636 and physical volumes.");
1637
1638   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1639    [InitISOFS, Always, TestOutput (
1640       [["file"; "/empty"]], "empty");
1641     InitISOFS, Always, TestOutput (
1642       [["file"; "/known-1"]], "ASCII text");
1643     InitISOFS, Always, TestLastFail (
1644       [["file"; "/notexists"]])],
1645    "determine file type",
1646    "\
1647 This call uses the standard L<file(1)> command to determine
1648 the type or contents of the file.  This also works on devices,
1649 for example to find out whether a partition contains a filesystem.
1650
1651 This call will also transparently look inside various types
1652 of compressed file.
1653
1654 The exact command which runs is C<file -zbsL path>.  Note in
1655 particular that the filename is not prepended to the output
1656 (the C<-b> option).");
1657
1658   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1659    [InitBasicFS, Always, TestOutput (
1660       [["upload"; "test-command"; "/test-command"];
1661        ["chmod"; "0o755"; "/test-command"];
1662        ["command"; "/test-command 1"]], "Result1");
1663     InitBasicFS, Always, TestOutput (
1664       [["upload"; "test-command"; "/test-command"];
1665        ["chmod"; "0o755"; "/test-command"];
1666        ["command"; "/test-command 2"]], "Result2\n");
1667     InitBasicFS, Always, TestOutput (
1668       [["upload"; "test-command"; "/test-command"];
1669        ["chmod"; "0o755"; "/test-command"];
1670        ["command"; "/test-command 3"]], "\nResult3");
1671     InitBasicFS, Always, TestOutput (
1672       [["upload"; "test-command"; "/test-command"];
1673        ["chmod"; "0o755"; "/test-command"];
1674        ["command"; "/test-command 4"]], "\nResult4\n");
1675     InitBasicFS, Always, TestOutput (
1676       [["upload"; "test-command"; "/test-command"];
1677        ["chmod"; "0o755"; "/test-command"];
1678        ["command"; "/test-command 5"]], "\nResult5\n\n");
1679     InitBasicFS, Always, TestOutput (
1680       [["upload"; "test-command"; "/test-command"];
1681        ["chmod"; "0o755"; "/test-command"];
1682        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1683     InitBasicFS, Always, TestOutput (
1684       [["upload"; "test-command"; "/test-command"];
1685        ["chmod"; "0o755"; "/test-command"];
1686        ["command"; "/test-command 7"]], "");
1687     InitBasicFS, Always, TestOutput (
1688       [["upload"; "test-command"; "/test-command"];
1689        ["chmod"; "0o755"; "/test-command"];
1690        ["command"; "/test-command 8"]], "\n");
1691     InitBasicFS, Always, TestOutput (
1692       [["upload"; "test-command"; "/test-command"];
1693        ["chmod"; "0o755"; "/test-command"];
1694        ["command"; "/test-command 9"]], "\n\n");
1695     InitBasicFS, Always, TestOutput (
1696       [["upload"; "test-command"; "/test-command"];
1697        ["chmod"; "0o755"; "/test-command"];
1698        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1699     InitBasicFS, Always, TestOutput (
1700       [["upload"; "test-command"; "/test-command"];
1701        ["chmod"; "0o755"; "/test-command"];
1702        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1703     InitBasicFS, Always, TestLastFail (
1704       [["upload"; "test-command"; "/test-command"];
1705        ["chmod"; "0o755"; "/test-command"];
1706        ["command"; "/test-command"]])],
1707    "run a command from the guest filesystem",
1708    "\
1709 This call runs a command from the guest filesystem.  The
1710 filesystem must be mounted, and must contain a compatible
1711 operating system (ie. something Linux, with the same
1712 or compatible processor architecture).
1713
1714 The single parameter is an argv-style list of arguments.
1715 The first element is the name of the program to run.
1716 Subsequent elements are parameters.  The list must be
1717 non-empty (ie. must contain a program name).  Note that
1718 the command runs directly, and is I<not> invoked via
1719 the shell (see C<guestfs_sh>).
1720
1721 The return value is anything printed to I<stdout> by
1722 the command.
1723
1724 If the command returns a non-zero exit status, then
1725 this function returns an error message.  The error message
1726 string is the content of I<stderr> from the command.
1727
1728 The C<$PATH> environment variable will contain at least
1729 C</usr/bin> and C</bin>.  If you require a program from
1730 another location, you should provide the full path in the
1731 first parameter.
1732
1733 Shared libraries and data files required by the program
1734 must be available on filesystems which are mounted in the
1735 correct places.  It is the caller's responsibility to ensure
1736 all filesystems that are needed are mounted at the right
1737 locations.");
1738
1739   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1740    [InitBasicFS, Always, TestOutputList (
1741       [["upload"; "test-command"; "/test-command"];
1742        ["chmod"; "0o755"; "/test-command"];
1743        ["command_lines"; "/test-command 1"]], ["Result1"]);
1744     InitBasicFS, Always, TestOutputList (
1745       [["upload"; "test-command"; "/test-command"];
1746        ["chmod"; "0o755"; "/test-command"];
1747        ["command_lines"; "/test-command 2"]], ["Result2"]);
1748     InitBasicFS, Always, TestOutputList (
1749       [["upload"; "test-command"; "/test-command"];
1750        ["chmod"; "0o755"; "/test-command"];
1751        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1752     InitBasicFS, Always, TestOutputList (
1753       [["upload"; "test-command"; "/test-command"];
1754        ["chmod"; "0o755"; "/test-command"];
1755        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1756     InitBasicFS, Always, TestOutputList (
1757       [["upload"; "test-command"; "/test-command"];
1758        ["chmod"; "0o755"; "/test-command"];
1759        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1760     InitBasicFS, Always, TestOutputList (
1761       [["upload"; "test-command"; "/test-command"];
1762        ["chmod"; "0o755"; "/test-command"];
1763        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1764     InitBasicFS, Always, TestOutputList (
1765       [["upload"; "test-command"; "/test-command"];
1766        ["chmod"; "0o755"; "/test-command"];
1767        ["command_lines"; "/test-command 7"]], []);
1768     InitBasicFS, Always, TestOutputList (
1769       [["upload"; "test-command"; "/test-command"];
1770        ["chmod"; "0o755"; "/test-command"];
1771        ["command_lines"; "/test-command 8"]], [""]);
1772     InitBasicFS, Always, TestOutputList (
1773       [["upload"; "test-command"; "/test-command"];
1774        ["chmod"; "0o755"; "/test-command"];
1775        ["command_lines"; "/test-command 9"]], ["";""]);
1776     InitBasicFS, Always, TestOutputList (
1777       [["upload"; "test-command"; "/test-command"];
1778        ["chmod"; "0o755"; "/test-command"];
1779        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1780     InitBasicFS, Always, TestOutputList (
1781       [["upload"; "test-command"; "/test-command"];
1782        ["chmod"; "0o755"; "/test-command"];
1783        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1784    "run a command, returning lines",
1785    "\
1786 This is the same as C<guestfs_command>, but splits the
1787 result into a list of lines.
1788
1789 See also: C<guestfs_sh_lines>");
1790
1791   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1792    [InitISOFS, Always, TestOutputStruct (
1793       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1794    "get file information",
1795    "\
1796 Returns file information for the given C<path>.
1797
1798 This is the same as the C<stat(2)> system call.");
1799
1800   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1801    [InitISOFS, Always, TestOutputStruct (
1802       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1803    "get file information for a symbolic link",
1804    "\
1805 Returns file information for the given C<path>.
1806
1807 This is the same as C<guestfs_stat> except that if C<path>
1808 is a symbolic link, then the link is stat-ed, not the file it
1809 refers to.
1810
1811 This is the same as the C<lstat(2)> system call.");
1812
1813   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1814    [InitISOFS, Always, TestOutputStruct (
1815       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1816    "get file system statistics",
1817    "\
1818 Returns file system statistics for any mounted file system.
1819 C<path> should be a file or directory in the mounted file system
1820 (typically it is the mount point itself, but it doesn't need to be).
1821
1822 This is the same as the C<statvfs(2)> system call.");
1823
1824   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1825    [], (* XXX test *)
1826    "get ext2/ext3/ext4 superblock details",
1827    "\
1828 This returns the contents of the ext2, ext3 or ext4 filesystem
1829 superblock on C<device>.
1830
1831 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1832 manpage for more details.  The list of fields returned isn't
1833 clearly defined, and depends on both the version of C<tune2fs>
1834 that libguestfs was built against, and the filesystem itself.");
1835
1836   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1837    [InitEmpty, Always, TestOutputTrue (
1838       [["blockdev_setro"; "/dev/sda"];
1839        ["blockdev_getro"; "/dev/sda"]])],
1840    "set block device to read-only",
1841    "\
1842 Sets the block device named C<device> to read-only.
1843
1844 This uses the L<blockdev(8)> command.");
1845
1846   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1847    [InitEmpty, Always, TestOutputFalse (
1848       [["blockdev_setrw"; "/dev/sda"];
1849        ["blockdev_getro"; "/dev/sda"]])],
1850    "set block device to read-write",
1851    "\
1852 Sets the block device named C<device> to read-write.
1853
1854 This uses the L<blockdev(8)> command.");
1855
1856   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1857    [InitEmpty, Always, TestOutputTrue (
1858       [["blockdev_setro"; "/dev/sda"];
1859        ["blockdev_getro"; "/dev/sda"]])],
1860    "is block device set to read-only",
1861    "\
1862 Returns a boolean indicating if the block device is read-only
1863 (true if read-only, false if not).
1864
1865 This uses the L<blockdev(8)> command.");
1866
1867   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1868    [InitEmpty, Always, TestOutputInt (
1869       [["blockdev_getss"; "/dev/sda"]], 512)],
1870    "get sectorsize of block device",
1871    "\
1872 This returns the size of sectors on a block device.
1873 Usually 512, but can be larger for modern devices.
1874
1875 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1876 for that).
1877
1878 This uses the L<blockdev(8)> command.");
1879
1880   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1881    [InitEmpty, Always, TestOutputInt (
1882       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1883    "get blocksize of block device",
1884    "\
1885 This returns the block size of a device.
1886
1887 (Note this is different from both I<size in blocks> and
1888 I<filesystem block size>).
1889
1890 This uses the L<blockdev(8)> command.");
1891
1892   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1893    [], (* XXX test *)
1894    "set blocksize of block device",
1895    "\
1896 This sets the block size of a device.
1897
1898 (Note this is different from both I<size in blocks> and
1899 I<filesystem block size>).
1900
1901 This uses the L<blockdev(8)> command.");
1902
1903   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1904    [InitEmpty, Always, TestOutputInt (
1905       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1906    "get total size of device in 512-byte sectors",
1907    "\
1908 This returns the size of the device in units of 512-byte sectors
1909 (even if the sectorsize isn't 512 bytes ... weird).
1910
1911 See also C<guestfs_blockdev_getss> for the real sector size of
1912 the device, and C<guestfs_blockdev_getsize64> for the more
1913 useful I<size in bytes>.
1914
1915 This uses the L<blockdev(8)> command.");
1916
1917   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1918    [InitEmpty, Always, TestOutputInt (
1919       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1920    "get total size of device in bytes",
1921    "\
1922 This returns the size of the device in bytes.
1923
1924 See also C<guestfs_blockdev_getsz>.
1925
1926 This uses the L<blockdev(8)> command.");
1927
1928   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1929    [InitEmpty, Always, TestRun
1930       [["blockdev_flushbufs"; "/dev/sda"]]],
1931    "flush device buffers",
1932    "\
1933 This tells the kernel to flush internal buffers associated
1934 with C<device>.
1935
1936 This uses the L<blockdev(8)> command.");
1937
1938   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1939    [InitEmpty, Always, TestRun
1940       [["blockdev_rereadpt"; "/dev/sda"]]],
1941    "reread partition table",
1942    "\
1943 Reread the partition table on C<device>.
1944
1945 This uses the L<blockdev(8)> command.");
1946
1947   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1948    [InitBasicFS, Always, TestOutput (
1949       (* Pick a file from cwd which isn't likely to change. *)
1950       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1951        ["checksum"; "md5"; "/COPYING.LIB"]],
1952       Digest.to_hex (Digest.file "COPYING.LIB"))],
1953    "upload a file from the local machine",
1954    "\
1955 Upload local file C<filename> to C<remotefilename> on the
1956 filesystem.
1957
1958 C<filename> can also be a named pipe.
1959
1960 See also C<guestfs_download>.");
1961
1962   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1963    [InitBasicFS, Always, TestOutput (
1964       (* Pick a file from cwd which isn't likely to change. *)
1965       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1966        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1967        ["upload"; "testdownload.tmp"; "/upload"];
1968        ["checksum"; "md5"; "/upload"]],
1969       Digest.to_hex (Digest.file "COPYING.LIB"))],
1970    "download a file to the local machine",
1971    "\
1972 Download file C<remotefilename> and save it as C<filename>
1973 on the local machine.
1974
1975 C<filename> can also be a named pipe.
1976
1977 See also C<guestfs_upload>, C<guestfs_cat>.");
1978
1979   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1980    [InitISOFS, Always, TestOutput (
1981       [["checksum"; "crc"; "/known-3"]], "2891671662");
1982     InitISOFS, Always, TestLastFail (
1983       [["checksum"; "crc"; "/notexists"]]);
1984     InitISOFS, Always, TestOutput (
1985       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1986     InitISOFS, Always, TestOutput (
1987       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1988     InitISOFS, Always, TestOutput (
1989       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1990     InitISOFS, Always, TestOutput (
1991       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1992     InitISOFS, Always, TestOutput (
1993       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1994     InitISOFS, Always, TestOutput (
1995       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1996    "compute MD5, SHAx or CRC checksum of file",
1997    "\
1998 This call computes the MD5, SHAx or CRC checksum of the
1999 file named C<path>.
2000
2001 The type of checksum to compute is given by the C<csumtype>
2002 parameter which must have one of the following values:
2003
2004 =over 4
2005
2006 =item C<crc>
2007
2008 Compute the cyclic redundancy check (CRC) specified by POSIX
2009 for the C<cksum> command.
2010
2011 =item C<md5>
2012
2013 Compute the MD5 hash (using the C<md5sum> program).
2014
2015 =item C<sha1>
2016
2017 Compute the SHA1 hash (using the C<sha1sum> program).
2018
2019 =item C<sha224>
2020
2021 Compute the SHA224 hash (using the C<sha224sum> program).
2022
2023 =item C<sha256>
2024
2025 Compute the SHA256 hash (using the C<sha256sum> program).
2026
2027 =item C<sha384>
2028
2029 Compute the SHA384 hash (using the C<sha384sum> program).
2030
2031 =item C<sha512>
2032
2033 Compute the SHA512 hash (using the C<sha512sum> program).
2034
2035 =back
2036
2037 The checksum is returned as a printable string.");
2038
2039   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2040    [InitBasicFS, Always, TestOutput (
2041       [["tar_in"; "../images/helloworld.tar"; "/"];
2042        ["cat"; "/hello"]], "hello\n")],
2043    "unpack tarfile to directory",
2044    "\
2045 This command uploads and unpacks local file C<tarfile> (an
2046 I<uncompressed> tar file) into C<directory>.
2047
2048 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2049
2050   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2051    [],
2052    "pack directory into tarfile",
2053    "\
2054 This command packs the contents of C<directory> and downloads
2055 it to local file C<tarfile>.
2056
2057 To download a compressed tarball, use C<guestfs_tgz_out>.");
2058
2059   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2060    [InitBasicFS, Always, TestOutput (
2061       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2062        ["cat"; "/hello"]], "hello\n")],
2063    "unpack compressed tarball to directory",
2064    "\
2065 This command uploads and unpacks local file C<tarball> (a
2066 I<gzip compressed> tar file) into C<directory>.
2067
2068 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2069
2070   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2071    [],
2072    "pack directory into compressed tarball",
2073    "\
2074 This command packs the contents of C<directory> and downloads
2075 it to local file C<tarball>.
2076
2077 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2078
2079   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2080    [InitBasicFS, Always, TestLastFail (
2081       [["umount"; "/"];
2082        ["mount_ro"; "/dev/sda1"; "/"];
2083        ["touch"; "/new"]]);
2084     InitBasicFS, Always, TestOutput (
2085       [["write_file"; "/new"; "data"; "0"];
2086        ["umount"; "/"];
2087        ["mount_ro"; "/dev/sda1"; "/"];
2088        ["cat"; "/new"]], "data")],
2089    "mount a guest disk, read-only",
2090    "\
2091 This is the same as the C<guestfs_mount> command, but it
2092 mounts the filesystem with the read-only (I<-o ro>) flag.");
2093
2094   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2095    [],
2096    "mount a guest disk with mount options",
2097    "\
2098 This is the same as the C<guestfs_mount> command, but it
2099 allows you to set the mount options as for the
2100 L<mount(8)> I<-o> flag.
2101
2102 If the C<options> parameter is an empty string, then
2103 no options are passed (all options default to whatever
2104 the filesystem uses).");
2105
2106   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2107    [],
2108    "mount a guest disk with mount options and vfstype",
2109    "\
2110 This is the same as the C<guestfs_mount> command, but it
2111 allows you to set both the mount options and the vfstype
2112 as for the L<mount(8)> I<-o> and I<-t> flags.");
2113
2114   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2115    [],
2116    "debugging and internals",
2117    "\
2118 The C<guestfs_debug> command exposes some internals of
2119 C<guestfsd> (the guestfs daemon) that runs inside the
2120 qemu subprocess.
2121
2122 There is no comprehensive help for this command.  You have
2123 to look at the file C<daemon/debug.c> in the libguestfs source
2124 to find out what you can do.");
2125
2126   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2127    [InitEmpty, Always, TestOutputList (
2128       [["part_disk"; "/dev/sda"; "mbr"];
2129        ["pvcreate"; "/dev/sda1"];
2130        ["vgcreate"; "VG"; "/dev/sda1"];
2131        ["lvcreate"; "LV1"; "VG"; "50"];
2132        ["lvcreate"; "LV2"; "VG"; "50"];
2133        ["lvremove"; "/dev/VG/LV1"];
2134        ["lvs"]], ["/dev/VG/LV2"]);
2135     InitEmpty, Always, TestOutputList (
2136       [["part_disk"; "/dev/sda"; "mbr"];
2137        ["pvcreate"; "/dev/sda1"];
2138        ["vgcreate"; "VG"; "/dev/sda1"];
2139        ["lvcreate"; "LV1"; "VG"; "50"];
2140        ["lvcreate"; "LV2"; "VG"; "50"];
2141        ["lvremove"; "/dev/VG"];
2142        ["lvs"]], []);
2143     InitEmpty, Always, TestOutputList (
2144       [["part_disk"; "/dev/sda"; "mbr"];
2145        ["pvcreate"; "/dev/sda1"];
2146        ["vgcreate"; "VG"; "/dev/sda1"];
2147        ["lvcreate"; "LV1"; "VG"; "50"];
2148        ["lvcreate"; "LV2"; "VG"; "50"];
2149        ["lvremove"; "/dev/VG"];
2150        ["vgs"]], ["VG"])],
2151    "remove an LVM logical volume",
2152    "\
2153 Remove an LVM logical volume C<device>, where C<device> is
2154 the path to the LV, such as C</dev/VG/LV>.
2155
2156 You can also remove all LVs in a volume group by specifying
2157 the VG name, C</dev/VG>.");
2158
2159   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2160    [InitEmpty, Always, TestOutputList (
2161       [["part_disk"; "/dev/sda"; "mbr"];
2162        ["pvcreate"; "/dev/sda1"];
2163        ["vgcreate"; "VG"; "/dev/sda1"];
2164        ["lvcreate"; "LV1"; "VG"; "50"];
2165        ["lvcreate"; "LV2"; "VG"; "50"];
2166        ["vgremove"; "VG"];
2167        ["lvs"]], []);
2168     InitEmpty, Always, TestOutputList (
2169       [["part_disk"; "/dev/sda"; "mbr"];
2170        ["pvcreate"; "/dev/sda1"];
2171        ["vgcreate"; "VG"; "/dev/sda1"];
2172        ["lvcreate"; "LV1"; "VG"; "50"];
2173        ["lvcreate"; "LV2"; "VG"; "50"];
2174        ["vgremove"; "VG"];
2175        ["vgs"]], [])],
2176    "remove an LVM volume group",
2177    "\
2178 Remove an LVM volume group C<vgname>, (for example C<VG>).
2179
2180 This also forcibly removes all logical volumes in the volume
2181 group (if any).");
2182
2183   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2184    [InitEmpty, Always, TestOutputListOfDevices (
2185       [["part_disk"; "/dev/sda"; "mbr"];
2186        ["pvcreate"; "/dev/sda1"];
2187        ["vgcreate"; "VG"; "/dev/sda1"];
2188        ["lvcreate"; "LV1"; "VG"; "50"];
2189        ["lvcreate"; "LV2"; "VG"; "50"];
2190        ["vgremove"; "VG"];
2191        ["pvremove"; "/dev/sda1"];
2192        ["lvs"]], []);
2193     InitEmpty, Always, TestOutputListOfDevices (
2194       [["part_disk"; "/dev/sda"; "mbr"];
2195        ["pvcreate"; "/dev/sda1"];
2196        ["vgcreate"; "VG"; "/dev/sda1"];
2197        ["lvcreate"; "LV1"; "VG"; "50"];
2198        ["lvcreate"; "LV2"; "VG"; "50"];
2199        ["vgremove"; "VG"];
2200        ["pvremove"; "/dev/sda1"];
2201        ["vgs"]], []);
2202     InitEmpty, Always, TestOutputListOfDevices (
2203       [["part_disk"; "/dev/sda"; "mbr"];
2204        ["pvcreate"; "/dev/sda1"];
2205        ["vgcreate"; "VG"; "/dev/sda1"];
2206        ["lvcreate"; "LV1"; "VG"; "50"];
2207        ["lvcreate"; "LV2"; "VG"; "50"];
2208        ["vgremove"; "VG"];
2209        ["pvremove"; "/dev/sda1"];
2210        ["pvs"]], [])],
2211    "remove an LVM physical volume",
2212    "\
2213 This wipes a physical volume C<device> so that LVM will no longer
2214 recognise it.
2215
2216 The implementation uses the C<pvremove> command which refuses to
2217 wipe physical volumes that contain any volume groups, so you have
2218 to remove those first.");
2219
2220   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2221    [InitBasicFS, Always, TestOutput (
2222       [["set_e2label"; "/dev/sda1"; "testlabel"];
2223        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2224    "set the ext2/3/4 filesystem label",
2225    "\
2226 This sets the ext2/3/4 filesystem label of the filesystem on
2227 C<device> to C<label>.  Filesystem labels are limited to
2228 16 characters.
2229
2230 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2231 to return the existing label on a filesystem.");
2232
2233   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2234    [],
2235    "get the ext2/3/4 filesystem label",
2236    "\
2237 This returns the ext2/3/4 filesystem label of the filesystem on
2238 C<device>.");
2239
2240   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2241    (let uuid = uuidgen () in
2242     [InitBasicFS, Always, TestOutput (
2243        [["set_e2uuid"; "/dev/sda1"; uuid];
2244         ["get_e2uuid"; "/dev/sda1"]], uuid);
2245      InitBasicFS, Always, TestOutput (
2246        [["set_e2uuid"; "/dev/sda1"; "clear"];
2247         ["get_e2uuid"; "/dev/sda1"]], "");
2248      (* We can't predict what UUIDs will be, so just check the commands run. *)
2249      InitBasicFS, Always, TestRun (
2250        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2251      InitBasicFS, Always, TestRun (
2252        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2253    "set the ext2/3/4 filesystem UUID",
2254    "\
2255 This sets the ext2/3/4 filesystem UUID of the filesystem on
2256 C<device> to C<uuid>.  The format of the UUID and alternatives
2257 such as C<clear>, C<random> and C<time> are described in the
2258 L<tune2fs(8)> manpage.
2259
2260 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2261 to return the existing UUID of a filesystem.");
2262
2263   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2264    [],
2265    "get the ext2/3/4 filesystem UUID",
2266    "\
2267 This returns the ext2/3/4 filesystem UUID of the filesystem on
2268 C<device>.");
2269
2270   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2271    [InitBasicFS, Always, TestOutputInt (
2272       [["umount"; "/dev/sda1"];
2273        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2274     InitBasicFS, Always, TestOutputInt (
2275       [["umount"; "/dev/sda1"];
2276        ["zero"; "/dev/sda1"];
2277        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2278    "run the filesystem checker",
2279    "\
2280 This runs the filesystem checker (fsck) on C<device> which
2281 should have filesystem type C<fstype>.
2282
2283 The returned integer is the status.  See L<fsck(8)> for the
2284 list of status codes from C<fsck>.
2285
2286 Notes:
2287
2288 =over 4
2289
2290 =item *
2291
2292 Multiple status codes can be summed together.
2293
2294 =item *
2295
2296 A non-zero return code can mean \"success\", for example if
2297 errors have been corrected on the filesystem.
2298
2299 =item *
2300
2301 Checking or repairing NTFS volumes is not supported
2302 (by linux-ntfs).
2303
2304 =back
2305
2306 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2307
2308   ("zero", (RErr, [Device "device"]), 85, [],
2309    [InitBasicFS, Always, TestOutput (
2310       [["umount"; "/dev/sda1"];
2311        ["zero"; "/dev/sda1"];
2312        ["file"; "/dev/sda1"]], "data")],
2313    "write zeroes to the device",
2314    "\
2315 This command writes zeroes over the first few blocks of C<device>.
2316
2317 How many blocks are zeroed isn't specified (but it's I<not> enough
2318 to securely wipe the device).  It should be sufficient to remove
2319 any partition tables, filesystem superblocks and so on.
2320
2321 See also: C<guestfs_scrub_device>.");
2322
2323   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2324    (* Test disabled because grub-install incompatible with virtio-blk driver.
2325     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2326     *)
2327    [InitBasicFS, Disabled, TestOutputTrue (
2328       [["grub_install"; "/"; "/dev/sda1"];
2329        ["is_dir"; "/boot"]])],
2330    "install GRUB",
2331    "\
2332 This command installs GRUB (the Grand Unified Bootloader) on
2333 C<device>, with the root directory being C<root>.
2334
2335 Note: If grub-install reports the error
2336 \"No suitable drive was found in the generated device map.\"
2337 it may be that you need to create a C</boot/grub/device.map>
2338 file first that contains the mapping between grub device names
2339 and Linux device names.  It is usually sufficient to create
2340 a file containing:
2341
2342  (hd0) /dev/vda
2343
2344 replacing C</dev/vda> with the name of the installation device.");
2345
2346   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2347    [InitBasicFS, Always, TestOutput (
2348       [["write_file"; "/old"; "file content"; "0"];
2349        ["cp"; "/old"; "/new"];
2350        ["cat"; "/new"]], "file content");
2351     InitBasicFS, Always, TestOutputTrue (
2352       [["write_file"; "/old"; "file content"; "0"];
2353        ["cp"; "/old"; "/new"];
2354        ["is_file"; "/old"]]);
2355     InitBasicFS, Always, TestOutput (
2356       [["write_file"; "/old"; "file content"; "0"];
2357        ["mkdir"; "/dir"];
2358        ["cp"; "/old"; "/dir/new"];
2359        ["cat"; "/dir/new"]], "file content")],
2360    "copy a file",
2361    "\
2362 This copies a file from C<src> to C<dest> where C<dest> is
2363 either a destination filename or destination directory.");
2364
2365   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2366    [InitBasicFS, Always, TestOutput (
2367       [["mkdir"; "/olddir"];
2368        ["mkdir"; "/newdir"];
2369        ["write_file"; "/olddir/file"; "file content"; "0"];
2370        ["cp_a"; "/olddir"; "/newdir"];
2371        ["cat"; "/newdir/olddir/file"]], "file content")],
2372    "copy a file or directory recursively",
2373    "\
2374 This copies a file or directory from C<src> to C<dest>
2375 recursively using the C<cp -a> command.");
2376
2377   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2378    [InitBasicFS, Always, TestOutput (
2379       [["write_file"; "/old"; "file content"; "0"];
2380        ["mv"; "/old"; "/new"];
2381        ["cat"; "/new"]], "file content");
2382     InitBasicFS, Always, TestOutputFalse (
2383       [["write_file"; "/old"; "file content"; "0"];
2384        ["mv"; "/old"; "/new"];
2385        ["is_file"; "/old"]])],
2386    "move a file",
2387    "\
2388 This moves a file from C<src> to C<dest> where C<dest> is
2389 either a destination filename or destination directory.");
2390
2391   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2392    [InitEmpty, Always, TestRun (
2393       [["drop_caches"; "3"]])],
2394    "drop kernel page cache, dentries and inodes",
2395    "\
2396 This instructs the guest kernel to drop its page cache,
2397 and/or dentries and inode caches.  The parameter C<whattodrop>
2398 tells the kernel what precisely to drop, see
2399 L<http://linux-mm.org/Drop_Caches>
2400
2401 Setting C<whattodrop> to 3 should drop everything.
2402
2403 This automatically calls L<sync(2)> before the operation,
2404 so that the maximum guest memory is freed.");
2405
2406   ("dmesg", (RString "kmsgs", []), 91, [],
2407    [InitEmpty, Always, TestRun (
2408       [["dmesg"]])],
2409    "return kernel messages",
2410    "\
2411 This returns the kernel messages (C<dmesg> output) from
2412 the guest kernel.  This is sometimes useful for extended
2413 debugging of problems.
2414
2415 Another way to get the same information is to enable
2416 verbose messages with C<guestfs_set_verbose> or by setting
2417 the environment variable C<LIBGUESTFS_DEBUG=1> before
2418 running the program.");
2419
2420   ("ping_daemon", (RErr, []), 92, [],
2421    [InitEmpty, Always, TestRun (
2422       [["ping_daemon"]])],
2423    "ping the guest daemon",
2424    "\
2425 This is a test probe into the guestfs daemon running inside
2426 the qemu subprocess.  Calling this function checks that the
2427 daemon responds to the ping message, without affecting the daemon
2428 or attached block device(s) in any other way.");
2429
2430   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2431    [InitBasicFS, Always, TestOutputTrue (
2432       [["write_file"; "/file1"; "contents of a file"; "0"];
2433        ["cp"; "/file1"; "/file2"];
2434        ["equal"; "/file1"; "/file2"]]);
2435     InitBasicFS, Always, TestOutputFalse (
2436       [["write_file"; "/file1"; "contents of a file"; "0"];
2437        ["write_file"; "/file2"; "contents of another file"; "0"];
2438        ["equal"; "/file1"; "/file2"]]);
2439     InitBasicFS, Always, TestLastFail (
2440       [["equal"; "/file1"; "/file2"]])],
2441    "test if two files have equal contents",
2442    "\
2443 This compares the two files C<file1> and C<file2> and returns
2444 true if their content is exactly equal, or false otherwise.
2445
2446 The external L<cmp(1)> program is used for the comparison.");
2447
2448   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2449    [InitISOFS, Always, TestOutputList (
2450       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2451     InitISOFS, Always, TestOutputList (
2452       [["strings"; "/empty"]], [])],
2453    "print the printable strings in a file",
2454    "\
2455 This runs the L<strings(1)> command on a file and returns
2456 the list of printable strings found.");
2457
2458   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2459    [InitISOFS, Always, TestOutputList (
2460       [["strings_e"; "b"; "/known-5"]], []);
2461     InitBasicFS, Disabled, TestOutputList (
2462       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2463        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2464    "print the printable strings in a file",
2465    "\
2466 This is like the C<guestfs_strings> command, but allows you to
2467 specify the encoding of strings that are looked for in
2468 the source file C<path>.
2469
2470 Allowed encodings are:
2471
2472 =over 4
2473
2474 =item s
2475
2476 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2477 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2478
2479 =item S
2480
2481 Single 8-bit-byte characters.
2482
2483 =item b
2484
2485 16-bit big endian strings such as those encoded in
2486 UTF-16BE or UCS-2BE.
2487
2488 =item l (lower case letter L)
2489
2490 16-bit little endian such as UTF-16LE and UCS-2LE.
2491 This is useful for examining binaries in Windows guests.
2492
2493 =item B
2494
2495 32-bit big endian such as UCS-4BE.
2496
2497 =item L
2498
2499 32-bit little endian such as UCS-4LE.
2500
2501 =back
2502
2503 The returned strings are transcoded to UTF-8.");
2504
2505   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2506    [InitISOFS, Always, TestOutput (
2507       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2508     (* Test for RHBZ#501888c2 regression which caused large hexdump
2509      * commands to segfault.
2510      *)
2511     InitISOFS, Always, TestRun (
2512       [["hexdump"; "/100krandom"]])],
2513    "dump a file in hexadecimal",
2514    "\
2515 This runs C<hexdump -C> on the given C<path>.  The result is
2516 the human-readable, canonical hex dump of the file.");
2517
2518   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2519    [InitNone, Always, TestOutput (
2520       [["part_disk"; "/dev/sda"; "mbr"];
2521        ["mkfs"; "ext3"; "/dev/sda1"];
2522        ["mount_options"; ""; "/dev/sda1"; "/"];
2523        ["write_file"; "/new"; "test file"; "0"];
2524        ["umount"; "/dev/sda1"];
2525        ["zerofree"; "/dev/sda1"];
2526        ["mount_options"; ""; "/dev/sda1"; "/"];
2527        ["cat"; "/new"]], "test file")],
2528    "zero unused inodes and disk blocks on ext2/3 filesystem",
2529    "\
2530 This runs the I<zerofree> program on C<device>.  This program
2531 claims to zero unused inodes and disk blocks on an ext2/3
2532 filesystem, thus making it possible to compress the filesystem
2533 more effectively.
2534
2535 You should B<not> run this program if the filesystem is
2536 mounted.
2537
2538 It is possible that using this program can damage the filesystem
2539 or data on the filesystem.");
2540
2541   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2542    [],
2543    "resize an LVM physical volume",
2544    "\
2545 This resizes (expands or shrinks) an existing LVM physical
2546 volume to match the new size of the underlying device.");
2547
2548   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2549                        Int "cyls"; Int "heads"; Int "sectors";
2550                        String "line"]), 99, [DangerWillRobinson],
2551    [],
2552    "modify a single partition on a block device",
2553    "\
2554 This runs L<sfdisk(8)> option to modify just the single
2555 partition C<n> (note: C<n> counts from 1).
2556
2557 For other parameters, see C<guestfs_sfdisk>.  You should usually
2558 pass C<0> for the cyls/heads/sectors parameters.
2559
2560 See also: C<guestfs_part_add>");
2561
2562   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2563    [],
2564    "display the partition table",
2565    "\
2566 This displays the partition table on C<device>, in the
2567 human-readable output of the L<sfdisk(8)> command.  It is
2568 not intended to be parsed.
2569
2570 See also: C<guestfs_part_list>");
2571
2572   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2573    [],
2574    "display the kernel geometry",
2575    "\
2576 This displays the kernel's idea of the geometry of C<device>.
2577
2578 The result is in human-readable format, and not designed to
2579 be parsed.");
2580
2581   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2582    [],
2583    "display the disk geometry from the partition table",
2584    "\
2585 This displays the disk geometry of C<device> read from the
2586 partition table.  Especially in the case where the underlying
2587 block device has been resized, this can be different from the
2588 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2589
2590 The result is in human-readable format, and not designed to
2591 be parsed.");
2592
2593   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2594    [],
2595    "activate or deactivate all volume groups",
2596    "\
2597 This command activates or (if C<activate> is false) deactivates
2598 all logical volumes in all volume groups.
2599 If activated, then they are made known to the
2600 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2601 then those devices disappear.
2602
2603 This command is the same as running C<vgchange -a y|n>");
2604
2605   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2606    [],
2607    "activate or deactivate some volume groups",
2608    "\
2609 This command activates or (if C<activate> is false) deactivates
2610 all logical volumes in the listed volume groups C<volgroups>.
2611 If activated, then they are made known to the
2612 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2613 then those devices disappear.
2614
2615 This command is the same as running C<vgchange -a y|n volgroups...>
2616
2617 Note that if C<volgroups> is an empty list then B<all> volume groups
2618 are activated or deactivated.");
2619
2620   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2621    [InitNone, Always, TestOutput (
2622       [["part_disk"; "/dev/sda"; "mbr"];
2623        ["pvcreate"; "/dev/sda1"];
2624        ["vgcreate"; "VG"; "/dev/sda1"];
2625        ["lvcreate"; "LV"; "VG"; "10"];
2626        ["mkfs"; "ext2"; "/dev/VG/LV"];
2627        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2628        ["write_file"; "/new"; "test content"; "0"];
2629        ["umount"; "/"];
2630        ["lvresize"; "/dev/VG/LV"; "20"];
2631        ["e2fsck_f"; "/dev/VG/LV"];
2632        ["resize2fs"; "/dev/VG/LV"];
2633        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2634        ["cat"; "/new"]], "test content");
2635     InitNone, Always, TestRun (
2636       (* Make an LV smaller to test RHBZ#587484. *)
2637       [["part_disk"; "/dev/sda"; "mbr"];
2638        ["pvcreate"; "/dev/sda1"];
2639        ["vgcreate"; "VG"; "/dev/sda1"];
2640        ["lvcreate"; "LV"; "VG"; "20"];
2641        ["lvresize"; "/dev/VG/LV"; "10"]])],
2642    "resize an LVM logical volume",
2643    "\
2644 This resizes (expands or shrinks) an existing LVM logical
2645 volume to C<mbytes>.  When reducing, data in the reduced part
2646 is lost.");
2647
2648   ("resize2fs", (RErr, [Device "device"]), 106, [],
2649    [], (* lvresize tests this *)
2650    "resize an ext2, ext3 or ext4 filesystem",
2651    "\
2652 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2653 the underlying device.
2654
2655 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2656 on the C<device> before calling this command.  For unknown reasons
2657 C<resize2fs> sometimes gives an error about this and sometimes not.
2658 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2659 calling this function.");
2660
2661   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2662    [InitBasicFS, Always, TestOutputList (
2663       [["find"; "/"]], ["lost+found"]);
2664     InitBasicFS, Always, TestOutputList (
2665       [["touch"; "/a"];
2666        ["mkdir"; "/b"];
2667        ["touch"; "/b/c"];
2668        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2669     InitBasicFS, Always, TestOutputList (
2670       [["mkdir_p"; "/a/b/c"];
2671        ["touch"; "/a/b/c/d"];
2672        ["find"; "/a/b/"]], ["c"; "c/d"])],
2673    "find all files and directories",
2674    "\
2675 This command lists out all files and directories, recursively,
2676 starting at C<directory>.  It is essentially equivalent to
2677 running the shell command C<find directory -print> but some
2678 post-processing happens on the output, described below.
2679
2680 This returns a list of strings I<without any prefix>.  Thus
2681 if the directory structure was:
2682
2683  /tmp/a
2684  /tmp/b
2685  /tmp/c/d
2686
2687 then the returned list from C<guestfs_find> C</tmp> would be
2688 4 elements:
2689
2690  a
2691  b
2692  c
2693  c/d
2694
2695 If C<directory> is not a directory, then this command returns
2696 an error.
2697
2698 The returned list is sorted.
2699
2700 See also C<guestfs_find0>.");
2701
2702   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2703    [], (* lvresize tests this *)
2704    "check an ext2/ext3 filesystem",
2705    "\
2706 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2707 filesystem checker on C<device>, noninteractively (C<-p>),
2708 even if the filesystem appears to be clean (C<-f>).
2709
2710 This command is only needed because of C<guestfs_resize2fs>
2711 (q.v.).  Normally you should use C<guestfs_fsck>.");
2712
2713   ("sleep", (RErr, [Int "secs"]), 109, [],
2714    [InitNone, Always, TestRun (
2715       [["sleep"; "1"]])],
2716    "sleep for some seconds",
2717    "\
2718 Sleep for C<secs> seconds.");
2719
2720   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2721    [InitNone, Always, TestOutputInt (
2722       [["part_disk"; "/dev/sda"; "mbr"];
2723        ["mkfs"; "ntfs"; "/dev/sda1"];
2724        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2725     InitNone, Always, TestOutputInt (
2726       [["part_disk"; "/dev/sda"; "mbr"];
2727        ["mkfs"; "ext2"; "/dev/sda1"];
2728        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2729    "probe NTFS volume",
2730    "\
2731 This command runs the L<ntfs-3g.probe(8)> command which probes
2732 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2733 be mounted read-write, and some cannot be mounted at all).
2734
2735 C<rw> is a boolean flag.  Set it to true if you want to test
2736 if the volume can be mounted read-write.  Set it to false if
2737 you want to test if the volume can be mounted read-only.
2738
2739 The return value is an integer which C<0> if the operation
2740 would succeed, or some non-zero value documented in the
2741 L<ntfs-3g.probe(8)> manual page.");
2742
2743   ("sh", (RString "output", [String "command"]), 111, [],
2744    [], (* XXX needs tests *)
2745    "run a command via the shell",
2746    "\
2747 This call runs a command from the guest filesystem via the
2748 guest's C</bin/sh>.
2749
2750 This is like C<guestfs_command>, but passes the command to:
2751
2752  /bin/sh -c \"command\"
2753
2754 Depending on the guest's shell, this usually results in
2755 wildcards being expanded, shell expressions being interpolated
2756 and so on.
2757
2758 All the provisos about C<guestfs_command> apply to this call.");
2759
2760   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2761    [], (* XXX needs tests *)
2762    "run a command via the shell returning lines",
2763    "\
2764 This is the same as C<guestfs_sh>, but splits the result
2765 into a list of lines.
2766
2767 See also: C<guestfs_command_lines>");
2768
2769   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2770    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2771     * code in stubs.c, since all valid glob patterns must start with "/".
2772     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2773     *)
2774    [InitBasicFS, Always, TestOutputList (
2775       [["mkdir_p"; "/a/b/c"];
2776        ["touch"; "/a/b/c/d"];
2777        ["touch"; "/a/b/c/e"];
2778        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2779     InitBasicFS, Always, TestOutputList (
2780       [["mkdir_p"; "/a/b/c"];
2781        ["touch"; "/a/b/c/d"];
2782        ["touch"; "/a/b/c/e"];
2783        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2784     InitBasicFS, Always, TestOutputList (
2785       [["mkdir_p"; "/a/b/c"];
2786        ["touch"; "/a/b/c/d"];
2787        ["touch"; "/a/b/c/e"];
2788        ["glob_expand"; "/a/*/x/*"]], [])],
2789    "expand a wildcard path",
2790    "\
2791 This command searches for all the pathnames matching
2792 C<pattern> according to the wildcard expansion rules
2793 used by the shell.
2794
2795 If no paths match, then this returns an empty list
2796 (note: not an error).
2797
2798 It is just a wrapper around the C L<glob(3)> function
2799 with flags C<GLOB_MARK|GLOB_BRACE>.
2800 See that manual page for more details.");
2801
2802   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2803    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2804       [["scrub_device"; "/dev/sdc"]])],
2805    "scrub (securely wipe) a device",
2806    "\
2807 This command writes patterns over C<device> to make data retrieval
2808 more difficult.
2809
2810 It is an interface to the L<scrub(1)> program.  See that
2811 manual page for more details.");
2812
2813   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2814    [InitBasicFS, Always, TestRun (
2815       [["write_file"; "/file"; "content"; "0"];
2816        ["scrub_file"; "/file"]])],
2817    "scrub (securely wipe) a file",
2818    "\
2819 This command writes patterns over a file to make data retrieval
2820 more difficult.
2821
2822 The file is I<removed> after scrubbing.
2823
2824 It is an interface to the L<scrub(1)> program.  See that
2825 manual page for more details.");
2826
2827   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2828    [], (* XXX needs testing *)
2829    "scrub (securely wipe) free space",
2830    "\
2831 This command creates the directory C<dir> and then fills it
2832 with files until the filesystem is full, and scrubs the files
2833 as for C<guestfs_scrub_file>, and deletes them.
2834 The intention is to scrub any free space on the partition
2835 containing C<dir>.
2836
2837 It is an interface to the L<scrub(1)> program.  See that
2838 manual page for more details.");
2839
2840   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2841    [InitBasicFS, Always, TestRun (
2842       [["mkdir"; "/tmp"];
2843        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2844    "create a temporary directory",
2845    "\
2846 This command creates a temporary directory.  The
2847 C<template> parameter should be a full pathname for the
2848 temporary directory name with the final six characters being
2849 \"XXXXXX\".
2850
2851 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2852 the second one being suitable for Windows filesystems.
2853
2854 The name of the temporary directory that was created
2855 is returned.
2856
2857 The temporary directory is created with mode 0700
2858 and is owned by root.
2859
2860 The caller is responsible for deleting the temporary
2861 directory and its contents after use.
2862
2863 See also: L<mkdtemp(3)>");
2864
2865   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2866    [InitISOFS, Always, TestOutputInt (
2867       [["wc_l"; "/10klines"]], 10000)],
2868    "count lines in a file",
2869    "\
2870 This command counts the lines in a file, using the
2871 C<wc -l> external command.");
2872
2873   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2874    [InitISOFS, Always, TestOutputInt (
2875       [["wc_w"; "/10klines"]], 10000)],
2876    "count words in a file",
2877    "\
2878 This command counts the words in a file, using the
2879 C<wc -w> external command.");
2880
2881   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2882    [InitISOFS, Always, TestOutputInt (
2883       [["wc_c"; "/100kallspaces"]], 102400)],
2884    "count characters in a file",
2885    "\
2886 This command counts the characters in a file, using the
2887 C<wc -c> external command.");
2888
2889   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2890    [InitISOFS, Always, TestOutputList (
2891       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2892    "return first 10 lines of a file",
2893    "\
2894 This command returns up to the first 10 lines of a file as
2895 a list of strings.");
2896
2897   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2898    [InitISOFS, Always, TestOutputList (
2899       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2900     InitISOFS, Always, TestOutputList (
2901       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2902     InitISOFS, Always, TestOutputList (
2903       [["head_n"; "0"; "/10klines"]], [])],
2904    "return first N lines of a file",
2905    "\
2906 If the parameter C<nrlines> is a positive number, this returns the first
2907 C<nrlines> lines of the file C<path>.
2908
2909 If the parameter C<nrlines> is a negative number, this returns lines
2910 from the file C<path>, excluding the last C<nrlines> lines.
2911
2912 If the parameter C<nrlines> is zero, this returns an empty list.");
2913
2914   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2915    [InitISOFS, Always, TestOutputList (
2916       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2917    "return last 10 lines of a file",
2918    "\
2919 This command returns up to the last 10 lines of a file as
2920 a list of strings.");
2921
2922   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2923    [InitISOFS, Always, TestOutputList (
2924       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2925     InitISOFS, Always, TestOutputList (
2926       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2927     InitISOFS, Always, TestOutputList (
2928       [["tail_n"; "0"; "/10klines"]], [])],
2929    "return last N lines of a file",
2930    "\
2931 If the parameter C<nrlines> is a positive number, this returns the last
2932 C<nrlines> lines of the file C<path>.
2933
2934 If the parameter C<nrlines> is a negative number, this returns lines
2935 from the file C<path>, starting with the C<-nrlines>th line.
2936
2937 If the parameter C<nrlines> is zero, this returns an empty list.");
2938
2939   ("df", (RString "output", []), 125, [],
2940    [], (* XXX Tricky to test because it depends on the exact format
2941         * of the 'df' command and other imponderables.
2942         *)
2943    "report file system disk space usage",
2944    "\
2945 This command runs the C<df> command to report disk space used.
2946
2947 This command is mostly useful for interactive sessions.  It
2948 is I<not> intended that you try to parse the output string.
2949 Use C<statvfs> from programs.");
2950
2951   ("df_h", (RString "output", []), 126, [],
2952    [], (* XXX Tricky to test because it depends on the exact format
2953         * of the 'df' command and other imponderables.
2954         *)
2955    "report file system disk space usage (human readable)",
2956    "\
2957 This command runs the C<df -h> command to report disk space used
2958 in human-readable format.
2959
2960 This command is mostly useful for interactive sessions.  It
2961 is I<not> intended that you try to parse the output string.
2962 Use C<statvfs> from programs.");
2963
2964   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2965    [InitISOFS, Always, TestOutputInt (
2966       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2967    "estimate file space usage",
2968    "\
2969 This command runs the C<du -s> command to estimate file space
2970 usage for C<path>.
2971
2972 C<path> can be a file or a directory.  If C<path> is a directory
2973 then the estimate includes the contents of the directory and all
2974 subdirectories (recursively).
2975
2976 The result is the estimated size in I<kilobytes>
2977 (ie. units of 1024 bytes).");
2978
2979   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2980    [InitISOFS, Always, TestOutputList (
2981       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2982    "list files in an initrd",
2983    "\
2984 This command lists out files contained in an initrd.
2985
2986 The files are listed without any initial C</> character.  The
2987 files are listed in the order they appear (not necessarily
2988 alphabetical).  Directory names are listed as separate items.
2989
2990 Old Linux kernels (2.4 and earlier) used a compressed ext2
2991 filesystem as initrd.  We I<only> support the newer initramfs
2992 format (compressed cpio files).");
2993
2994   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2995    [],
2996    "mount a file using the loop device",
2997    "\
2998 This command lets you mount C<file> (a filesystem image
2999 in a file) on a mount point.  It is entirely equivalent to
3000 the command C<mount -o loop file mountpoint>.");
3001
3002   ("mkswap", (RErr, [Device "device"]), 130, [],
3003    [InitEmpty, Always, TestRun (
3004       [["part_disk"; "/dev/sda"; "mbr"];
3005        ["mkswap"; "/dev/sda1"]])],
3006    "create a swap partition",
3007    "\
3008 Create a swap partition on C<device>.");
3009
3010   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3011    [InitEmpty, Always, TestRun (
3012       [["part_disk"; "/dev/sda"; "mbr"];
3013        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3014    "create a swap partition with a label",
3015    "\
3016 Create a swap partition on C<device> with label C<label>.
3017
3018 Note that you cannot attach a swap label to a block device
3019 (eg. C</dev/sda>), just to a partition.  This appears to be
3020 a limitation of the kernel or swap tools.");
3021
3022   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3023    (let uuid = uuidgen () in
3024     [InitEmpty, Always, TestRun (
3025        [["part_disk"; "/dev/sda"; "mbr"];
3026         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3027    "create a swap partition with an explicit UUID",
3028    "\
3029 Create a swap partition on C<device> with UUID C<uuid>.");
3030
3031   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3032    [InitBasicFS, Always, TestOutputStruct (
3033       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3034        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3035        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3036     InitBasicFS, Always, TestOutputStruct (
3037       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3038        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3039    "make block, character or FIFO devices",
3040    "\
3041 This call creates block or character special devices, or
3042 named pipes (FIFOs).
3043
3044 The C<mode> parameter should be the mode, using the standard
3045 constants.  C<devmajor> and C<devminor> are the
3046 device major and minor numbers, only used when creating block
3047 and character special devices.
3048
3049 Note that, just like L<mknod(2)>, the mode must be bitwise
3050 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3051 just creates a regular file).  These constants are
3052 available in the standard Linux header files, or you can use
3053 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3054 which are wrappers around this command which bitwise OR
3055 in the appropriate constant for you.
3056
3057 The mode actually set is affected by the umask.");
3058
3059   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3060    [InitBasicFS, Always, TestOutputStruct (
3061       [["mkfifo"; "0o777"; "/node"];
3062        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3063    "make FIFO (named pipe)",
3064    "\
3065 This call creates a FIFO (named pipe) called C<path> with
3066 mode C<mode>.  It is just a convenient wrapper around
3067 C<guestfs_mknod>.
3068
3069 The mode actually set is affected by the umask.");
3070
3071   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3072    [InitBasicFS, Always, TestOutputStruct (
3073       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3074        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3075    "make block device node",
3076    "\
3077 This call creates a block device node called C<path> with
3078 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3079 It is just a convenient wrapper around C<guestfs_mknod>.
3080
3081 The mode actually set is affected by the umask.");
3082
3083   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3084    [InitBasicFS, Always, TestOutputStruct (
3085       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3086        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3087    "make char device node",
3088    "\
3089 This call creates a char device node called C<path> with
3090 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3091 It is just a convenient wrapper around C<guestfs_mknod>.
3092
3093 The mode actually set is affected by the umask.");
3094
3095   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3096    [InitEmpty, Always, TestOutputInt (
3097       [["umask"; "0o22"]], 0o22)],
3098    "set file mode creation mask (umask)",
3099    "\
3100 This function sets the mask used for creating new files and
3101 device nodes to C<mask & 0777>.
3102
3103 Typical umask values would be C<022> which creates new files
3104 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3105 C<002> which creates new files with permissions like
3106 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3107
3108 The default umask is C<022>.  This is important because it
3109 means that directories and device nodes will be created with
3110 C<0644> or C<0755> mode even if you specify C<0777>.
3111
3112 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3113
3114 This call returns the previous umask.");
3115
3116   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3117    [],
3118    "read directories entries",
3119    "\
3120 This returns the list of directory entries in directory C<dir>.
3121
3122 All entries in the directory are returned, including C<.> and
3123 C<..>.  The entries are I<not> sorted, but returned in the same
3124 order as the underlying filesystem.
3125
3126 Also this call returns basic file type information about each
3127 file.  The C<ftyp> field will contain one of the following characters:
3128
3129 =over 4
3130
3131 =item 'b'
3132
3133 Block special
3134
3135 =item 'c'
3136
3137 Char special
3138
3139 =item 'd'
3140
3141 Directory
3142
3143 =item 'f'
3144
3145 FIFO (named pipe)
3146
3147 =item 'l'
3148
3149 Symbolic link
3150
3151 =item 'r'
3152
3153 Regular file
3154
3155 =item 's'
3156
3157 Socket
3158
3159 =item 'u'
3160
3161 Unknown file type
3162
3163 =item '?'
3164
3165 The L<readdir(3)> call returned a C<d_type> field with an
3166 unexpected value
3167
3168 =back
3169
3170 This function is primarily intended for use by programs.  To
3171 get a simple list of names, use C<guestfs_ls>.  To get a printable
3172 directory for human consumption, use C<guestfs_ll>.");
3173
3174   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3175    [],
3176    "create partitions on a block device",
3177    "\
3178 This is a simplified interface to the C<guestfs_sfdisk>
3179 command, where partition sizes are specified in megabytes
3180 only (rounded to the nearest cylinder) and you don't need
3181 to specify the cyls, heads and sectors parameters which
3182 were rarely if ever used anyway.
3183
3184 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3185 and C<guestfs_part_disk>");
3186
3187   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3188    [],
3189    "determine file type inside a compressed file",
3190    "\
3191 This command runs C<file> after first decompressing C<path>
3192 using C<method>.
3193
3194 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3195
3196 Since 1.0.63, use C<guestfs_file> instead which can now
3197 process compressed files.");
3198
3199   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3200    [],
3201    "list extended attributes of a file or directory",
3202    "\
3203 This call lists the extended attributes of the file or directory
3204 C<path>.
3205
3206 At the system call level, this is a combination of the
3207 L<listxattr(2)> and L<getxattr(2)> calls.
3208
3209 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3210
3211   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3212    [],
3213    "list extended attributes of a file or directory",
3214    "\
3215 This is the same as C<guestfs_getxattrs>, but if C<path>
3216 is a symbolic link, then it returns the extended attributes
3217 of the link itself.");
3218
3219   ("setxattr", (RErr, [String "xattr";
3220                        String "val"; Int "vallen"; (* will be BufferIn *)
3221                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3222    [],
3223    "set extended attribute of a file or directory",
3224    "\
3225 This call sets the extended attribute named C<xattr>
3226 of the file C<path> to the value C<val> (of length C<vallen>).
3227 The value is arbitrary 8 bit data.
3228
3229 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3230
3231   ("lsetxattr", (RErr, [String "xattr";
3232                         String "val"; Int "vallen"; (* will be BufferIn *)
3233                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3234    [],
3235    "set extended attribute of a file or directory",
3236    "\
3237 This is the same as C<guestfs_setxattr>, but if C<path>
3238 is a symbolic link, then it sets an extended attribute
3239 of the link itself.");
3240
3241   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3242    [],
3243    "remove extended attribute of a file or directory",
3244    "\
3245 This call removes the extended attribute named C<xattr>
3246 of the file C<path>.
3247
3248 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3249
3250   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3251    [],
3252    "remove extended attribute of a file or directory",
3253    "\
3254 This is the same as C<guestfs_removexattr>, but if C<path>
3255 is a symbolic link, then it removes an extended attribute
3256 of the link itself.");
3257
3258   ("mountpoints", (RHashtable "mps", []), 147, [],
3259    [],
3260    "show mountpoints",
3261    "\
3262 This call is similar to C<guestfs_mounts>.  That call returns
3263 a list of devices.  This one returns a hash table (map) of
3264 device name to directory where the device is mounted.");
3265
3266   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3267    (* This is a special case: while you would expect a parameter
3268     * of type "Pathname", that doesn't work, because it implies
3269     * NEED_ROOT in the generated calling code in stubs.c, and
3270     * this function cannot use NEED_ROOT.
3271     *)
3272    [],
3273    "create a mountpoint",
3274    "\
3275 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3276 specialized calls that can be used to create extra mountpoints
3277 before mounting the first filesystem.
3278
3279 These calls are I<only> necessary in some very limited circumstances,
3280 mainly the case where you want to mount a mix of unrelated and/or
3281 read-only filesystems together.
3282
3283 For example, live CDs often contain a \"Russian doll\" nest of
3284 filesystems, an ISO outer layer, with a squashfs image inside, with
3285 an ext2/3 image inside that.  You can unpack this as follows
3286 in guestfish:
3287
3288  add-ro Fedora-11-i686-Live.iso
3289  run
3290  mkmountpoint /cd
3291  mkmountpoint /squash
3292  mkmountpoint /ext3
3293  mount /dev/sda /cd
3294  mount-loop /cd/LiveOS/squashfs.img /squash
3295  mount-loop /squash/LiveOS/ext3fs.img /ext3
3296
3297 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3298
3299   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3300    [],
3301    "remove a mountpoint",
3302    "\
3303 This calls removes a mountpoint that was previously created
3304 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3305 for full details.");
3306
3307   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3308    [InitISOFS, Always, TestOutputBuffer (
3309       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3310     (* Test various near large, large and too large files (RHBZ#589039). *)
3311     InitBasicFS, Always, TestLastFail (
3312       [["touch"; "/a"];
3313        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3314        ["read_file"; "/a"]]);
3315     InitBasicFS, Always, TestLastFail (
3316       [["touch"; "/a"];
3317        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3318        ["read_file"; "/a"]]);
3319     InitBasicFS, Always, TestLastFail (
3320       [["touch"; "/a"];
3321        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3322        ["read_file"; "/a"]])],
3323    "read a file",
3324    "\
3325 This calls returns the contents of the file C<path> as a
3326 buffer.
3327
3328 Unlike C<guestfs_cat>, this function can correctly
3329 handle files that contain embedded ASCII NUL characters.
3330 However unlike C<guestfs_download>, this function is limited
3331 in the total size of file that can be handled.");
3332
3333   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3334    [InitISOFS, Always, TestOutputList (
3335       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3336     InitISOFS, Always, TestOutputList (
3337       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3338    "return lines matching a pattern",
3339    "\
3340 This calls the external C<grep> program and returns the
3341 matching lines.");
3342
3343   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3344    [InitISOFS, Always, TestOutputList (
3345       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3346    "return lines matching a pattern",
3347    "\
3348 This calls the external C<egrep> program and returns the
3349 matching lines.");
3350
3351   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3352    [InitISOFS, Always, TestOutputList (
3353       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3354    "return lines matching a pattern",
3355    "\
3356 This calls the external C<fgrep> program and returns the
3357 matching lines.");
3358
3359   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3360    [InitISOFS, Always, TestOutputList (
3361       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3362    "return lines matching a pattern",
3363    "\
3364 This calls the external C<grep -i> program and returns the
3365 matching lines.");
3366
3367   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3368    [InitISOFS, Always, TestOutputList (
3369       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3370    "return lines matching a pattern",
3371    "\
3372 This calls the external C<egrep -i> program and returns the
3373 matching lines.");
3374
3375   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3376    [InitISOFS, Always, TestOutputList (
3377       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3378    "return lines matching a pattern",
3379    "\
3380 This calls the external C<fgrep -i> program and returns the
3381 matching lines.");
3382
3383   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3384    [InitISOFS, Always, TestOutputList (
3385       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3386    "return lines matching a pattern",
3387    "\
3388 This calls the external C<zgrep> program and returns the
3389 matching lines.");
3390
3391   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3392    [InitISOFS, Always, TestOutputList (
3393       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3394    "return lines matching a pattern",
3395    "\
3396 This calls the external C<zegrep> program and returns the
3397 matching lines.");
3398
3399   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3400    [InitISOFS, Always, TestOutputList (
3401       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3402    "return lines matching a pattern",
3403    "\
3404 This calls the external C<zfgrep> program and returns the
3405 matching lines.");
3406
3407   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3408    [InitISOFS, Always, TestOutputList (
3409       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3410    "return lines matching a pattern",
3411    "\
3412 This calls the external C<zgrep -i> program and returns the
3413 matching lines.");
3414
3415   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3416    [InitISOFS, Always, TestOutputList (
3417       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3418    "return lines matching a pattern",
3419    "\
3420 This calls the external C<zegrep -i> program and returns the
3421 matching lines.");
3422
3423   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3424    [InitISOFS, Always, TestOutputList (
3425       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3426    "return lines matching a pattern",
3427    "\
3428 This calls the external C<zfgrep -i> program and returns the
3429 matching lines.");
3430
3431   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3432    [InitISOFS, Always, TestOutput (
3433       [["realpath"; "/../directory"]], "/directory")],
3434    "canonicalized absolute pathname",
3435    "\
3436 Return the canonicalized absolute pathname of C<path>.  The
3437 returned path has no C<.>, C<..> or symbolic link path elements.");
3438
3439   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3440    [InitBasicFS, Always, TestOutputStruct (
3441       [["touch"; "/a"];
3442        ["ln"; "/a"; "/b"];
3443        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3444    "create a hard link",
3445    "\
3446 This command creates a hard link using the C<ln> command.");
3447
3448   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3449    [InitBasicFS, Always, TestOutputStruct (
3450       [["touch"; "/a"];
3451        ["touch"; "/b"];
3452        ["ln_f"; "/a"; "/b"];
3453        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3454    "create a hard link",
3455    "\
3456 This command creates a hard link using the C<ln -f> command.
3457 The C<-f> option removes the link (C<linkname>) if it exists already.");
3458
3459   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3460    [InitBasicFS, Always, TestOutputStruct (
3461       [["touch"; "/a"];
3462        ["ln_s"; "a"; "/b"];
3463        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3464    "create a symbolic link",
3465    "\
3466 This command creates a symbolic link using the C<ln -s> command.");
3467
3468   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3469    [InitBasicFS, Always, TestOutput (
3470       [["mkdir_p"; "/a/b"];
3471        ["touch"; "/a/b/c"];
3472        ["ln_sf"; "../d"; "/a/b/c"];
3473        ["readlink"; "/a/b/c"]], "../d")],
3474    "create a symbolic link",
3475    "\
3476 This command creates a symbolic link using the C<ln -sf> command,
3477 The C<-f> option removes the link (C<linkname>) if it exists already.");
3478
3479   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3480    [] (* XXX tested above *),
3481    "read the target of a symbolic link",
3482    "\
3483 This command reads the target of a symbolic link.");
3484
3485   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3486    [InitBasicFS, Always, TestOutputStruct (
3487       [["fallocate"; "/a"; "1000000"];
3488        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3489    "preallocate a file in the guest filesystem",
3490    "\
3491 This command preallocates a file (containing zero bytes) named
3492 C<path> of size C<len> bytes.  If the file exists already, it
3493 is overwritten.
3494
3495 Do not confuse this with the guestfish-specific
3496 C<alloc> command which allocates a file in the host and
3497 attaches it as a device.");
3498
3499   ("swapon_device", (RErr, [Device "device"]), 170, [],
3500    [InitPartition, Always, TestRun (
3501       [["mkswap"; "/dev/sda1"];
3502        ["swapon_device"; "/dev/sda1"];
3503        ["swapoff_device"; "/dev/sda1"]])],
3504    "enable swap on device",
3505    "\
3506 This command enables the libguestfs appliance to use the
3507 swap device or partition named C<device>.  The increased
3508 memory is made available for all commands, for example
3509 those run using C<guestfs_command> or C<guestfs_sh>.
3510
3511 Note that you should not swap to existing guest swap
3512 partitions unless you know what you are doing.  They may
3513 contain hibernation information, or other information that
3514 the guest doesn't want you to trash.  You also risk leaking
3515 information about the host to the guest this way.  Instead,
3516 attach a new host device to the guest and swap on that.");
3517
3518   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3519    [], (* XXX tested by swapon_device *)
3520    "disable swap on device",
3521    "\
3522 This command disables the libguestfs appliance swap
3523 device or partition named C<device>.
3524 See C<guestfs_swapon_device>.");
3525
3526   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3527    [InitBasicFS, Always, TestRun (
3528       [["fallocate"; "/swap"; "8388608"];
3529        ["mkswap_file"; "/swap"];
3530        ["swapon_file"; "/swap"];
3531        ["swapoff_file"; "/swap"]])],
3532    "enable swap on file",
3533    "\
3534 This command enables swap to a file.
3535 See C<guestfs_swapon_device> for other notes.");
3536
3537   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3538    [], (* XXX tested by swapon_file *)
3539    "disable swap on file",
3540    "\
3541 This command disables the libguestfs appliance swap on file.");
3542
3543   ("swapon_label", (RErr, [String "label"]), 174, [],
3544    [InitEmpty, Always, TestRun (
3545       [["part_disk"; "/dev/sdb"; "mbr"];
3546        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3547        ["swapon_label"; "swapit"];
3548        ["swapoff_label"; "swapit"];
3549        ["zero"; "/dev/sdb"];
3550        ["blockdev_rereadpt"; "/dev/sdb"]])],
3551    "enable swap on labeled swap partition",
3552    "\
3553 This command enables swap to a labeled swap partition.
3554 See C<guestfs_swapon_device> for other notes.");
3555
3556   ("swapoff_label", (RErr, [String "label"]), 175, [],
3557    [], (* XXX tested by swapon_label *)
3558    "disable swap on labeled swap partition",
3559    "\
3560 This command disables the libguestfs appliance swap on
3561 labeled swap partition.");
3562
3563   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3564    (let uuid = uuidgen () in
3565     [InitEmpty, Always, TestRun (
3566        [["mkswap_U"; uuid; "/dev/sdb"];
3567         ["swapon_uuid"; uuid];
3568         ["swapoff_uuid"; uuid]])]),
3569    "enable swap on swap partition by UUID",
3570    "\
3571 This command enables swap to a swap partition with the given UUID.
3572 See C<guestfs_swapon_device> for other notes.");
3573
3574   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3575    [], (* XXX tested by swapon_uuid *)
3576    "disable swap on swap partition by UUID",
3577    "\
3578 This command disables the libguestfs appliance swap partition
3579 with the given UUID.");
3580
3581   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3582    [InitBasicFS, Always, TestRun (
3583       [["fallocate"; "/swap"; "8388608"];
3584        ["mkswap_file"; "/swap"]])],
3585    "create a swap file",
3586    "\
3587 Create a swap file.
3588
3589 This command just writes a swap file signature to an existing
3590 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3591
3592   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3593    [InitISOFS, Always, TestRun (
3594       [["inotify_init"; "0"]])],
3595    "create an inotify handle",
3596    "\
3597 This command creates a new inotify handle.
3598 The inotify subsystem can be used to notify events which happen to
3599 objects in the guest filesystem.
3600
3601 C<maxevents> is the maximum number of events which will be
3602 queued up between calls to C<guestfs_inotify_read> or
3603 C<guestfs_inotify_files>.
3604 If this is passed as C<0>, then the kernel (or previously set)
3605 default is used.  For Linux 2.6.29 the default was 16384 events.
3606 Beyond this limit, the kernel throws away events, but records
3607 the fact that it threw them away by setting a flag
3608 C<IN_Q_OVERFLOW> in the returned structure list (see
3609 C<guestfs_inotify_read>).
3610
3611 Before any events are generated, you have to add some
3612 watches to the internal watch list.  See:
3613 C<guestfs_inotify_add_watch>,
3614 C<guestfs_inotify_rm_watch> and
3615 C<guestfs_inotify_watch_all>.
3616
3617 Queued up events should be read periodically by calling
3618 C<guestfs_inotify_read>
3619 (or C<guestfs_inotify_files> which is just a helpful
3620 wrapper around C<guestfs_inotify_read>).  If you don't
3621 read the events out often enough then you risk the internal
3622 queue overflowing.
3623
3624 The handle should be closed after use by calling
3625 C<guestfs_inotify_close>.  This also removes any
3626 watches automatically.
3627
3628 See also L<inotify(7)> for an overview of the inotify interface
3629 as exposed by the Linux kernel, which is roughly what we expose
3630 via libguestfs.  Note that there is one global inotify handle
3631 per libguestfs instance.");
3632
3633   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3634    [InitBasicFS, Always, TestOutputList (
3635       [["inotify_init"; "0"];
3636        ["inotify_add_watch"; "/"; "1073741823"];
3637        ["touch"; "/a"];
3638        ["touch"; "/b"];
3639        ["inotify_files"]], ["a"; "b"])],
3640    "add an inotify watch",
3641    "\
3642 Watch C<path> for the events listed in C<mask>.
3643
3644 Note that if C<path> is a directory then events within that
3645 directory are watched, but this does I<not> happen recursively
3646 (in subdirectories).
3647
3648 Note for non-C or non-Linux callers: the inotify events are
3649 defined by the Linux kernel ABI and are listed in
3650 C</usr/include/sys/inotify.h>.");
3651
3652   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3653    [],
3654    "remove an inotify watch",
3655    "\
3656 Remove a previously defined inotify watch.
3657 See C<guestfs_inotify_add_watch>.");
3658
3659   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3660    [],
3661    "return list of inotify events",
3662    "\
3663 Return the complete queue of events that have happened
3664 since the previous read call.
3665
3666 If no events have happened, this returns an empty list.
3667
3668 I<Note>: In order to make sure that all events have been
3669 read, you must call this function repeatedly until it
3670 returns an empty list.  The reason is that the call will
3671 read events up to the maximum appliance-to-host message
3672 size and leave remaining events in the queue.");
3673
3674   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3675    [],
3676    "return list of watched files that had events",
3677    "\
3678 This function is a helpful wrapper around C<guestfs_inotify_read>
3679 which just returns a list of pathnames of objects that were
3680 touched.  The returned pathnames are sorted and deduplicated.");
3681
3682   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3683    [],
3684    "close the inotify handle",
3685    "\
3686 This closes the inotify handle which was previously
3687 opened by inotify_init.  It removes all watches, throws
3688 away any pending events, and deallocates all resources.");
3689
3690   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3691    [],
3692    "set SELinux security context",
3693    "\
3694 This sets the SELinux security context of the daemon
3695 to the string C<context>.
3696
3697 See the documentation about SELINUX in L<guestfs(3)>.");
3698
3699   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3700    [],
3701    "get SELinux security context",
3702    "\
3703 This gets the SELinux security context of the daemon.
3704
3705 See the documentation about SELINUX in L<guestfs(3)>,
3706 and C<guestfs_setcon>");
3707
3708   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3709    [InitEmpty, Always, TestOutput (
3710       [["part_disk"; "/dev/sda"; "mbr"];
3711        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3712        ["mount_options"; ""; "/dev/sda1"; "/"];
3713        ["write_file"; "/new"; "new file contents"; "0"];
3714        ["cat"; "/new"]], "new file contents")],
3715    "make a filesystem with block size",
3716    "\
3717 This call is similar to C<guestfs_mkfs>, but it allows you to
3718 control the block size of the resulting filesystem.  Supported
3719 block sizes depend on the filesystem type, but typically they
3720 are C<1024>, C<2048> or C<4096> only.");
3721
3722   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3723    [InitEmpty, Always, TestOutput (
3724       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3725        ["mke2journal"; "4096"; "/dev/sda1"];
3726        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3727        ["mount_options"; ""; "/dev/sda2"; "/"];
3728        ["write_file"; "/new"; "new file contents"; "0"];
3729        ["cat"; "/new"]], "new file contents")],
3730    "make ext2/3/4 external journal",
3731    "\
3732 This creates an ext2 external journal on C<device>.  It is equivalent
3733 to the command:
3734
3735  mke2fs -O journal_dev -b blocksize device");
3736
3737   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3738    [InitEmpty, Always, TestOutput (
3739       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3740        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3741        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3742        ["mount_options"; ""; "/dev/sda2"; "/"];
3743        ["write_file"; "/new"; "new file contents"; "0"];
3744        ["cat"; "/new"]], "new file contents")],
3745    "make ext2/3/4 external journal with label",
3746    "\
3747 This creates an ext2 external journal on C<device> with label C<label>.");
3748
3749   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3750    (let uuid = uuidgen () in
3751     [InitEmpty, Always, TestOutput (
3752        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3753         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3754         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3755         ["mount_options"; ""; "/dev/sda2"; "/"];
3756         ["write_file"; "/new"; "new file contents"; "0"];
3757         ["cat"; "/new"]], "new file contents")]),
3758    "make ext2/3/4 external journal with UUID",
3759    "\
3760 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3761
3762   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3763    [],
3764    "make ext2/3/4 filesystem with external journal",
3765    "\
3766 This creates an ext2/3/4 filesystem on C<device> with
3767 an external journal on C<journal>.  It is equivalent
3768 to the command:
3769
3770  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3771
3772 See also C<guestfs_mke2journal>.");
3773
3774   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3775    [],
3776    "make ext2/3/4 filesystem with external journal",
3777    "\
3778 This creates an ext2/3/4 filesystem on C<device> with
3779 an external journal on the journal labeled C<label>.
3780
3781 See also C<guestfs_mke2journal_L>.");
3782
3783   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3784    [],
3785    "make ext2/3/4 filesystem with external journal",
3786    "\
3787 This creates an ext2/3/4 filesystem on C<device> with
3788 an external journal on the journal with UUID C<uuid>.
3789
3790 See also C<guestfs_mke2journal_U>.");
3791
3792   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3793    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3794    "load a kernel module",
3795    "\
3796 This loads a kernel module in the appliance.
3797
3798 The kernel module must have been whitelisted when libguestfs
3799 was built (see C<appliance/kmod.whitelist.in> in the source).");
3800
3801   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3802    [InitNone, Always, TestOutput (
3803       [["echo_daemon"; "This is a test"]], "This is a test"
3804     )],
3805    "echo arguments back to the client",
3806    "\
3807 This command concatenates the list of C<words> passed with single spaces
3808 between them and returns the resulting string.
3809
3810 You can use this command to test the connection through to the daemon.
3811
3812 See also C<guestfs_ping_daemon>.");
3813
3814   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3815    [], (* There is a regression test for this. *)
3816    "find all files and directories, returning NUL-separated list",
3817    "\
3818 This command lists out all files and directories, recursively,
3819 starting at C<directory>, placing the resulting list in the
3820 external file called C<files>.
3821
3822 This command works the same way as C<guestfs_find> with the
3823 following exceptions:
3824
3825 =over 4
3826
3827 =item *
3828
3829 The resulting list is written to an external file.
3830
3831 =item *
3832
3833 Items (filenames) in the result are separated
3834 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3835
3836 =item *
3837
3838 This command is not limited in the number of names that it
3839 can return.
3840
3841 =item *
3842
3843 The result list is not sorted.
3844
3845 =back");
3846
3847   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3848    [InitISOFS, Always, TestOutput (
3849       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3850     InitISOFS, Always, TestOutput (
3851       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3852     InitISOFS, Always, TestOutput (
3853       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3854     InitISOFS, Always, TestLastFail (
3855       [["case_sensitive_path"; "/Known-1/"]]);
3856     InitBasicFS, Always, TestOutput (
3857       [["mkdir"; "/a"];
3858        ["mkdir"; "/a/bbb"];
3859        ["touch"; "/a/bbb/c"];
3860        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3861     InitBasicFS, Always, TestOutput (
3862       [["mkdir"; "/a"];
3863        ["mkdir"; "/a/bbb"];
3864        ["touch"; "/a/bbb/c"];
3865        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3866     InitBasicFS, Always, TestLastFail (
3867       [["mkdir"; "/a"];
3868        ["mkdir"; "/a/bbb"];
3869        ["touch"; "/a/bbb/c"];
3870        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3871    "return true path on case-insensitive filesystem",
3872    "\
3873 This can be used to resolve case insensitive paths on
3874 a filesystem which is case sensitive.  The use case is
3875 to resolve paths which you have read from Windows configuration
3876 files or the Windows Registry, to the true path.
3877
3878 The command handles a peculiarity of the Linux ntfs-3g
3879 filesystem driver (and probably others), which is that although
3880 the underlying filesystem is case-insensitive, the driver
3881 exports the filesystem to Linux as case-sensitive.
3882
3883 One consequence of this is that special directories such
3884 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3885 (or other things) depending on the precise details of how
3886 they were created.  In Windows itself this would not be
3887 a problem.
3888
3889 Bug or feature?  You decide:
3890 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3891
3892 This function resolves the true case of each element in the
3893 path and returns the case-sensitive path.
3894
3895 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3896 might return C<\"/WINDOWS/system32\"> (the exact return value
3897 would depend on details of how the directories were originally
3898 created under Windows).
3899
3900 I<Note>:
3901 This function does not handle drive names, backslashes etc.
3902
3903 See also C<guestfs_realpath>.");
3904
3905   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3906    [InitBasicFS, Always, TestOutput (
3907       [["vfs_type"; "/dev/sda1"]], "ext2")],
3908    "get the Linux VFS type corresponding to a mounted device",
3909    "\
3910 This command gets the filesystem type corresponding to
3911 the filesystem on C<device>.
3912
3913 For most filesystems, the result is the name of the Linux
3914 VFS module which would be used to mount this filesystem
3915 if you mounted it without specifying the filesystem type.
3916 For example a string such as C<ext3> or C<ntfs>.");
3917
3918   ("truncate", (RErr, [Pathname "path"]), 199, [],
3919    [InitBasicFS, Always, TestOutputStruct (
3920       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3921        ["truncate"; "/test"];
3922        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3923    "truncate a file to zero size",
3924    "\
3925 This command truncates C<path> to a zero-length file.  The
3926 file must exist already.");
3927
3928   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3929    [InitBasicFS, Always, TestOutputStruct (
3930       [["touch"; "/test"];
3931        ["truncate_size"; "/test"; "1000"];
3932        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3933    "truncate a file to a particular size",
3934    "\
3935 This command truncates C<path> to size C<size> bytes.  The file
3936 must exist already.
3937
3938 If the current file size is less than C<size> then
3939 the file is extended to the required size with zero bytes.
3940 This creates a sparse file (ie. disk blocks are not allocated
3941 for the file until you write to it).  To create a non-sparse
3942 file of zeroes, use C<guestfs_fallocate64> instead.");
3943
3944   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3945    [InitBasicFS, Always, TestOutputStruct (
3946       [["touch"; "/test"];
3947        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3948        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3949    "set timestamp of a file with nanosecond precision",
3950    "\
3951 This command sets the timestamps of a file with nanosecond
3952 precision.
3953
3954 C<atsecs, atnsecs> are the last access time (atime) in secs and
3955 nanoseconds from the epoch.
3956
3957 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3958 secs and nanoseconds from the epoch.
3959
3960 If the C<*nsecs> field contains the special value C<-1> then
3961 the corresponding timestamp is set to the current time.  (The
3962 C<*secs> field is ignored in this case).
3963
3964 If the C<*nsecs> field contains the special value C<-2> then
3965 the corresponding timestamp is left unchanged.  (The
3966 C<*secs> field is ignored in this case).");
3967
3968   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3969    [InitBasicFS, Always, TestOutputStruct (
3970       [["mkdir_mode"; "/test"; "0o111"];
3971        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3972    "create a directory with a particular mode",
3973    "\
3974 This command creates a directory, setting the initial permissions
3975 of the directory to C<mode>.
3976
3977 For common Linux filesystems, the actual mode which is set will
3978 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3979 interpret the mode in other ways.
3980
3981 See also C<guestfs_mkdir>, C<guestfs_umask>");
3982
3983   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3984    [], (* XXX *)
3985    "change file owner and group",
3986    "\
3987 Change the file owner to C<owner> and group to C<group>.
3988 This is like C<guestfs_chown> but if C<path> is a symlink then
3989 the link itself is changed, not the target.
3990
3991 Only numeric uid and gid are supported.  If you want to use
3992 names, you will need to locate and parse the password file
3993 yourself (Augeas support makes this relatively easy).");
3994
3995   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3996    [], (* XXX *)
3997    "lstat on multiple files",
3998    "\
3999 This call allows you to perform the C<guestfs_lstat> operation
4000 on multiple files, where all files are in the directory C<path>.
4001 C<names> is the list of files from this directory.
4002
4003 On return you get a list of stat structs, with a one-to-one
4004 correspondence to the C<names> list.  If any name did not exist
4005 or could not be lstat'd, then the C<ino> field of that structure
4006 is set to C<-1>.
4007
4008 This call is intended for programs that want to efficiently
4009 list a directory contents without making many round-trips.
4010 See also C<guestfs_lxattrlist> for a similarly efficient call
4011 for getting extended attributes.  Very long directory listings
4012 might cause the protocol message size to be exceeded, causing
4013 this call to fail.  The caller must split up such requests
4014 into smaller groups of names.");
4015
4016   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4017    [], (* XXX *)
4018    "lgetxattr on multiple files",
4019    "\
4020 This call allows you to get the extended attributes
4021 of multiple files, where all files are in the directory C<path>.
4022 C<names> is the list of files from this directory.
4023
4024 On return you get a flat list of xattr structs which must be
4025 interpreted sequentially.  The first xattr struct always has a zero-length
4026 C<attrname>.  C<attrval> in this struct is zero-length
4027 to indicate there was an error doing C<lgetxattr> for this
4028 file, I<or> is a C string which is a decimal number
4029 (the number of following attributes for this file, which could
4030 be C<\"0\">).  Then after the first xattr struct are the
4031 zero or more attributes for the first named file.
4032 This repeats for the second and subsequent files.
4033
4034 This call is intended for programs that want to efficiently
4035 list a directory contents without making many round-trips.
4036 See also C<guestfs_lstatlist> for a similarly efficient call
4037 for getting standard stats.  Very long directory listings
4038 might cause the protocol message size to be exceeded, causing
4039 this call to fail.  The caller must split up such requests
4040 into smaller groups of names.");
4041
4042   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4043    [], (* XXX *)
4044    "readlink on multiple files",
4045    "\
4046 This call allows you to do a C<readlink> operation
4047 on multiple files, where all files are in the directory C<path>.
4048 C<names> is the list of files from this directory.
4049
4050 On return you get a list of strings, with a one-to-one
4051 correspondence to the C<names> list.  Each string is the
4052 value of the symbolic link.
4053
4054 If the C<readlink(2)> operation fails on any name, then
4055 the corresponding result string is the empty string C<\"\">.
4056 However the whole operation is completed even if there
4057 were C<readlink(2)> errors, and so you can call this
4058 function with names where you don't know if they are
4059 symbolic links already (albeit slightly less efficient).
4060
4061 This call is intended for programs that want to efficiently
4062 list a directory contents without making many round-trips.
4063 Very long directory listings might cause the protocol
4064 message size to be exceeded, causing
4065 this call to fail.  The caller must split up such requests
4066 into smaller groups of names.");
4067
4068   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4069    [InitISOFS, Always, TestOutputBuffer (
4070       [["pread"; "/known-4"; "1"; "3"]], "\n");
4071     InitISOFS, Always, TestOutputBuffer (
4072       [["pread"; "/empty"; "0"; "100"]], "")],
4073    "read part of a file",
4074    "\
4075 This command lets you read part of a file.  It reads C<count>
4076 bytes of the file, starting at C<offset>, from file C<path>.
4077
4078 This may read fewer bytes than requested.  For further details
4079 see the L<pread(2)> system call.");
4080
4081   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4082    [InitEmpty, Always, TestRun (
4083       [["part_init"; "/dev/sda"; "gpt"]])],
4084    "create an empty partition table",
4085    "\
4086 This creates an empty partition table on C<device> of one of the
4087 partition types listed below.  Usually C<parttype> should be
4088 either C<msdos> or C<gpt> (for large disks).
4089
4090 Initially there are no partitions.  Following this, you should
4091 call C<guestfs_part_add> for each partition required.
4092
4093 Possible values for C<parttype> are:
4094
4095 =over 4
4096
4097 =item B<efi> | B<gpt>
4098
4099 Intel EFI / GPT partition table.
4100
4101 This is recommended for >= 2 TB partitions that will be accessed
4102 from Linux and Intel-based Mac OS X.  It also has limited backwards
4103 compatibility with the C<mbr> format.
4104
4105 =item B<mbr> | B<msdos>
4106
4107 The standard PC \"Master Boot Record\" (MBR) format used
4108 by MS-DOS and Windows.  This partition type will B<only> work
4109 for device sizes up to 2 TB.  For large disks we recommend
4110 using C<gpt>.
4111
4112 =back
4113
4114 Other partition table types that may work but are not
4115 supported include:
4116
4117 =over 4
4118
4119 =item B<aix>
4120
4121 AIX disk labels.
4122
4123 =item B<amiga> | B<rdb>
4124
4125 Amiga \"Rigid Disk Block\" format.
4126
4127 =item B<bsd>
4128
4129 BSD disk labels.
4130
4131 =item B<dasd>
4132
4133 DASD, used on IBM mainframes.
4134
4135 =item B<dvh>
4136
4137 MIPS/SGI volumes.
4138
4139 =item B<mac>
4140
4141 Old Mac partition format.  Modern Macs use C<gpt>.
4142
4143 =item B<pc98>
4144
4145 NEC PC-98 format, common in Japan apparently.
4146
4147 =item B<sun>
4148
4149 Sun disk labels.
4150
4151 =back");
4152
4153   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4154    [InitEmpty, Always, TestRun (
4155       [["part_init"; "/dev/sda"; "mbr"];
4156        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4157     InitEmpty, Always, TestRun (
4158       [["part_init"; "/dev/sda"; "gpt"];
4159        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4160        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4161     InitEmpty, Always, TestRun (
4162       [["part_init"; "/dev/sda"; "mbr"];
4163        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4164        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4165        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4166        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4167    "add a partition to the device",
4168    "\
4169 This command adds a partition to C<device>.  If there is no partition
4170 table on the device, call C<guestfs_part_init> first.
4171
4172 The C<prlogex> parameter is the type of partition.  Normally you
4173 should pass C<p> or C<primary> here, but MBR partition tables also
4174 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4175 types.
4176
4177 C<startsect> and C<endsect> are the start and end of the partition
4178 in I<sectors>.  C<endsect> may be negative, which means it counts
4179 backwards from the end of the disk (C<-1> is the last sector).
4180
4181 Creating a partition which covers the whole disk is not so easy.
4182 Use C<guestfs_part_disk> to do that.");
4183
4184   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4185    [InitEmpty, Always, TestRun (
4186       [["part_disk"; "/dev/sda"; "mbr"]]);
4187     InitEmpty, Always, TestRun (
4188       [["part_disk"; "/dev/sda"; "gpt"]])],
4189    "partition whole disk with a single primary partition",
4190    "\
4191 This command is simply a combination of C<guestfs_part_init>
4192 followed by C<guestfs_part_add> to create a single primary partition
4193 covering the whole disk.
4194
4195 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4196 but other possible values are described in C<guestfs_part_init>.");
4197
4198   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4199    [InitEmpty, Always, TestRun (
4200       [["part_disk"; "/dev/sda"; "mbr"];
4201        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4202    "make a partition bootable",
4203    "\
4204 This sets the bootable flag on partition numbered C<partnum> on
4205 device C<device>.  Note that partitions are numbered from 1.
4206
4207 The bootable flag is used by some operating systems (notably
4208 Windows) to determine which partition to boot from.  It is by
4209 no means universally recognized.");
4210
4211   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4212    [InitEmpty, Always, TestRun (
4213       [["part_disk"; "/dev/sda"; "gpt"];
4214        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4215    "set partition name",
4216    "\
4217 This sets the partition name on partition numbered C<partnum> on
4218 device C<device>.  Note that partitions are numbered from 1.
4219
4220 The partition name can only be set on certain types of partition
4221 table.  This works on C<gpt> but not on C<mbr> partitions.");
4222
4223   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4224    [], (* XXX Add a regression test for this. *)
4225    "list partitions on a device",
4226    "\
4227 This command parses the partition table on C<device> and
4228 returns the list of partitions found.
4229
4230 The fields in the returned structure are:
4231
4232 =over 4
4233
4234 =item B<part_num>
4235
4236 Partition number, counting from 1.
4237
4238 =item B<part_start>
4239
4240 Start of the partition I<in bytes>.  To get sectors you have to
4241 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4242
4243 =item B<part_end>
4244
4245 End of the partition in bytes.
4246
4247 =item B<part_size>
4248
4249 Size of the partition in bytes.
4250
4251 =back");
4252
4253   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4254    [InitEmpty, Always, TestOutput (
4255       [["part_disk"; "/dev/sda"; "gpt"];
4256        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4257    "get the partition table type",
4258    "\
4259 This command examines the partition table on C<device> and
4260 returns the partition table type (format) being used.
4261
4262 Common return values include: C<msdos> (a DOS/Windows style MBR
4263 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4264 values are possible, although unusual.  See C<guestfs_part_init>
4265 for a full list.");
4266
4267   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4268    [InitBasicFS, Always, TestOutputBuffer (
4269       [["fill"; "0x63"; "10"; "/test"];
4270        ["read_file"; "/test"]], "cccccccccc")],
4271    "fill a file with octets",
4272    "\
4273 This command creates a new file called C<path>.  The initial
4274 content of the file is C<len> octets of C<c>, where C<c>
4275 must be a number in the range C<[0..255]>.
4276
4277 To fill a file with zero bytes (sparsely), it is
4278 much more efficient to use C<guestfs_truncate_size>.");
4279
4280   ("available", (RErr, [StringList "groups"]), 216, [],
4281    [InitNone, Always, TestRun [["available"; ""]]],
4282    "test availability of some parts of the API",
4283    "\
4284 This command is used to check the availability of some
4285 groups of functionality in the appliance, which not all builds of
4286 the libguestfs appliance will be able to provide.
4287
4288 The libguestfs groups, and the functions that those
4289 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4290
4291 The argument C<groups> is a list of group names, eg:
4292 C<[\"inotify\", \"augeas\"]> would check for the availability of
4293 the Linux inotify functions and Augeas (configuration file
4294 editing) functions.
4295
4296 The command returns no error if I<all> requested groups are available.
4297
4298 It fails with an error if one or more of the requested
4299 groups is unavailable in the appliance.
4300
4301 If an unknown group name is included in the
4302 list of groups then an error is always returned.
4303
4304 I<Notes:>
4305
4306 =over 4
4307
4308 =item *
4309
4310 You must call C<guestfs_launch> before calling this function.
4311
4312 The reason is because we don't know what groups are
4313 supported by the appliance/daemon until it is running and can
4314 be queried.
4315
4316 =item *
4317
4318 If a group of functions is available, this does not necessarily
4319 mean that they will work.  You still have to check for errors
4320 when calling individual API functions even if they are
4321 available.
4322
4323 =item *
4324
4325 It is usually the job of distro packagers to build
4326 complete functionality into the libguestfs appliance.
4327 Upstream libguestfs, if built from source with all
4328 requirements satisfied, will support everything.
4329
4330 =item *
4331
4332 This call was added in version C<1.0.80>.  In previous
4333 versions of libguestfs all you could do would be to speculatively
4334 execute a command to find out if the daemon implemented it.
4335 See also C<guestfs_version>.
4336
4337 =back");
4338
4339   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4340    [InitBasicFS, Always, TestOutputBuffer (
4341       [["write_file"; "/src"; "hello, world"; "0"];
4342        ["dd"; "/src"; "/dest"];
4343        ["read_file"; "/dest"]], "hello, world")],
4344    "copy from source to destination using dd",
4345    "\
4346 This command copies from one source device or file C<src>
4347 to another destination device or file C<dest>.  Normally you
4348 would use this to copy to or from a device or partition, for
4349 example to duplicate a filesystem.
4350
4351 If the destination is a device, it must be as large or larger
4352 than the source file or device, otherwise the copy will fail.
4353 This command cannot do partial copies (see C<guestfs_copy_size>).");
4354
4355   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4356    [InitBasicFS, Always, TestOutputInt (
4357       [["write_file"; "/file"; "hello, world"; "0"];
4358        ["filesize"; "/file"]], 12)],
4359    "return the size of the file in bytes",
4360    "\
4361 This command returns the size of C<file> in bytes.
4362
4363 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4364 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4365 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4366
4367   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4368    [InitBasicFSonLVM, Always, TestOutputList (
4369       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4370        ["lvs"]], ["/dev/VG/LV2"])],
4371    "rename an LVM logical volume",
4372    "\
4373 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4374
4375   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4376    [InitBasicFSonLVM, Always, TestOutputList (
4377       [["umount"; "/"];
4378        ["vg_activate"; "false"; "VG"];
4379        ["vgrename"; "VG"; "VG2"];
4380        ["vg_activate"; "true"; "VG2"];
4381        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4382        ["vgs"]], ["VG2"])],
4383    "rename an LVM volume group",
4384    "\
4385 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4386
4387   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4388    [InitISOFS, Always, TestOutputBuffer (
4389       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4390    "list the contents of a single file in an initrd",
4391    "\
4392 This command unpacks the file C<filename> from the initrd file
4393 called C<initrdpath>.  The filename must be given I<without> the
4394 initial C</> character.
4395
4396 For example, in guestfish you could use the following command
4397 to examine the boot script (usually called C</init>)
4398 contained in a Linux initrd or initramfs image:
4399
4400  initrd-cat /boot/initrd-<version>.img init
4401
4402 See also C<guestfs_initrd_list>.");
4403
4404   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4405    [],
4406    "get the UUID of a physical volume",
4407    "\
4408 This command returns the UUID of the LVM PV C<device>.");
4409
4410   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4411    [],
4412    "get the UUID of a volume group",
4413    "\
4414 This command returns the UUID of the LVM VG named C<vgname>.");
4415
4416   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4417    [],
4418    "get the UUID of a logical volume",
4419    "\
4420 This command returns the UUID of the LVM LV C<device>.");
4421
4422   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4423    [],
4424    "get the PV UUIDs containing the volume group",
4425    "\
4426 Given a VG called C<vgname>, this returns the UUIDs of all
4427 the physical volumes that this volume group resides on.
4428
4429 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4430 calls to associate physical volumes and volume groups.
4431
4432 See also C<guestfs_vglvuuids>.");
4433
4434   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4435    [],
4436    "get the LV UUIDs of all LVs in the volume group",
4437    "\
4438 Given a VG called C<vgname>, this returns the UUIDs of all
4439 the logical volumes created in this volume group.
4440
4441 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4442 calls to associate logical volumes and volume groups.
4443
4444 See also C<guestfs_vgpvuuids>.");
4445
4446   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4447    [InitBasicFS, Always, TestOutputBuffer (
4448       [["write_file"; "/src"; "hello, world"; "0"];
4449        ["copy_size"; "/src"; "/dest"; "5"];
4450        ["read_file"; "/dest"]], "hello")],
4451    "copy size bytes from source to destination using dd",
4452    "\
4453 This command copies exactly C<size> bytes from one source device
4454 or file C<src> to another destination device or file C<dest>.
4455
4456 Note this will fail if the source is too short or if the destination
4457 is not large enough.");
4458
4459   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4460    [InitEmpty, Always, TestRun (
4461       [["part_init"; "/dev/sda"; "mbr"];
4462        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4463        ["part_del"; "/dev/sda"; "1"]])],
4464    "delete a partition",
4465    "\
4466 This command deletes the partition numbered C<partnum> on C<device>.
4467
4468 Note that in the case of MBR partitioning, deleting an
4469 extended partition also deletes any logical partitions
4470 it contains.");
4471
4472   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4473    [InitEmpty, Always, TestOutputTrue (
4474       [["part_init"; "/dev/sda"; "mbr"];
4475        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4476        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4477        ["part_get_bootable"; "/dev/sda"; "1"]])],
4478    "return true if a partition is bootable",
4479    "\
4480 This command returns true if the partition C<partnum> on
4481 C<device> has the bootable flag set.
4482
4483 See also C<guestfs_part_set_bootable>.");
4484
4485   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4486    [InitEmpty, Always, TestOutputInt (
4487       [["part_init"; "/dev/sda"; "mbr"];
4488        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4489        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4490        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4491    "get the MBR type byte (ID byte) from a partition",
4492    "\
4493 Returns the MBR type byte (also known as the ID byte) from
4494 the numbered partition C<partnum>.
4495
4496 Note that only MBR (old DOS-style) partitions have type bytes.
4497 You will get undefined results for other partition table
4498 types (see C<guestfs_part_get_parttype>).");
4499
4500   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4501    [], (* tested by part_get_mbr_id *)
4502    "set the MBR type byte (ID byte) of a partition",
4503    "\
4504 Sets the MBR type byte (also known as the ID byte) of
4505 the numbered partition C<partnum> to C<idbyte>.  Note
4506 that the type bytes quoted in most documentation are
4507 in fact hexadecimal numbers, but usually documented
4508 without any leading \"0x\" which might be confusing.
4509
4510 Note that only MBR (old DOS-style) partitions have type bytes.
4511 You will get undefined results for other partition table
4512 types (see C<guestfs_part_get_parttype>).");
4513
4514 ]
4515
4516 let all_functions = non_daemon_functions @ daemon_functions
4517
4518 (* In some places we want the functions to be displayed sorted
4519  * alphabetically, so this is useful:
4520  *)
4521 let all_functions_sorted =
4522   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4523                compare n1 n2) all_functions
4524
4525 (* Field types for structures. *)
4526 type field =
4527   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4528   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4529   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4530   | FUInt32
4531   | FInt32
4532   | FUInt64
4533   | FInt64
4534   | FBytes                      (* Any int measure that counts bytes. *)
4535   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4536   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4537
4538 (* Because we generate extra parsing code for LVM command line tools,
4539  * we have to pull out the LVM columns separately here.
4540  *)
4541 let lvm_pv_cols = [
4542   "pv_name", FString;
4543   "pv_uuid", FUUID;
4544   "pv_fmt", FString;
4545   "pv_size", FBytes;
4546   "dev_size", FBytes;
4547   "pv_free", FBytes;
4548   "pv_used", FBytes;
4549   "pv_attr", FString (* XXX *);
4550   "pv_pe_count", FInt64;
4551   "pv_pe_alloc_count", FInt64;
4552   "pv_tags", FString;
4553   "pe_start", FBytes;
4554   "pv_mda_count", FInt64;
4555   "pv_mda_free", FBytes;
4556   (* Not in Fedora 10:
4557      "pv_mda_size", FBytes;
4558   *)
4559 ]
4560 let lvm_vg_cols = [
4561   "vg_name", FString;
4562   "vg_uuid", FUUID;
4563   "vg_fmt", FString;
4564   "vg_attr", FString (* XXX *);
4565   "vg_size", FBytes;
4566   "vg_free", FBytes;
4567   "vg_sysid", FString;
4568   "vg_extent_size", FBytes;
4569   "vg_extent_count", FInt64;
4570   "vg_free_count", FInt64;
4571   "max_lv", FInt64;
4572   "max_pv", FInt64;
4573   "pv_count", FInt64;
4574   "lv_count", FInt64;
4575   "snap_count", FInt64;
4576   "vg_seqno", FInt64;
4577   "vg_tags", FString;
4578   "vg_mda_count", FInt64;
4579   "vg_mda_free", FBytes;
4580   (* Not in Fedora 10:
4581      "vg_mda_size", FBytes;
4582   *)
4583 ]
4584 let lvm_lv_cols = [
4585   "lv_name", FString;
4586   "lv_uuid", FUUID;
4587   "lv_attr", FString (* XXX *);
4588   "lv_major", FInt64;
4589   "lv_minor", FInt64;
4590   "lv_kernel_major", FInt64;
4591   "lv_kernel_minor", FInt64;
4592   "lv_size", FBytes;
4593   "seg_count", FInt64;
4594   "origin", FString;
4595   "snap_percent", FOptPercent;
4596   "copy_percent", FOptPercent;
4597   "move_pv", FString;
4598   "lv_tags", FString;
4599   "mirror_log", FString;
4600   "modules", FString;
4601 ]
4602
4603 (* Names and fields in all structures (in RStruct and RStructList)
4604  * that we support.
4605  *)
4606 let structs = [
4607   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4608    * not use this struct in any new code.
4609    *)
4610   "int_bool", [
4611     "i", FInt32;                (* for historical compatibility *)
4612     "b", FInt32;                (* for historical compatibility *)
4613   ];
4614
4615   (* LVM PVs, VGs, LVs. *)
4616   "lvm_pv", lvm_pv_cols;
4617   "lvm_vg", lvm_vg_cols;
4618   "lvm_lv", lvm_lv_cols;
4619
4620   (* Column names and types from stat structures.
4621    * NB. Can't use things like 'st_atime' because glibc header files
4622    * define some of these as macros.  Ugh.
4623    *)
4624   "stat", [
4625     "dev", FInt64;
4626     "ino", FInt64;
4627     "mode", FInt64;
4628     "nlink", FInt64;
4629     "uid", FInt64;
4630     "gid", FInt64;
4631     "rdev", FInt64;
4632     "size", FInt64;
4633     "blksize", FInt64;
4634     "blocks", FInt64;
4635     "atime", FInt64;
4636     "mtime", FInt64;
4637     "ctime", FInt64;
4638   ];
4639   "statvfs", [
4640     "bsize", FInt64;
4641     "frsize", FInt64;
4642     "blocks", FInt64;
4643     "bfree", FInt64;
4644     "bavail", FInt64;
4645     "files", FInt64;
4646     "ffree", FInt64;
4647     "favail", FInt64;
4648     "fsid", FInt64;
4649     "flag", FInt64;
4650     "namemax", FInt64;
4651   ];
4652
4653   (* Column names in dirent structure. *)
4654   "dirent", [
4655     "ino", FInt64;
4656     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4657     "ftyp", FChar;
4658     "name", FString;
4659   ];
4660
4661   (* Version numbers. *)
4662   "version", [
4663     "major", FInt64;
4664     "minor", FInt64;
4665     "release", FInt64;
4666     "extra", FString;
4667   ];
4668
4669   (* Extended attribute. *)
4670   "xattr", [
4671     "attrname", FString;
4672     "attrval", FBuffer;
4673   ];
4674
4675   (* Inotify events. *)
4676   "inotify_event", [
4677     "in_wd", FInt64;
4678     "in_mask", FUInt32;
4679     "in_cookie", FUInt32;
4680     "in_name", FString;
4681   ];
4682
4683   (* Partition table entry. *)
4684   "partition", [
4685     "part_num", FInt32;
4686     "part_start", FBytes;
4687     "part_end", FBytes;
4688     "part_size", FBytes;
4689   ];
4690 ] (* end of structs *)
4691
4692 (* Ugh, Java has to be different ..
4693  * These names are also used by the Haskell bindings.
4694  *)
4695 let java_structs = [
4696   "int_bool", "IntBool";
4697   "lvm_pv", "PV";
4698   "lvm_vg", "VG";
4699   "lvm_lv", "LV";
4700   "stat", "Stat";
4701   "statvfs", "StatVFS";
4702   "dirent", "Dirent";
4703   "version", "Version";
4704   "xattr", "XAttr";
4705   "inotify_event", "INotifyEvent";
4706   "partition", "Partition";
4707 ]
4708
4709 (* What structs are actually returned. *)
4710 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4711
4712 (* Returns a list of RStruct/RStructList structs that are returned
4713  * by any function.  Each element of returned list is a pair:
4714  *
4715  * (structname, RStructOnly)
4716  *    == there exists function which returns RStruct (_, structname)
4717  * (structname, RStructListOnly)
4718  *    == there exists function which returns RStructList (_, structname)
4719  * (structname, RStructAndList)
4720  *    == there are functions returning both RStruct (_, structname)
4721  *                                      and RStructList (_, structname)
4722  *)
4723 let rstructs_used_by functions =
4724   (* ||| is a "logical OR" for rstructs_used_t *)
4725   let (|||) a b =
4726     match a, b with
4727     | RStructAndList, _
4728     | _, RStructAndList -> RStructAndList
4729     | RStructOnly, RStructListOnly
4730     | RStructListOnly, RStructOnly -> RStructAndList
4731     | RStructOnly, RStructOnly -> RStructOnly
4732     | RStructListOnly, RStructListOnly -> RStructListOnly
4733   in
4734
4735   let h = Hashtbl.create 13 in
4736
4737   (* if elem->oldv exists, update entry using ||| operator,
4738    * else just add elem->newv to the hash
4739    *)
4740   let update elem newv =
4741     try  let oldv = Hashtbl.find h elem in
4742          Hashtbl.replace h elem (newv ||| oldv)
4743     with Not_found -> Hashtbl.add h elem newv
4744   in
4745
4746   List.iter (
4747     fun (_, style, _, _, _, _, _) ->
4748       match fst style with
4749       | RStruct (_, structname) -> update structname RStructOnly
4750       | RStructList (_, structname) -> update structname RStructListOnly
4751       | _ -> ()
4752   ) functions;
4753
4754   (* return key->values as a list of (key,value) *)
4755   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4756
4757 (* Used for testing language bindings. *)
4758 type callt =
4759   | CallString of string
4760   | CallOptString of string option
4761   | CallStringList of string list
4762   | CallInt of int
4763   | CallInt64 of int64
4764   | CallBool of bool
4765
4766 (* Used to memoize the result of pod2text. *)
4767 let pod2text_memo_filename = "src/.pod2text.data"
4768 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4769   try
4770     let chan = open_in pod2text_memo_filename in
4771     let v = input_value chan in
4772     close_in chan;
4773     v
4774   with
4775     _ -> Hashtbl.create 13
4776 let pod2text_memo_updated () =
4777   let chan = open_out pod2text_memo_filename in
4778   output_value chan pod2text_memo;
4779   close_out chan
4780
4781 (* Useful functions.
4782  * Note we don't want to use any external OCaml libraries which
4783  * makes this a bit harder than it should be.
4784  *)
4785 module StringMap = Map.Make (String)
4786
4787 let failwithf fs = ksprintf failwith fs
4788
4789 let unique = let i = ref 0 in fun () -> incr i; !i
4790
4791 let replace_char s c1 c2 =
4792   let s2 = String.copy s in
4793   let r = ref false in
4794   for i = 0 to String.length s2 - 1 do
4795     if String.unsafe_get s2 i = c1 then (
4796       String.unsafe_set s2 i c2;
4797       r := true
4798     )
4799   done;
4800   if not !r then s else s2
4801
4802 let isspace c =
4803   c = ' '
4804   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4805
4806 let triml ?(test = isspace) str =
4807   let i = ref 0 in
4808   let n = ref (String.length str) in
4809   while !n > 0 && test str.[!i]; do
4810     decr n;
4811     incr i
4812   done;
4813   if !i = 0 then str
4814   else String.sub str !i !n
4815
4816 let trimr ?(test = isspace) str =
4817   let n = ref (String.length str) in
4818   while !n > 0 && test str.[!n-1]; do
4819     decr n
4820   done;
4821   if !n = String.length str then str
4822   else String.sub str 0 !n
4823
4824 let trim ?(test = isspace) str =
4825   trimr ~test (triml ~test str)
4826
4827 let rec find s sub =
4828   let len = String.length s in
4829   let sublen = String.length sub in
4830   let rec loop i =
4831     if i <= len-sublen then (
4832       let rec loop2 j =
4833         if j < sublen then (
4834           if s.[i+j] = sub.[j] then loop2 (j+1)
4835           else -1
4836         ) else
4837           i (* found *)
4838       in
4839       let r = loop2 0 in
4840       if r = -1 then loop (i+1) else r
4841     ) else
4842       -1 (* not found *)
4843   in
4844   loop 0
4845
4846 let rec replace_str s s1 s2 =
4847   let len = String.length s in
4848   let sublen = String.length s1 in
4849   let i = find s s1 in
4850   if i = -1 then s
4851   else (
4852     let s' = String.sub s 0 i in
4853     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4854     s' ^ s2 ^ replace_str s'' s1 s2
4855   )
4856
4857 let rec string_split sep str =
4858   let len = String.length str in
4859   let seplen = String.length sep in
4860   let i = find str sep in
4861   if i = -1 then [str]
4862   else (
4863     let s' = String.sub str 0 i in
4864     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4865     s' :: string_split sep s''
4866   )
4867
4868 let files_equal n1 n2 =
4869   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4870   match Sys.command cmd with
4871   | 0 -> true
4872   | 1 -> false
4873   | i -> failwithf "%s: failed with error code %d" cmd i
4874
4875 let rec filter_map f = function
4876   | [] -> []
4877   | x :: xs ->
4878       match f x with
4879       | Some y -> y :: filter_map f xs
4880       | None -> filter_map f xs
4881
4882 let rec find_map f = function
4883   | [] -> raise Not_found
4884   | x :: xs ->
4885       match f x with
4886       | Some y -> y
4887       | None -> find_map f xs
4888
4889 let iteri f xs =
4890   let rec loop i = function
4891     | [] -> ()
4892     | x :: xs -> f i x; loop (i+1) xs
4893   in
4894   loop 0 xs
4895
4896 let mapi f xs =
4897   let rec loop i = function
4898     | [] -> []
4899     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4900   in
4901   loop 0 xs
4902
4903 let count_chars c str =
4904   let count = ref 0 in
4905   for i = 0 to String.length str - 1 do
4906     if c = String.unsafe_get str i then incr count
4907   done;
4908   !count
4909
4910 let name_of_argt = function
4911   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4912   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4913   | FileIn n | FileOut n -> n
4914
4915 let java_name_of_struct typ =
4916   try List.assoc typ java_structs
4917   with Not_found ->
4918     failwithf
4919       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4920
4921 let cols_of_struct typ =
4922   try List.assoc typ structs
4923   with Not_found ->
4924     failwithf "cols_of_struct: unknown struct %s" typ
4925
4926 let seq_of_test = function
4927   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4928   | TestOutputListOfDevices (s, _)
4929   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4930   | TestOutputTrue s | TestOutputFalse s
4931   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4932   | TestOutputStruct (s, _)
4933   | TestLastFail s -> s
4934
4935 (* Handling for function flags. *)
4936 let protocol_limit_warning =
4937   "Because of the message protocol, there is a transfer limit
4938 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4939
4940 let danger_will_robinson =
4941   "B<This command is dangerous.  Without careful use you
4942 can easily destroy all your data>."
4943
4944 let deprecation_notice flags =
4945   try
4946     let alt =
4947       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4948     let txt =
4949       sprintf "This function is deprecated.
4950 In new code, use the C<%s> call instead.
4951
4952 Deprecated functions will not be removed from the API, but the
4953 fact that they are deprecated indicates that there are problems
4954 with correct use of these functions." alt in
4955     Some txt
4956   with
4957     Not_found -> None
4958
4959 (* Create list of optional groups. *)
4960 let optgroups =
4961   let h = Hashtbl.create 13 in
4962   List.iter (
4963     fun (name, _, _, flags, _, _, _) ->
4964       List.iter (
4965         function
4966         | Optional group ->
4967             let names = try Hashtbl.find h group with Not_found -> [] in
4968             Hashtbl.replace h group (name :: names)
4969         | _ -> ()
4970       ) flags
4971   ) daemon_functions;
4972   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4973   let groups =
4974     List.map (
4975       fun group -> group, List.sort compare (Hashtbl.find h group)
4976     ) groups in
4977   List.sort (fun x y -> compare (fst x) (fst y)) groups
4978
4979 (* Check function names etc. for consistency. *)
4980 let check_functions () =
4981   let contains_uppercase str =
4982     let len = String.length str in
4983     let rec loop i =
4984       if i >= len then false
4985       else (
4986         let c = str.[i] in
4987         if c >= 'A' && c <= 'Z' then true
4988         else loop (i+1)
4989       )
4990     in
4991     loop 0
4992   in
4993
4994   (* Check function names. *)
4995   List.iter (
4996     fun (name, _, _, _, _, _, _) ->
4997       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4998         failwithf "function name %s does not need 'guestfs' prefix" name;
4999       if name = "" then
5000         failwithf "function name is empty";
5001       if name.[0] < 'a' || name.[0] > 'z' then
5002         failwithf "function name %s must start with lowercase a-z" name;
5003       if String.contains name '-' then
5004         failwithf "function name %s should not contain '-', use '_' instead."
5005           name
5006   ) all_functions;
5007
5008   (* Check function parameter/return names. *)
5009   List.iter (
5010     fun (name, style, _, _, _, _, _) ->
5011       let check_arg_ret_name n =
5012         if contains_uppercase n then
5013           failwithf "%s param/ret %s should not contain uppercase chars"
5014             name n;
5015         if String.contains n '-' || String.contains n '_' then
5016           failwithf "%s param/ret %s should not contain '-' or '_'"
5017             name n;
5018         if n = "value" then
5019           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;
5020         if n = "int" || n = "char" || n = "short" || n = "long" then
5021           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5022         if n = "i" || n = "n" then
5023           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5024         if n = "argv" || n = "args" then
5025           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5026
5027         (* List Haskell, OCaml and C keywords here.
5028          * http://www.haskell.org/haskellwiki/Keywords
5029          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5030          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5031          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5032          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5033          * Omitting _-containing words, since they're handled above.
5034          * Omitting the OCaml reserved word, "val", is ok,
5035          * and saves us from renaming several parameters.
5036          *)
5037         let reserved = [
5038           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5039           "char"; "class"; "const"; "constraint"; "continue"; "data";
5040           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5041           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5042           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5043           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5044           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5045           "interface";
5046           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5047           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5048           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5049           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5050           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5051           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5052           "volatile"; "when"; "where"; "while";
5053           ] in
5054         if List.mem n reserved then
5055           failwithf "%s has param/ret using reserved word %s" name n;
5056       in
5057
5058       (match fst style with
5059        | RErr -> ()
5060        | RInt n | RInt64 n | RBool n
5061        | RConstString n | RConstOptString n | RString n
5062        | RStringList n | RStruct (n, _) | RStructList (n, _)
5063        | RHashtable n | RBufferOut n ->
5064            check_arg_ret_name n
5065       );
5066       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5067   ) all_functions;
5068
5069   (* Check short descriptions. *)
5070   List.iter (
5071     fun (name, _, _, _, _, shortdesc, _) ->
5072       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5073         failwithf "short description of %s should begin with lowercase." name;
5074       let c = shortdesc.[String.length shortdesc-1] in
5075       if c = '\n' || c = '.' then
5076         failwithf "short description of %s should not end with . or \\n." name
5077   ) all_functions;
5078
5079   (* Check long descriptions. *)
5080   List.iter (
5081     fun (name, _, _, _, _, _, longdesc) ->
5082       if longdesc.[String.length longdesc-1] = '\n' then
5083         failwithf "long description of %s should not end with \\n." name
5084   ) all_functions;
5085
5086   (* Check proc_nrs. *)
5087   List.iter (
5088     fun (name, _, proc_nr, _, _, _, _) ->
5089       if proc_nr <= 0 then
5090         failwithf "daemon function %s should have proc_nr > 0" name
5091   ) daemon_functions;
5092
5093   List.iter (
5094     fun (name, _, proc_nr, _, _, _, _) ->
5095       if proc_nr <> -1 then
5096         failwithf "non-daemon function %s should have proc_nr -1" name
5097   ) non_daemon_functions;
5098
5099   let proc_nrs =
5100     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5101       daemon_functions in
5102   let proc_nrs =
5103     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5104   let rec loop = function
5105     | [] -> ()
5106     | [_] -> ()
5107     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5108         loop rest
5109     | (name1,nr1) :: (name2,nr2) :: _ ->
5110         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5111           name1 name2 nr1 nr2
5112   in
5113   loop proc_nrs;
5114
5115   (* Check tests. *)
5116   List.iter (
5117     function
5118       (* Ignore functions that have no tests.  We generate a
5119        * warning when the user does 'make check' instead.
5120        *)
5121     | name, _, _, _, [], _, _ -> ()
5122     | name, _, _, _, tests, _, _ ->
5123         let funcs =
5124           List.map (
5125             fun (_, _, test) ->
5126               match seq_of_test test with
5127               | [] ->
5128                   failwithf "%s has a test containing an empty sequence" name
5129               | cmds -> List.map List.hd cmds
5130           ) tests in
5131         let funcs = List.flatten funcs in
5132
5133         let tested = List.mem name funcs in
5134
5135         if not tested then
5136           failwithf "function %s has tests but does not test itself" name
5137   ) all_functions
5138
5139 (* 'pr' prints to the current output file. *)
5140 let chan = ref Pervasives.stdout
5141 let lines = ref 0
5142 let pr fs =
5143   ksprintf
5144     (fun str ->
5145        let i = count_chars '\n' str in
5146        lines := !lines + i;
5147        output_string !chan str
5148     ) fs
5149
5150 let copyright_years =
5151   let this_year = 1900 + (localtime (time ())).tm_year in
5152   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5153
5154 (* Generate a header block in a number of standard styles. *)
5155 type comment_style =
5156     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5157 type license = GPLv2plus | LGPLv2plus
5158
5159 let generate_header ?(extra_inputs = []) comment license =
5160   let inputs = "src/generator.ml" :: extra_inputs in
5161   let c = match comment with
5162     | CStyle ->         pr "/* "; " *"
5163     | CPlusPlusStyle -> pr "// "; "//"
5164     | HashStyle ->      pr "# ";  "#"
5165     | OCamlStyle ->     pr "(* "; " *"
5166     | HaskellStyle ->   pr "{- "; "  " in
5167   pr "libguestfs generated file\n";
5168   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5169   List.iter (pr "%s   %s\n" c) inputs;
5170   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5171   pr "%s\n" c;
5172   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5173   pr "%s\n" c;
5174   (match license with
5175    | GPLv2plus ->
5176        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5177        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5178        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5179        pr "%s (at your option) any later version.\n" c;
5180        pr "%s\n" c;
5181        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5182        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5183        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5184        pr "%s GNU General Public License for more details.\n" c;
5185        pr "%s\n" c;
5186        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5187        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5188        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5189
5190    | LGPLv2plus ->
5191        pr "%s This library is free software; you can redistribute it and/or\n" c;
5192        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5193        pr "%s License as published by the Free Software Foundation; either\n" c;
5194        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5195        pr "%s\n" c;
5196        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5197        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5198        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5199        pr "%s Lesser General Public License for more details.\n" c;
5200        pr "%s\n" c;
5201        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5202        pr "%s License along with this library; if not, write to the Free Software\n" c;
5203        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5204   );
5205   (match comment with
5206    | CStyle -> pr " */\n"
5207    | CPlusPlusStyle
5208    | HashStyle -> ()
5209    | OCamlStyle -> pr " *)\n"
5210    | HaskellStyle -> pr "-}\n"
5211   );
5212   pr "\n"
5213
5214 (* Start of main code generation functions below this line. *)
5215
5216 (* Generate the pod documentation for the C API. *)
5217 let rec generate_actions_pod () =
5218   List.iter (
5219     fun (shortname, style, _, flags, _, _, longdesc) ->
5220       if not (List.mem NotInDocs flags) then (
5221         let name = "guestfs_" ^ shortname in
5222         pr "=head2 %s\n\n" name;
5223         pr " ";
5224         generate_prototype ~extern:false ~handle:"g" name style;
5225         pr "\n\n";
5226         pr "%s\n\n" longdesc;
5227         (match fst style with
5228          | RErr ->
5229              pr "This function returns 0 on success or -1 on error.\n\n"
5230          | RInt _ ->
5231              pr "On error this function returns -1.\n\n"
5232          | RInt64 _ ->
5233              pr "On error this function returns -1.\n\n"
5234          | RBool _ ->
5235              pr "This function returns a C truth value on success or -1 on error.\n\n"
5236          | RConstString _ ->
5237              pr "This function returns a string, or NULL on error.
5238 The string is owned by the guest handle and must I<not> be freed.\n\n"
5239          | RConstOptString _ ->
5240              pr "This function returns a string which may be NULL.
5241 There is way to return an error from this function.
5242 The string is owned by the guest handle and must I<not> be freed.\n\n"
5243          | RString _ ->
5244              pr "This function returns a string, or NULL on error.
5245 I<The caller must free the returned string after use>.\n\n"
5246          | RStringList _ ->
5247              pr "This function returns a NULL-terminated array of strings
5248 (like L<environ(3)>), or NULL if there was an error.
5249 I<The caller must free the strings and the array after use>.\n\n"
5250          | RStruct (_, typ) ->
5251              pr "This function returns a C<struct guestfs_%s *>,
5252 or NULL if there was an error.
5253 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5254          | RStructList (_, typ) ->
5255              pr "This function returns a C<struct guestfs_%s_list *>
5256 (see E<lt>guestfs-structs.hE<gt>),
5257 or NULL if there was an error.
5258 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5259          | RHashtable _ ->
5260              pr "This function returns a NULL-terminated array of
5261 strings, or NULL if there was an error.
5262 The array of strings will always have length C<2n+1>, where
5263 C<n> keys and values alternate, followed by the trailing NULL entry.
5264 I<The caller must free the strings and the array after use>.\n\n"
5265          | RBufferOut _ ->
5266              pr "This function returns a buffer, or NULL on error.
5267 The size of the returned buffer is written to C<*size_r>.
5268 I<The caller must free the returned buffer after use>.\n\n"
5269         );
5270         if List.mem ProtocolLimitWarning flags then
5271           pr "%s\n\n" protocol_limit_warning;
5272         if List.mem DangerWillRobinson flags then
5273           pr "%s\n\n" danger_will_robinson;
5274         match deprecation_notice flags with
5275         | None -> ()
5276         | Some txt -> pr "%s\n\n" txt
5277       )
5278   ) all_functions_sorted
5279
5280 and generate_structs_pod () =
5281   (* Structs documentation. *)
5282   List.iter (
5283     fun (typ, cols) ->
5284       pr "=head2 guestfs_%s\n" typ;
5285       pr "\n";
5286       pr " struct guestfs_%s {\n" typ;
5287       List.iter (
5288         function
5289         | name, FChar -> pr "   char %s;\n" name
5290         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5291         | name, FInt32 -> pr "   int32_t %s;\n" name
5292         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5293         | name, FInt64 -> pr "   int64_t %s;\n" name
5294         | name, FString -> pr "   char *%s;\n" name
5295         | name, FBuffer ->
5296             pr "   /* The next two fields describe a byte array. */\n";
5297             pr "   uint32_t %s_len;\n" name;
5298             pr "   char *%s;\n" name
5299         | name, FUUID ->
5300             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5301             pr "   char %s[32];\n" name
5302         | name, FOptPercent ->
5303             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5304             pr "   float %s;\n" name
5305       ) cols;
5306       pr " };\n";
5307       pr " \n";
5308       pr " struct guestfs_%s_list {\n" typ;
5309       pr "   uint32_t len; /* Number of elements in list. */\n";
5310       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5311       pr " };\n";
5312       pr " \n";
5313       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5314       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5315         typ typ;
5316       pr "\n"
5317   ) structs
5318
5319 and generate_availability_pod () =
5320   (* Availability documentation. *)
5321   pr "=over 4\n";
5322   pr "\n";
5323   List.iter (
5324     fun (group, functions) ->
5325       pr "=item B<%s>\n" group;
5326       pr "\n";
5327       pr "The following functions:\n";
5328       List.iter (pr "L</guestfs_%s>\n") functions;
5329       pr "\n"
5330   ) optgroups;
5331   pr "=back\n";
5332   pr "\n"
5333
5334 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5335  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5336  *
5337  * We have to use an underscore instead of a dash because otherwise
5338  * rpcgen generates incorrect code.
5339  *
5340  * This header is NOT exported to clients, but see also generate_structs_h.
5341  *)
5342 and generate_xdr () =
5343   generate_header CStyle LGPLv2plus;
5344
5345   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5346   pr "typedef string str<>;\n";
5347   pr "\n";
5348
5349   (* Internal structures. *)
5350   List.iter (
5351     function
5352     | typ, cols ->
5353         pr "struct guestfs_int_%s {\n" typ;
5354         List.iter (function
5355                    | name, FChar -> pr "  char %s;\n" name
5356                    | name, FString -> pr "  string %s<>;\n" name
5357                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5358                    | name, FUUID -> pr "  opaque %s[32];\n" name
5359                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5360                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5361                    | name, FOptPercent -> pr "  float %s;\n" name
5362                   ) cols;
5363         pr "};\n";
5364         pr "\n";
5365         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5366         pr "\n";
5367   ) structs;
5368
5369   List.iter (
5370     fun (shortname, style, _, _, _, _, _) ->
5371       let name = "guestfs_" ^ shortname in
5372
5373       (match snd style with
5374        | [] -> ()
5375        | args ->
5376            pr "struct %s_args {\n" name;
5377            List.iter (
5378              function
5379              | Pathname n | Device n | Dev_or_Path n | String n ->
5380                  pr "  string %s<>;\n" n
5381              | OptString n -> pr "  str *%s;\n" n
5382              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5383              | Bool n -> pr "  bool %s;\n" n
5384              | Int n -> pr "  int %s;\n" n
5385              | Int64 n -> pr "  hyper %s;\n" n
5386              | FileIn _ | FileOut _ -> ()
5387            ) args;
5388            pr "};\n\n"
5389       );
5390       (match fst style with
5391        | RErr -> ()
5392        | RInt n ->
5393            pr "struct %s_ret {\n" name;
5394            pr "  int %s;\n" n;
5395            pr "};\n\n"
5396        | RInt64 n ->
5397            pr "struct %s_ret {\n" name;
5398            pr "  hyper %s;\n" n;
5399            pr "};\n\n"
5400        | RBool n ->
5401            pr "struct %s_ret {\n" name;
5402            pr "  bool %s;\n" n;
5403            pr "};\n\n"
5404        | RConstString _ | RConstOptString _ ->
5405            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5406        | RString n ->
5407            pr "struct %s_ret {\n" name;
5408            pr "  string %s<>;\n" n;
5409            pr "};\n\n"
5410        | RStringList n ->
5411            pr "struct %s_ret {\n" name;
5412            pr "  str %s<>;\n" n;
5413            pr "};\n\n"
5414        | RStruct (n, typ) ->
5415            pr "struct %s_ret {\n" name;
5416            pr "  guestfs_int_%s %s;\n" typ n;
5417            pr "};\n\n"
5418        | RStructList (n, typ) ->
5419            pr "struct %s_ret {\n" name;
5420            pr "  guestfs_int_%s_list %s;\n" typ n;
5421            pr "};\n\n"
5422        | RHashtable n ->
5423            pr "struct %s_ret {\n" name;
5424            pr "  str %s<>;\n" n;
5425            pr "};\n\n"
5426        | RBufferOut n ->
5427            pr "struct %s_ret {\n" name;
5428            pr "  opaque %s<>;\n" n;
5429            pr "};\n\n"
5430       );
5431   ) daemon_functions;
5432
5433   (* Table of procedure numbers. *)
5434   pr "enum guestfs_procedure {\n";
5435   List.iter (
5436     fun (shortname, _, proc_nr, _, _, _, _) ->
5437       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5438   ) daemon_functions;
5439   pr "  GUESTFS_PROC_NR_PROCS\n";
5440   pr "};\n";
5441   pr "\n";
5442
5443   (* Having to choose a maximum message size is annoying for several
5444    * reasons (it limits what we can do in the API), but it (a) makes
5445    * the protocol a lot simpler, and (b) provides a bound on the size
5446    * of the daemon which operates in limited memory space.
5447    *)
5448   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5449   pr "\n";
5450
5451   (* Message header, etc. *)
5452   pr "\
5453 /* The communication protocol is now documented in the guestfs(3)
5454  * manpage.
5455  */
5456
5457 const GUESTFS_PROGRAM = 0x2000F5F5;
5458 const GUESTFS_PROTOCOL_VERSION = 1;
5459
5460 /* These constants must be larger than any possible message length. */
5461 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5462 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5463
5464 enum guestfs_message_direction {
5465   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5466   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5467 };
5468
5469 enum guestfs_message_status {
5470   GUESTFS_STATUS_OK = 0,
5471   GUESTFS_STATUS_ERROR = 1
5472 };
5473
5474 const GUESTFS_ERROR_LEN = 256;
5475
5476 struct guestfs_message_error {
5477   string error_message<GUESTFS_ERROR_LEN>;
5478 };
5479
5480 struct guestfs_message_header {
5481   unsigned prog;                     /* GUESTFS_PROGRAM */
5482   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5483   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5484   guestfs_message_direction direction;
5485   unsigned serial;                   /* message serial number */
5486   guestfs_message_status status;
5487 };
5488
5489 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5490
5491 struct guestfs_chunk {
5492   int cancel;                        /* if non-zero, transfer is cancelled */
5493   /* data size is 0 bytes if the transfer has finished successfully */
5494   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5495 };
5496 "
5497
5498 (* Generate the guestfs-structs.h file. *)
5499 and generate_structs_h () =
5500   generate_header CStyle LGPLv2plus;
5501
5502   (* This is a public exported header file containing various
5503    * structures.  The structures are carefully written to have
5504    * exactly the same in-memory format as the XDR structures that
5505    * we use on the wire to the daemon.  The reason for creating
5506    * copies of these structures here is just so we don't have to
5507    * export the whole of guestfs_protocol.h (which includes much
5508    * unrelated and XDR-dependent stuff that we don't want to be
5509    * public, or required by clients).
5510    *
5511    * To reiterate, we will pass these structures to and from the
5512    * client with a simple assignment or memcpy, so the format
5513    * must be identical to what rpcgen / the RFC defines.
5514    *)
5515
5516   (* Public structures. *)
5517   List.iter (
5518     fun (typ, cols) ->
5519       pr "struct guestfs_%s {\n" typ;
5520       List.iter (
5521         function
5522         | name, FChar -> pr "  char %s;\n" name
5523         | name, FString -> pr "  char *%s;\n" name
5524         | name, FBuffer ->
5525             pr "  uint32_t %s_len;\n" name;
5526             pr "  char *%s;\n" name
5527         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5528         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5529         | name, FInt32 -> pr "  int32_t %s;\n" name
5530         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5531         | name, FInt64 -> pr "  int64_t %s;\n" name
5532         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5533       ) cols;
5534       pr "};\n";
5535       pr "\n";
5536       pr "struct guestfs_%s_list {\n" typ;
5537       pr "  uint32_t len;\n";
5538       pr "  struct guestfs_%s *val;\n" typ;
5539       pr "};\n";
5540       pr "\n";
5541       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5542       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5543       pr "\n"
5544   ) structs
5545
5546 (* Generate the guestfs-actions.h file. *)
5547 and generate_actions_h () =
5548   generate_header CStyle LGPLv2plus;
5549   List.iter (
5550     fun (shortname, style, _, _, _, _, _) ->
5551       let name = "guestfs_" ^ shortname in
5552       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5553         name style
5554   ) all_functions
5555
5556 (* Generate the guestfs-internal-actions.h file. *)
5557 and generate_internal_actions_h () =
5558   generate_header CStyle LGPLv2plus;
5559   List.iter (
5560     fun (shortname, style, _, _, _, _, _) ->
5561       let name = "guestfs__" ^ shortname in
5562       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5563         name style
5564   ) non_daemon_functions
5565
5566 (* Generate the client-side dispatch stubs. *)
5567 and generate_client_actions () =
5568   generate_header CStyle LGPLv2plus;
5569
5570   pr "\
5571 #include <stdio.h>
5572 #include <stdlib.h>
5573 #include <stdint.h>
5574 #include <string.h>
5575 #include <inttypes.h>
5576
5577 #include \"guestfs.h\"
5578 #include \"guestfs-internal.h\"
5579 #include \"guestfs-internal-actions.h\"
5580 #include \"guestfs_protocol.h\"
5581
5582 #define error guestfs_error
5583 //#define perrorf guestfs_perrorf
5584 #define safe_malloc guestfs_safe_malloc
5585 #define safe_realloc guestfs_safe_realloc
5586 //#define safe_strdup guestfs_safe_strdup
5587 #define safe_memdup guestfs_safe_memdup
5588
5589 /* Check the return message from a call for validity. */
5590 static int
5591 check_reply_header (guestfs_h *g,
5592                     const struct guestfs_message_header *hdr,
5593                     unsigned int proc_nr, unsigned int serial)
5594 {
5595   if (hdr->prog != GUESTFS_PROGRAM) {
5596     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5597     return -1;
5598   }
5599   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5600     error (g, \"wrong protocol version (%%d/%%d)\",
5601            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5602     return -1;
5603   }
5604   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5605     error (g, \"unexpected message direction (%%d/%%d)\",
5606            hdr->direction, GUESTFS_DIRECTION_REPLY);
5607     return -1;
5608   }
5609   if (hdr->proc != proc_nr) {
5610     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5611     return -1;
5612   }
5613   if (hdr->serial != serial) {
5614     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5615     return -1;
5616   }
5617
5618   return 0;
5619 }
5620
5621 /* Check we are in the right state to run a high-level action. */
5622 static int
5623 check_state (guestfs_h *g, const char *caller)
5624 {
5625   if (!guestfs__is_ready (g)) {
5626     if (guestfs__is_config (g) || guestfs__is_launching (g))
5627       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5628         caller);
5629     else
5630       error (g, \"%%s called from the wrong state, %%d != READY\",
5631         caller, guestfs__get_state (g));
5632     return -1;
5633   }
5634   return 0;
5635 }
5636
5637 ";
5638
5639   (* Generate code to generate guestfish call traces. *)
5640   let trace_call shortname style =
5641     pr "  if (guestfs__get_trace (g)) {\n";
5642
5643     let needs_i =
5644       List.exists (function
5645                    | StringList _ | DeviceList _ -> true
5646                    | _ -> false) (snd style) in
5647     if needs_i then (
5648       pr "    int i;\n";
5649       pr "\n"
5650     );
5651
5652     pr "    printf (\"%s\");\n" shortname;
5653     List.iter (
5654       function
5655       | String n                        (* strings *)
5656       | Device n
5657       | Pathname n
5658       | Dev_or_Path n
5659       | FileIn n
5660       | FileOut n ->
5661           (* guestfish doesn't support string escaping, so neither do we *)
5662           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5663       | OptString n ->                  (* string option *)
5664           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5665           pr "    else printf (\" null\");\n"
5666       | StringList n
5667       | DeviceList n ->                 (* string list *)
5668           pr "    putchar (' ');\n";
5669           pr "    putchar ('\"');\n";
5670           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5671           pr "      if (i > 0) putchar (' ');\n";
5672           pr "      fputs (%s[i], stdout);\n" n;
5673           pr "    }\n";
5674           pr "    putchar ('\"');\n";
5675       | Bool n ->                       (* boolean *)
5676           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5677       | Int n ->                        (* int *)
5678           pr "    printf (\" %%d\", %s);\n" n
5679       | Int64 n ->
5680           pr "    printf (\" %%\" PRIi64, %s);\n" n
5681     ) (snd style);
5682     pr "    putchar ('\\n');\n";
5683     pr "  }\n";
5684     pr "\n";
5685   in
5686
5687   (* For non-daemon functions, generate a wrapper around each function. *)
5688   List.iter (
5689     fun (shortname, style, _, _, _, _, _) ->
5690       let name = "guestfs_" ^ shortname in
5691
5692       generate_prototype ~extern:false ~semicolon:false ~newline:true
5693         ~handle:"g" name style;
5694       pr "{\n";
5695       trace_call shortname style;
5696       pr "  return guestfs__%s " shortname;
5697       generate_c_call_args ~handle:"g" style;
5698       pr ";\n";
5699       pr "}\n";
5700       pr "\n"
5701   ) non_daemon_functions;
5702
5703   (* Client-side stubs for each function. *)
5704   List.iter (
5705     fun (shortname, style, _, _, _, _, _) ->
5706       let name = "guestfs_" ^ shortname in
5707
5708       (* Generate the action stub. *)
5709       generate_prototype ~extern:false ~semicolon:false ~newline:true
5710         ~handle:"g" name style;
5711
5712       let error_code =
5713         match fst style with
5714         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5715         | RConstString _ | RConstOptString _ ->
5716             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5717         | RString _ | RStringList _
5718         | RStruct _ | RStructList _
5719         | RHashtable _ | RBufferOut _ ->
5720             "NULL" in
5721
5722       pr "{\n";
5723
5724       (match snd style with
5725        | [] -> ()
5726        | _ -> pr "  struct %s_args args;\n" name
5727       );
5728
5729       pr "  guestfs_message_header hdr;\n";
5730       pr "  guestfs_message_error err;\n";
5731       let has_ret =
5732         match fst style with
5733         | RErr -> false
5734         | RConstString _ | RConstOptString _ ->
5735             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5736         | RInt _ | RInt64 _
5737         | RBool _ | RString _ | RStringList _
5738         | RStruct _ | RStructList _
5739         | RHashtable _ | RBufferOut _ ->
5740             pr "  struct %s_ret ret;\n" name;
5741             true in
5742
5743       pr "  int serial;\n";
5744       pr "  int r;\n";
5745       pr "\n";
5746       trace_call shortname style;
5747       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5748       pr "  guestfs___set_busy (g);\n";
5749       pr "\n";
5750
5751       (* Send the main header and arguments. *)
5752       (match snd style with
5753        | [] ->
5754            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5755              (String.uppercase shortname)
5756        | args ->
5757            List.iter (
5758              function
5759              | Pathname n | Device n | Dev_or_Path n | String n ->
5760                  pr "  args.%s = (char *) %s;\n" n n
5761              | OptString n ->
5762                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5763              | StringList n | DeviceList n ->
5764                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5765                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5766              | Bool n ->
5767                  pr "  args.%s = %s;\n" n n
5768              | Int n ->
5769                  pr "  args.%s = %s;\n" n n
5770              | Int64 n ->
5771                  pr "  args.%s = %s;\n" n n
5772              | FileIn _ | FileOut _ -> ()
5773            ) args;
5774            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5775              (String.uppercase shortname);
5776            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5777              name;
5778       );
5779       pr "  if (serial == -1) {\n";
5780       pr "    guestfs___end_busy (g);\n";
5781       pr "    return %s;\n" error_code;
5782       pr "  }\n";
5783       pr "\n";
5784
5785       (* Send any additional files (FileIn) requested. *)
5786       let need_read_reply_label = ref false in
5787       List.iter (
5788         function
5789         | FileIn n ->
5790             pr "  r = guestfs___send_file (g, %s);\n" n;
5791             pr "  if (r == -1) {\n";
5792             pr "    guestfs___end_busy (g);\n";
5793             pr "    return %s;\n" error_code;
5794             pr "  }\n";
5795             pr "  if (r == -2) /* daemon cancelled */\n";
5796             pr "    goto read_reply;\n";
5797             need_read_reply_label := true;
5798             pr "\n";
5799         | _ -> ()
5800       ) (snd style);
5801
5802       (* Wait for the reply from the remote end. *)
5803       if !need_read_reply_label then pr " read_reply:\n";
5804       pr "  memset (&hdr, 0, sizeof hdr);\n";
5805       pr "  memset (&err, 0, sizeof err);\n";
5806       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5807       pr "\n";
5808       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5809       if not has_ret then
5810         pr "NULL, NULL"
5811       else
5812         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5813       pr ");\n";
5814
5815       pr "  if (r == -1) {\n";
5816       pr "    guestfs___end_busy (g);\n";
5817       pr "    return %s;\n" error_code;
5818       pr "  }\n";
5819       pr "\n";
5820
5821       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5822         (String.uppercase shortname);
5823       pr "    guestfs___end_busy (g);\n";
5824       pr "    return %s;\n" error_code;
5825       pr "  }\n";
5826       pr "\n";
5827
5828       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5829       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5830       pr "    free (err.error_message);\n";
5831       pr "    guestfs___end_busy (g);\n";
5832       pr "    return %s;\n" error_code;
5833       pr "  }\n";
5834       pr "\n";
5835
5836       (* Expecting to receive further files (FileOut)? *)
5837       List.iter (
5838         function
5839         | FileOut n ->
5840             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5841             pr "    guestfs___end_busy (g);\n";
5842             pr "    return %s;\n" error_code;
5843             pr "  }\n";
5844             pr "\n";
5845         | _ -> ()
5846       ) (snd style);
5847
5848       pr "  guestfs___end_busy (g);\n";
5849
5850       (match fst style with
5851        | RErr -> pr "  return 0;\n"
5852        | RInt n | RInt64 n | RBool n ->
5853            pr "  return ret.%s;\n" n
5854        | RConstString _ | RConstOptString _ ->
5855            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5856        | RString n ->
5857            pr "  return ret.%s; /* caller will free */\n" n
5858        | RStringList n | RHashtable n ->
5859            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5860            pr "  ret.%s.%s_val =\n" n n;
5861            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5862            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5863              n n;
5864            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5865            pr "  return ret.%s.%s_val;\n" n n
5866        | RStruct (n, _) ->
5867            pr "  /* caller will free this */\n";
5868            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5869        | RStructList (n, _) ->
5870            pr "  /* caller will free this */\n";
5871            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5872        | RBufferOut n ->
5873            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5874            pr "   * _val might be NULL here.  To make the API saner for\n";
5875            pr "   * callers, we turn this case into a unique pointer (using\n";
5876            pr "   * malloc(1)).\n";
5877            pr "   */\n";
5878            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5879            pr "    *size_r = ret.%s.%s_len;\n" n n;
5880            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5881            pr "  } else {\n";
5882            pr "    free (ret.%s.%s_val);\n" n n;
5883            pr "    char *p = safe_malloc (g, 1);\n";
5884            pr "    *size_r = ret.%s.%s_len;\n" n n;
5885            pr "    return p;\n";
5886            pr "  }\n";
5887       );
5888
5889       pr "}\n\n"
5890   ) daemon_functions;
5891
5892   (* Functions to free structures. *)
5893   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5894   pr " * structure format is identical to the XDR format.  See note in\n";
5895   pr " * generator.ml.\n";
5896   pr " */\n";
5897   pr "\n";
5898
5899   List.iter (
5900     fun (typ, _) ->
5901       pr "void\n";
5902       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5903       pr "{\n";
5904       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5905       pr "  free (x);\n";
5906       pr "}\n";
5907       pr "\n";
5908
5909       pr "void\n";
5910       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5911       pr "{\n";
5912       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5913       pr "  free (x);\n";
5914       pr "}\n";
5915       pr "\n";
5916
5917   ) structs;
5918
5919 (* Generate daemon/actions.h. *)
5920 and generate_daemon_actions_h () =
5921   generate_header CStyle GPLv2plus;
5922
5923   pr "#include \"../src/guestfs_protocol.h\"\n";
5924   pr "\n";
5925
5926   List.iter (
5927     fun (name, style, _, _, _, _, _) ->
5928       generate_prototype
5929         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5930         name style;
5931   ) daemon_functions
5932
5933 (* Generate the linker script which controls the visibility of
5934  * symbols in the public ABI and ensures no other symbols get
5935  * exported accidentally.
5936  *)
5937 and generate_linker_script () =
5938   generate_header HashStyle GPLv2plus;
5939
5940   let globals = [
5941     "guestfs_create";
5942     "guestfs_close";
5943     "guestfs_get_error_handler";
5944     "guestfs_get_out_of_memory_handler";
5945     "guestfs_last_error";
5946     "guestfs_set_error_handler";
5947     "guestfs_set_launch_done_callback";
5948     "guestfs_set_log_message_callback";
5949     "guestfs_set_out_of_memory_handler";
5950     "guestfs_set_subprocess_quit_callback";
5951
5952     (* Unofficial parts of the API: the bindings code use these
5953      * functions, so it is useful to export them.
5954      *)
5955     "guestfs_safe_calloc";
5956     "guestfs_safe_malloc";
5957     "guestfs_safe_strdup";
5958     "guestfs_safe_memdup";
5959   ] in
5960   let functions =
5961     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5962       all_functions in
5963   let structs =
5964     List.concat (
5965       List.map (fun (typ, _) ->
5966                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5967         structs
5968     ) in
5969   let globals = List.sort compare (globals @ functions @ structs) in
5970
5971   pr "{\n";
5972   pr "    global:\n";
5973   List.iter (pr "        %s;\n") globals;
5974   pr "\n";
5975
5976   pr "    local:\n";
5977   pr "        *;\n";
5978   pr "};\n"
5979
5980 (* Generate the server-side stubs. *)
5981 and generate_daemon_actions () =
5982   generate_header CStyle GPLv2plus;
5983
5984   pr "#include <config.h>\n";
5985   pr "\n";
5986   pr "#include <stdio.h>\n";
5987   pr "#include <stdlib.h>\n";
5988   pr "#include <string.h>\n";
5989   pr "#include <inttypes.h>\n";
5990   pr "#include <rpc/types.h>\n";
5991   pr "#include <rpc/xdr.h>\n";
5992   pr "\n";
5993   pr "#include \"daemon.h\"\n";
5994   pr "#include \"c-ctype.h\"\n";
5995   pr "#include \"../src/guestfs_protocol.h\"\n";
5996   pr "#include \"actions.h\"\n";
5997   pr "\n";
5998
5999   List.iter (
6000     fun (name, style, _, _, _, _, _) ->
6001       (* Generate server-side stubs. *)
6002       pr "static void %s_stub (XDR *xdr_in)\n" name;
6003       pr "{\n";
6004       let error_code =
6005         match fst style with
6006         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6007         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6008         | RBool _ -> pr "  int r;\n"; "-1"
6009         | RConstString _ | RConstOptString _ ->
6010             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6011         | RString _ -> pr "  char *r;\n"; "NULL"
6012         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6013         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6014         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6015         | RBufferOut _ ->
6016             pr "  size_t size = 1;\n";
6017             pr "  char *r;\n";
6018             "NULL" in
6019
6020       (match snd style with
6021        | [] -> ()
6022        | args ->
6023            pr "  struct guestfs_%s_args args;\n" name;
6024            List.iter (
6025              function
6026              | Device n | Dev_or_Path n
6027              | Pathname n
6028              | String n -> ()
6029              | OptString n -> pr "  char *%s;\n" n
6030              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6031              | Bool n -> pr "  int %s;\n" n
6032              | Int n -> pr "  int %s;\n" n
6033              | Int64 n -> pr "  int64_t %s;\n" n
6034              | FileIn _ | FileOut _ -> ()
6035            ) args
6036       );
6037       pr "\n";
6038
6039       (match snd style with
6040        | [] -> ()
6041        | args ->
6042            pr "  memset (&args, 0, sizeof args);\n";
6043            pr "\n";
6044            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6045            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6046            pr "    return;\n";
6047            pr "  }\n";
6048            let pr_args n =
6049              pr "  char *%s = args.%s;\n" n n
6050            in
6051            let pr_list_handling_code n =
6052              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6053              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6054              pr "  if (%s == NULL) {\n" n;
6055              pr "    reply_with_perror (\"realloc\");\n";
6056              pr "    goto done;\n";
6057              pr "  }\n";
6058              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6059              pr "  args.%s.%s_val = %s;\n" n n n;
6060            in
6061            List.iter (
6062              function
6063              | Pathname n ->
6064                  pr_args n;
6065                  pr "  ABS_PATH (%s, goto done);\n" n;
6066              | Device n ->
6067                  pr_args n;
6068                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6069              | Dev_or_Path n ->
6070                  pr_args n;
6071                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6072              | String n -> pr_args n
6073              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6074              | StringList n ->
6075                  pr_list_handling_code n;
6076              | DeviceList n ->
6077                  pr_list_handling_code n;
6078                  pr "  /* Ensure that each is a device,\n";
6079                  pr "   * and perform device name translation.\n";
6080                  pr "   */\n";
6081                  pr "  {\n";
6082                  pr "    int i;\n";
6083                  pr "    for (i = 0; %s[i] != NULL; ++i)\n" n;
6084                  pr "      RESOLVE_DEVICE (%s[i], goto done);\n" n;
6085                  pr "  }\n";
6086              | Bool n -> pr "  %s = args.%s;\n" n n
6087              | Int n -> pr "  %s = args.%s;\n" n n
6088              | Int64 n -> pr "  %s = args.%s;\n" n n
6089              | FileIn _ | FileOut _ -> ()
6090            ) args;
6091            pr "\n"
6092       );
6093
6094
6095       (* this is used at least for do_equal *)
6096       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6097         (* Emit NEED_ROOT just once, even when there are two or
6098            more Pathname args *)
6099         pr "  NEED_ROOT (goto done);\n";
6100       );
6101
6102       (* Don't want to call the impl with any FileIn or FileOut
6103        * parameters, since these go "outside" the RPC protocol.
6104        *)
6105       let args' =
6106         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6107           (snd style) in
6108       pr "  r = do_%s " name;
6109       generate_c_call_args (fst style, args');
6110       pr ";\n";
6111
6112       (match fst style with
6113        | RErr | RInt _ | RInt64 _ | RBool _
6114        | RConstString _ | RConstOptString _
6115        | RString _ | RStringList _ | RHashtable _
6116        | RStruct (_, _) | RStructList (_, _) ->
6117            pr "  if (r == %s)\n" error_code;
6118            pr "    /* do_%s has already called reply_with_error */\n" name;
6119            pr "    goto done;\n";
6120            pr "\n"
6121        | RBufferOut _ ->
6122            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6123            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6124            pr "   */\n";
6125            pr "  if (size == 1 && r == %s)\n" error_code;
6126            pr "    /* do_%s has already called reply_with_error */\n" name;
6127            pr "    goto done;\n";
6128            pr "\n"
6129       );
6130
6131       (* If there are any FileOut parameters, then the impl must
6132        * send its own reply.
6133        *)
6134       let no_reply =
6135         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6136       if no_reply then
6137         pr "  /* do_%s has already sent a reply */\n" name
6138       else (
6139         match fst style with
6140         | RErr -> pr "  reply (NULL, NULL);\n"
6141         | RInt n | RInt64 n | RBool n ->
6142             pr "  struct guestfs_%s_ret ret;\n" name;
6143             pr "  ret.%s = r;\n" n;
6144             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6145               name
6146         | RConstString _ | RConstOptString _ ->
6147             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6148         | RString n ->
6149             pr "  struct guestfs_%s_ret ret;\n" name;
6150             pr "  ret.%s = r;\n" n;
6151             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6152               name;
6153             pr "  free (r);\n"
6154         | RStringList n | RHashtable n ->
6155             pr "  struct guestfs_%s_ret ret;\n" name;
6156             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6157             pr "  ret.%s.%s_val = r;\n" n n;
6158             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6159               name;
6160             pr "  free_strings (r);\n"
6161         | RStruct (n, _) ->
6162             pr "  struct guestfs_%s_ret ret;\n" name;
6163             pr "  ret.%s = *r;\n" n;
6164             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6165               name;
6166             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6167               name
6168         | RStructList (n, _) ->
6169             pr "  struct guestfs_%s_ret ret;\n" name;
6170             pr "  ret.%s = *r;\n" n;
6171             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6172               name;
6173             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6174               name
6175         | RBufferOut n ->
6176             pr "  struct guestfs_%s_ret ret;\n" name;
6177             pr "  ret.%s.%s_val = r;\n" n n;
6178             pr "  ret.%s.%s_len = size;\n" n n;
6179             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6180               name;
6181             pr "  free (r);\n"
6182       );
6183
6184       (* Free the args. *)
6185       (match snd style with
6186        | [] ->
6187            pr "done: ;\n";
6188        | _ ->
6189            pr "done:\n";
6190            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6191              name
6192       );
6193
6194       pr "}\n\n";
6195   ) daemon_functions;
6196
6197   (* Dispatch function. *)
6198   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6199   pr "{\n";
6200   pr "  switch (proc_nr) {\n";
6201
6202   List.iter (
6203     fun (name, style, _, _, _, _, _) ->
6204       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6205       pr "      %s_stub (xdr_in);\n" name;
6206       pr "      break;\n"
6207   ) daemon_functions;
6208
6209   pr "    default:\n";
6210   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";
6211   pr "  }\n";
6212   pr "}\n";
6213   pr "\n";
6214
6215   (* LVM columns and tokenization functions. *)
6216   (* XXX This generates crap code.  We should rethink how we
6217    * do this parsing.
6218    *)
6219   List.iter (
6220     function
6221     | typ, cols ->
6222         pr "static const char *lvm_%s_cols = \"%s\";\n"
6223           typ (String.concat "," (List.map fst cols));
6224         pr "\n";
6225
6226         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6227         pr "{\n";
6228         pr "  char *tok, *p, *next;\n";
6229         pr "  int i, j;\n";
6230         pr "\n";
6231         (*
6232           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6233           pr "\n";
6234         *)
6235         pr "  if (!str) {\n";
6236         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6237         pr "    return -1;\n";
6238         pr "  }\n";
6239         pr "  if (!*str || c_isspace (*str)) {\n";
6240         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6241         pr "    return -1;\n";
6242         pr "  }\n";
6243         pr "  tok = str;\n";
6244         List.iter (
6245           fun (name, coltype) ->
6246             pr "  if (!tok) {\n";
6247             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6248             pr "    return -1;\n";
6249             pr "  }\n";
6250             pr "  p = strchrnul (tok, ',');\n";
6251             pr "  if (*p) next = p+1; else next = NULL;\n";
6252             pr "  *p = '\\0';\n";
6253             (match coltype with
6254              | FString ->
6255                  pr "  r->%s = strdup (tok);\n" name;
6256                  pr "  if (r->%s == NULL) {\n" name;
6257                  pr "    perror (\"strdup\");\n";
6258                  pr "    return -1;\n";
6259                  pr "  }\n"
6260              | FUUID ->
6261                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6262                  pr "    if (tok[j] == '\\0') {\n";
6263                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6264                  pr "      return -1;\n";
6265                  pr "    } else if (tok[j] != '-')\n";
6266                  pr "      r->%s[i++] = tok[j];\n" name;
6267                  pr "  }\n";
6268              | FBytes ->
6269                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6270                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6271                  pr "    return -1;\n";
6272                  pr "  }\n";
6273              | FInt64 ->
6274                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6275                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6276                  pr "    return -1;\n";
6277                  pr "  }\n";
6278              | FOptPercent ->
6279                  pr "  if (tok[0] == '\\0')\n";
6280                  pr "    r->%s = -1;\n" name;
6281                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6282                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6283                  pr "    return -1;\n";
6284                  pr "  }\n";
6285              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6286                  assert false (* can never be an LVM column *)
6287             );
6288             pr "  tok = next;\n";
6289         ) cols;
6290
6291         pr "  if (tok != NULL) {\n";
6292         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6293         pr "    return -1;\n";
6294         pr "  }\n";
6295         pr "  return 0;\n";
6296         pr "}\n";
6297         pr "\n";
6298
6299         pr "guestfs_int_lvm_%s_list *\n" typ;
6300         pr "parse_command_line_%ss (void)\n" typ;
6301         pr "{\n";
6302         pr "  char *out, *err;\n";
6303         pr "  char *p, *pend;\n";
6304         pr "  int r, i;\n";
6305         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6306         pr "  void *newp;\n";
6307         pr "\n";
6308         pr "  ret = malloc (sizeof *ret);\n";
6309         pr "  if (!ret) {\n";
6310         pr "    reply_with_perror (\"malloc\");\n";
6311         pr "    return NULL;\n";
6312         pr "  }\n";
6313         pr "\n";
6314         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6315         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6316         pr "\n";
6317         pr "  r = command (&out, &err,\n";
6318         pr "           \"lvm\", \"%ss\",\n" typ;
6319         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6320         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6321         pr "  if (r == -1) {\n";
6322         pr "    reply_with_error (\"%%s\", err);\n";
6323         pr "    free (out);\n";
6324         pr "    free (err);\n";
6325         pr "    free (ret);\n";
6326         pr "    return NULL;\n";
6327         pr "  }\n";
6328         pr "\n";
6329         pr "  free (err);\n";
6330         pr "\n";
6331         pr "  /* Tokenize each line of the output. */\n";
6332         pr "  p = out;\n";
6333         pr "  i = 0;\n";
6334         pr "  while (p) {\n";
6335         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6336         pr "    if (pend) {\n";
6337         pr "      *pend = '\\0';\n";
6338         pr "      pend++;\n";
6339         pr "    }\n";
6340         pr "\n";
6341         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6342         pr "      p++;\n";
6343         pr "\n";
6344         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6345         pr "      p = pend;\n";
6346         pr "      continue;\n";
6347         pr "    }\n";
6348         pr "\n";
6349         pr "    /* Allocate some space to store this next entry. */\n";
6350         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6351         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6352         pr "    if (newp == NULL) {\n";
6353         pr "      reply_with_perror (\"realloc\");\n";
6354         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6355         pr "      free (ret);\n";
6356         pr "      free (out);\n";
6357         pr "      return NULL;\n";
6358         pr "    }\n";
6359         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6360         pr "\n";
6361         pr "    /* Tokenize the next entry. */\n";
6362         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6363         pr "    if (r == -1) {\n";
6364         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6365         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6366         pr "      free (ret);\n";
6367         pr "      free (out);\n";
6368         pr "      return NULL;\n";
6369         pr "    }\n";
6370         pr "\n";
6371         pr "    ++i;\n";
6372         pr "    p = pend;\n";
6373         pr "  }\n";
6374         pr "\n";
6375         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6376         pr "\n";
6377         pr "  free (out);\n";
6378         pr "  return ret;\n";
6379         pr "}\n"
6380
6381   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6382
6383 (* Generate a list of function names, for debugging in the daemon.. *)
6384 and generate_daemon_names () =
6385   generate_header CStyle GPLv2plus;
6386
6387   pr "#include <config.h>\n";
6388   pr "\n";
6389   pr "#include \"daemon.h\"\n";
6390   pr "\n";
6391
6392   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6393   pr "const char *function_names[] = {\n";
6394   List.iter (
6395     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6396   ) daemon_functions;
6397   pr "};\n";
6398
6399 (* Generate the optional groups for the daemon to implement
6400  * guestfs_available.
6401  *)
6402 and generate_daemon_optgroups_c () =
6403   generate_header CStyle GPLv2plus;
6404
6405   pr "#include <config.h>\n";
6406   pr "\n";
6407   pr "#include \"daemon.h\"\n";
6408   pr "#include \"optgroups.h\"\n";
6409   pr "\n";
6410
6411   pr "struct optgroup optgroups[] = {\n";
6412   List.iter (
6413     fun (group, _) ->
6414       pr "  { \"%s\", optgroup_%s_available },\n" group group
6415   ) optgroups;
6416   pr "  { NULL, NULL }\n";
6417   pr "};\n"
6418
6419 and generate_daemon_optgroups_h () =
6420   generate_header CStyle GPLv2plus;
6421
6422   List.iter (
6423     fun (group, _) ->
6424       pr "extern int optgroup_%s_available (void);\n" group
6425   ) optgroups
6426
6427 (* Generate the tests. *)
6428 and generate_tests () =
6429   generate_header CStyle GPLv2plus;
6430
6431   pr "\
6432 #include <stdio.h>
6433 #include <stdlib.h>
6434 #include <string.h>
6435 #include <unistd.h>
6436 #include <sys/types.h>
6437 #include <fcntl.h>
6438
6439 #include \"guestfs.h\"
6440 #include \"guestfs-internal.h\"
6441
6442 static guestfs_h *g;
6443 static int suppress_error = 0;
6444
6445 static void print_error (guestfs_h *g, void *data, const char *msg)
6446 {
6447   if (!suppress_error)
6448     fprintf (stderr, \"%%s\\n\", msg);
6449 }
6450
6451 /* FIXME: nearly identical code appears in fish.c */
6452 static void print_strings (char *const *argv)
6453 {
6454   int argc;
6455
6456   for (argc = 0; argv[argc] != NULL; ++argc)
6457     printf (\"\\t%%s\\n\", argv[argc]);
6458 }
6459
6460 /*
6461 static void print_table (char const *const *argv)
6462 {
6463   int i;
6464
6465   for (i = 0; argv[i] != NULL; i += 2)
6466     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6467 }
6468 */
6469
6470 static int
6471 is_available (const char *group)
6472 {
6473   const char *groups[] = { group, NULL };
6474   int r;
6475
6476   suppress_error = 1;
6477   r = guestfs_available (g, (char **) groups);
6478   suppress_error = 0;
6479
6480   return r == 0;
6481 }
6482
6483 ";
6484
6485   (* Generate a list of commands which are not tested anywhere. *)
6486   pr "static void no_test_warnings (void)\n";
6487   pr "{\n";
6488
6489   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6490   List.iter (
6491     fun (_, _, _, _, tests, _, _) ->
6492       let tests = filter_map (
6493         function
6494         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
6495         | (_, Disabled, _) -> None
6496       ) tests in
6497       let seq = List.concat (List.map seq_of_test tests) in
6498       let cmds_tested = List.map List.hd seq in
6499       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6500   ) all_functions;
6501
6502   List.iter (
6503     fun (name, _, _, _, _, _, _) ->
6504       if not (Hashtbl.mem hash name) then
6505         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6506   ) all_functions;
6507
6508   pr "}\n";
6509   pr "\n";
6510
6511   (* Generate the actual tests.  Note that we generate the tests
6512    * in reverse order, deliberately, so that (in general) the
6513    * newest tests run first.  This makes it quicker and easier to
6514    * debug them.
6515    *)
6516   let test_names =
6517     List.map (
6518       fun (name, _, _, flags, tests, _, _) ->
6519         mapi (generate_one_test name flags) tests
6520     ) (List.rev all_functions) in
6521   let test_names = List.concat test_names in
6522   let nr_tests = List.length test_names in
6523
6524   pr "\
6525 int main (int argc, char *argv[])
6526 {
6527   char c = 0;
6528   unsigned long int n_failed = 0;
6529   const char *filename;
6530   int fd;
6531   int nr_tests, test_num = 0;
6532
6533   setbuf (stdout, NULL);
6534
6535   no_test_warnings ();
6536
6537   g = guestfs_create ();
6538   if (g == NULL) {
6539     printf (\"guestfs_create FAILED\\n\");
6540     exit (EXIT_FAILURE);
6541   }
6542
6543   guestfs_set_error_handler (g, print_error, NULL);
6544
6545   guestfs_set_path (g, \"../appliance\");
6546
6547   filename = \"test1.img\";
6548   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6549   if (fd == -1) {
6550     perror (filename);
6551     exit (EXIT_FAILURE);
6552   }
6553   if (lseek (fd, %d, SEEK_SET) == -1) {
6554     perror (\"lseek\");
6555     close (fd);
6556     unlink (filename);
6557     exit (EXIT_FAILURE);
6558   }
6559   if (write (fd, &c, 1) == -1) {
6560     perror (\"write\");
6561     close (fd);
6562     unlink (filename);
6563     exit (EXIT_FAILURE);
6564   }
6565   if (close (fd) == -1) {
6566     perror (filename);
6567     unlink (filename);
6568     exit (EXIT_FAILURE);
6569   }
6570   if (guestfs_add_drive (g, filename) == -1) {
6571     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6572     exit (EXIT_FAILURE);
6573   }
6574
6575   filename = \"test2.img\";
6576   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6577   if (fd == -1) {
6578     perror (filename);
6579     exit (EXIT_FAILURE);
6580   }
6581   if (lseek (fd, %d, SEEK_SET) == -1) {
6582     perror (\"lseek\");
6583     close (fd);
6584     unlink (filename);
6585     exit (EXIT_FAILURE);
6586   }
6587   if (write (fd, &c, 1) == -1) {
6588     perror (\"write\");
6589     close (fd);
6590     unlink (filename);
6591     exit (EXIT_FAILURE);
6592   }
6593   if (close (fd) == -1) {
6594     perror (filename);
6595     unlink (filename);
6596     exit (EXIT_FAILURE);
6597   }
6598   if (guestfs_add_drive (g, filename) == -1) {
6599     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6600     exit (EXIT_FAILURE);
6601   }
6602
6603   filename = \"test3.img\";
6604   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6605   if (fd == -1) {
6606     perror (filename);
6607     exit (EXIT_FAILURE);
6608   }
6609   if (lseek (fd, %d, SEEK_SET) == -1) {
6610     perror (\"lseek\");
6611     close (fd);
6612     unlink (filename);
6613     exit (EXIT_FAILURE);
6614   }
6615   if (write (fd, &c, 1) == -1) {
6616     perror (\"write\");
6617     close (fd);
6618     unlink (filename);
6619     exit (EXIT_FAILURE);
6620   }
6621   if (close (fd) == -1) {
6622     perror (filename);
6623     unlink (filename);
6624     exit (EXIT_FAILURE);
6625   }
6626   if (guestfs_add_drive (g, filename) == -1) {
6627     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6628     exit (EXIT_FAILURE);
6629   }
6630
6631   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6632     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6633     exit (EXIT_FAILURE);
6634   }
6635
6636   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6637   alarm (600);
6638
6639   if (guestfs_launch (g) == -1) {
6640     printf (\"guestfs_launch FAILED\\n\");
6641     exit (EXIT_FAILURE);
6642   }
6643
6644   /* Cancel previous alarm. */
6645   alarm (0);
6646
6647   nr_tests = %d;
6648
6649 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6650
6651   iteri (
6652     fun i test_name ->
6653       pr "  test_num++;\n";
6654       pr "  if (guestfs_get_verbose (g))\n";
6655       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6656       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6657       pr "  if (%s () == -1) {\n" test_name;
6658       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6659       pr "    n_failed++;\n";
6660       pr "  }\n";
6661   ) test_names;
6662   pr "\n";
6663
6664   pr "  guestfs_close (g);\n";
6665   pr "  unlink (\"test1.img\");\n";
6666   pr "  unlink (\"test2.img\");\n";
6667   pr "  unlink (\"test3.img\");\n";
6668   pr "\n";
6669
6670   pr "  if (n_failed > 0) {\n";
6671   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6672   pr "    exit (EXIT_FAILURE);\n";
6673   pr "  }\n";
6674   pr "\n";
6675
6676   pr "  exit (EXIT_SUCCESS);\n";
6677   pr "}\n"
6678
6679 and generate_one_test name flags i (init, prereq, test) =
6680   let test_name = sprintf "test_%s_%d" name i in
6681
6682   pr "\
6683 static int %s_skip (void)
6684 {
6685   const char *str;
6686
6687   str = getenv (\"TEST_ONLY\");
6688   if (str)
6689     return strstr (str, \"%s\") == NULL;
6690   str = getenv (\"SKIP_%s\");
6691   if (str && STREQ (str, \"1\")) return 1;
6692   str = getenv (\"SKIP_TEST_%s\");
6693   if (str && STREQ (str, \"1\")) return 1;
6694   return 0;
6695 }
6696
6697 " test_name name (String.uppercase test_name) (String.uppercase name);
6698
6699   (match prereq with
6700    | Disabled | Always | IfAvailable _ -> ()
6701    | If code | Unless code ->
6702        pr "static int %s_prereq (void)\n" test_name;
6703        pr "{\n";
6704        pr "  %s\n" code;
6705        pr "}\n";
6706        pr "\n";
6707   );
6708
6709   pr "\
6710 static int %s (void)
6711 {
6712   if (%s_skip ()) {
6713     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6714     return 0;
6715   }
6716
6717 " test_name test_name test_name;
6718
6719   (* Optional functions should only be tested if the relevant
6720    * support is available in the daemon.
6721    *)
6722   List.iter (
6723     function
6724     | Optional group ->
6725         pr "  if (!is_available (\"%s\")) {\n" group;
6726         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
6727         pr "    return 0;\n";
6728         pr "  }\n";
6729     | _ -> ()
6730   ) flags;
6731
6732   (match prereq with
6733    | Disabled ->
6734        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6735    | If _ ->
6736        pr "  if (! %s_prereq ()) {\n" test_name;
6737        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6738        pr "    return 0;\n";
6739        pr "  }\n";
6740        pr "\n";
6741        generate_one_test_body name i test_name init test;
6742    | Unless _ ->
6743        pr "  if (%s_prereq ()) {\n" test_name;
6744        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6745        pr "    return 0;\n";
6746        pr "  }\n";
6747        pr "\n";
6748        generate_one_test_body name i test_name init test;
6749    | IfAvailable group ->
6750        pr "  if (!is_available (\"%s\")) {\n" group;
6751        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
6752        pr "    return 0;\n";
6753        pr "  }\n";
6754        pr "\n";
6755        generate_one_test_body name i test_name init test;
6756    | Always ->
6757        generate_one_test_body name i test_name init test
6758   );
6759
6760   pr "  return 0;\n";
6761   pr "}\n";
6762   pr "\n";
6763   test_name
6764
6765 and generate_one_test_body name i test_name init test =
6766   (match init with
6767    | InitNone (* XXX at some point, InitNone and InitEmpty became
6768                * folded together as the same thing.  Really we should
6769                * make InitNone do nothing at all, but the tests may
6770                * need to be checked to make sure this is OK.
6771                *)
6772    | InitEmpty ->
6773        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6774        List.iter (generate_test_command_call test_name)
6775          [["blockdev_setrw"; "/dev/sda"];
6776           ["umount_all"];
6777           ["lvm_remove_all"]]
6778    | InitPartition ->
6779        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6780        List.iter (generate_test_command_call test_name)
6781          [["blockdev_setrw"; "/dev/sda"];
6782           ["umount_all"];
6783           ["lvm_remove_all"];
6784           ["part_disk"; "/dev/sda"; "mbr"]]
6785    | InitBasicFS ->
6786        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6787        List.iter (generate_test_command_call test_name)
6788          [["blockdev_setrw"; "/dev/sda"];
6789           ["umount_all"];
6790           ["lvm_remove_all"];
6791           ["part_disk"; "/dev/sda"; "mbr"];
6792           ["mkfs"; "ext2"; "/dev/sda1"];
6793           ["mount_options"; ""; "/dev/sda1"; "/"]]
6794    | InitBasicFSonLVM ->
6795        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6796          test_name;
6797        List.iter (generate_test_command_call test_name)
6798          [["blockdev_setrw"; "/dev/sda"];
6799           ["umount_all"];
6800           ["lvm_remove_all"];
6801           ["part_disk"; "/dev/sda"; "mbr"];
6802           ["pvcreate"; "/dev/sda1"];
6803           ["vgcreate"; "VG"; "/dev/sda1"];
6804           ["lvcreate"; "LV"; "VG"; "8"];
6805           ["mkfs"; "ext2"; "/dev/VG/LV"];
6806           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6807    | InitISOFS ->
6808        pr "  /* InitISOFS for %s */\n" test_name;
6809        List.iter (generate_test_command_call test_name)
6810          [["blockdev_setrw"; "/dev/sda"];
6811           ["umount_all"];
6812           ["lvm_remove_all"];
6813           ["mount_ro"; "/dev/sdd"; "/"]]
6814   );
6815
6816   let get_seq_last = function
6817     | [] ->
6818         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6819           test_name
6820     | seq ->
6821         let seq = List.rev seq in
6822         List.rev (List.tl seq), List.hd seq
6823   in
6824
6825   match test with
6826   | TestRun seq ->
6827       pr "  /* TestRun for %s (%d) */\n" name i;
6828       List.iter (generate_test_command_call test_name) seq
6829   | TestOutput (seq, expected) ->
6830       pr "  /* TestOutput for %s (%d) */\n" name i;
6831       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6832       let seq, last = get_seq_last seq in
6833       let test () =
6834         pr "    if (STRNEQ (r, expected)) {\n";
6835         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6836         pr "      return -1;\n";
6837         pr "    }\n"
6838       in
6839       List.iter (generate_test_command_call test_name) seq;
6840       generate_test_command_call ~test test_name last
6841   | TestOutputList (seq, expected) ->
6842       pr "  /* TestOutputList for %s (%d) */\n" name i;
6843       let seq, last = get_seq_last seq in
6844       let test () =
6845         iteri (
6846           fun i str ->
6847             pr "    if (!r[%d]) {\n" i;
6848             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6849             pr "      print_strings (r);\n";
6850             pr "      return -1;\n";
6851             pr "    }\n";
6852             pr "    {\n";
6853             pr "      const char *expected = \"%s\";\n" (c_quote str);
6854             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6855             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6856             pr "        return -1;\n";
6857             pr "      }\n";
6858             pr "    }\n"
6859         ) expected;
6860         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6861         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6862           test_name;
6863         pr "      print_strings (r);\n";
6864         pr "      return -1;\n";
6865         pr "    }\n"
6866       in
6867       List.iter (generate_test_command_call test_name) seq;
6868       generate_test_command_call ~test test_name last
6869   | TestOutputListOfDevices (seq, expected) ->
6870       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6871       let seq, last = get_seq_last seq in
6872       let test () =
6873         iteri (
6874           fun i str ->
6875             pr "    if (!r[%d]) {\n" i;
6876             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6877             pr "      print_strings (r);\n";
6878             pr "      return -1;\n";
6879             pr "    }\n";
6880             pr "    {\n";
6881             pr "      const char *expected = \"%s\";\n" (c_quote str);
6882             pr "      r[%d][5] = 's';\n" i;
6883             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6884             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6885             pr "        return -1;\n";
6886             pr "      }\n";
6887             pr "    }\n"
6888         ) expected;
6889         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6890         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6891           test_name;
6892         pr "      print_strings (r);\n";
6893         pr "      return -1;\n";
6894         pr "    }\n"
6895       in
6896       List.iter (generate_test_command_call test_name) seq;
6897       generate_test_command_call ~test test_name last
6898   | TestOutputInt (seq, expected) ->
6899       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6900       let seq, last = get_seq_last seq in
6901       let test () =
6902         pr "    if (r != %d) {\n" expected;
6903         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6904           test_name expected;
6905         pr "               (int) r);\n";
6906         pr "      return -1;\n";
6907         pr "    }\n"
6908       in
6909       List.iter (generate_test_command_call test_name) seq;
6910       generate_test_command_call ~test test_name last
6911   | TestOutputIntOp (seq, op, expected) ->
6912       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6913       let seq, last = get_seq_last seq in
6914       let test () =
6915         pr "    if (! (r %s %d)) {\n" op expected;
6916         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6917           test_name op expected;
6918         pr "               (int) r);\n";
6919         pr "      return -1;\n";
6920         pr "    }\n"
6921       in
6922       List.iter (generate_test_command_call test_name) seq;
6923       generate_test_command_call ~test test_name last
6924   | TestOutputTrue seq ->
6925       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6926       let seq, last = get_seq_last seq in
6927       let test () =
6928         pr "    if (!r) {\n";
6929         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6930           test_name;
6931         pr "      return -1;\n";
6932         pr "    }\n"
6933       in
6934       List.iter (generate_test_command_call test_name) seq;
6935       generate_test_command_call ~test test_name last
6936   | TestOutputFalse seq ->
6937       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6938       let seq, last = get_seq_last seq in
6939       let test () =
6940         pr "    if (r) {\n";
6941         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6942           test_name;
6943         pr "      return -1;\n";
6944         pr "    }\n"
6945       in
6946       List.iter (generate_test_command_call test_name) seq;
6947       generate_test_command_call ~test test_name last
6948   | TestOutputLength (seq, expected) ->
6949       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6950       let seq, last = get_seq_last seq in
6951       let test () =
6952         pr "    int j;\n";
6953         pr "    for (j = 0; j < %d; ++j)\n" expected;
6954         pr "      if (r[j] == NULL) {\n";
6955         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6956           test_name;
6957         pr "        print_strings (r);\n";
6958         pr "        return -1;\n";
6959         pr "      }\n";
6960         pr "    if (r[j] != NULL) {\n";
6961         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6962           test_name;
6963         pr "      print_strings (r);\n";
6964         pr "      return -1;\n";
6965         pr "    }\n"
6966       in
6967       List.iter (generate_test_command_call test_name) seq;
6968       generate_test_command_call ~test test_name last
6969   | TestOutputBuffer (seq, expected) ->
6970       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6971       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6972       let seq, last = get_seq_last seq in
6973       let len = String.length expected in
6974       let test () =
6975         pr "    if (size != %d) {\n" len;
6976         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6977         pr "      return -1;\n";
6978         pr "    }\n";
6979         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6980         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6981         pr "      return -1;\n";
6982         pr "    }\n"
6983       in
6984       List.iter (generate_test_command_call test_name) seq;
6985       generate_test_command_call ~test test_name last
6986   | TestOutputStruct (seq, checks) ->
6987       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6988       let seq, last = get_seq_last seq in
6989       let test () =
6990         List.iter (
6991           function
6992           | CompareWithInt (field, expected) ->
6993               pr "    if (r->%s != %d) {\n" field expected;
6994               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6995                 test_name field expected;
6996               pr "               (int) r->%s);\n" field;
6997               pr "      return -1;\n";
6998               pr "    }\n"
6999           | CompareWithIntOp (field, op, expected) ->
7000               pr "    if (!(r->%s %s %d)) {\n" field op expected;
7001               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
7002                 test_name field op expected;
7003               pr "               (int) r->%s);\n" field;
7004               pr "      return -1;\n";
7005               pr "    }\n"
7006           | CompareWithString (field, expected) ->
7007               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7008               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7009                 test_name field expected;
7010               pr "               r->%s);\n" field;
7011               pr "      return -1;\n";
7012               pr "    }\n"
7013           | CompareFieldsIntEq (field1, field2) ->
7014               pr "    if (r->%s != r->%s) {\n" field1 field2;
7015               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7016                 test_name field1 field2;
7017               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7018               pr "      return -1;\n";
7019               pr "    }\n"
7020           | CompareFieldsStrEq (field1, field2) ->
7021               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7022               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7023                 test_name field1 field2;
7024               pr "               r->%s, r->%s);\n" field1 field2;
7025               pr "      return -1;\n";
7026               pr "    }\n"
7027         ) checks
7028       in
7029       List.iter (generate_test_command_call test_name) seq;
7030       generate_test_command_call ~test test_name last
7031   | TestLastFail seq ->
7032       pr "  /* TestLastFail for %s (%d) */\n" name i;
7033       let seq, last = get_seq_last seq in
7034       List.iter (generate_test_command_call test_name) seq;
7035       generate_test_command_call test_name ~expect_error:true last
7036
7037 (* Generate the code to run a command, leaving the result in 'r'.
7038  * If you expect to get an error then you should set expect_error:true.
7039  *)
7040 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7041   match cmd with
7042   | [] -> assert false
7043   | name :: args ->
7044       (* Look up the command to find out what args/ret it has. *)
7045       let style =
7046         try
7047           let _, style, _, _, _, _, _ =
7048             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7049           style
7050         with Not_found ->
7051           failwithf "%s: in test, command %s was not found" test_name name in
7052
7053       if List.length (snd style) <> List.length args then
7054         failwithf "%s: in test, wrong number of args given to %s"
7055           test_name name;
7056
7057       pr "  {\n";
7058
7059       List.iter (
7060         function
7061         | OptString n, "NULL" -> ()
7062         | Pathname n, arg
7063         | Device n, arg
7064         | Dev_or_Path n, arg
7065         | String n, arg
7066         | OptString n, arg ->
7067             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7068         | Int _, _
7069         | Int64 _, _
7070         | Bool _, _
7071         | FileIn _, _ | FileOut _, _ -> ()
7072         | StringList n, "" | DeviceList n, "" ->
7073             pr "    const char *const %s[1] = { NULL };\n" n
7074         | StringList n, arg | DeviceList n, arg ->
7075             let strs = string_split " " arg in
7076             iteri (
7077               fun i str ->
7078                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7079             ) strs;
7080             pr "    const char *const %s[] = {\n" n;
7081             iteri (
7082               fun i _ -> pr "      %s_%d,\n" n i
7083             ) strs;
7084             pr "      NULL\n";
7085             pr "    };\n";
7086       ) (List.combine (snd style) args);
7087
7088       let error_code =
7089         match fst style with
7090         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7091         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7092         | RConstString _ | RConstOptString _ ->
7093             pr "    const char *r;\n"; "NULL"
7094         | RString _ -> pr "    char *r;\n"; "NULL"
7095         | RStringList _ | RHashtable _ ->
7096             pr "    char **r;\n";
7097             pr "    int i;\n";
7098             "NULL"
7099         | RStruct (_, typ) ->
7100             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7101         | RStructList (_, typ) ->
7102             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7103         | RBufferOut _ ->
7104             pr "    char *r;\n";
7105             pr "    size_t size;\n";
7106             "NULL" in
7107
7108       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7109       pr "    r = guestfs_%s (g" name;
7110
7111       (* Generate the parameters. *)
7112       List.iter (
7113         function
7114         | OptString _, "NULL" -> pr ", NULL"
7115         | Pathname n, _
7116         | Device n, _ | Dev_or_Path n, _
7117         | String n, _
7118         | OptString n, _ ->
7119             pr ", %s" n
7120         | FileIn _, arg | FileOut _, arg ->
7121             pr ", \"%s\"" (c_quote arg)
7122         | StringList n, _ | DeviceList n, _ ->
7123             pr ", (char **) %s" n
7124         | Int _, arg ->
7125             let i =
7126               try int_of_string arg
7127               with Failure "int_of_string" ->
7128                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7129             pr ", %d" i
7130         | Int64 _, arg ->
7131             let i =
7132               try Int64.of_string arg
7133               with Failure "int_of_string" ->
7134                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7135             pr ", %Ld" i
7136         | Bool _, arg ->
7137             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7138       ) (List.combine (snd style) args);
7139
7140       (match fst style with
7141        | RBufferOut _ -> pr ", &size"
7142        | _ -> ()
7143       );
7144
7145       pr ");\n";
7146
7147       if not expect_error then
7148         pr "    if (r == %s)\n" error_code
7149       else
7150         pr "    if (r != %s)\n" error_code;
7151       pr "      return -1;\n";
7152
7153       (* Insert the test code. *)
7154       (match test with
7155        | None -> ()
7156        | Some f -> f ()
7157       );
7158
7159       (match fst style with
7160        | RErr | RInt _ | RInt64 _ | RBool _
7161        | RConstString _ | RConstOptString _ -> ()
7162        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7163        | RStringList _ | RHashtable _ ->
7164            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7165            pr "      free (r[i]);\n";
7166            pr "    free (r);\n"
7167        | RStruct (_, typ) ->
7168            pr "    guestfs_free_%s (r);\n" typ
7169        | RStructList (_, typ) ->
7170            pr "    guestfs_free_%s_list (r);\n" typ
7171       );
7172
7173       pr "  }\n"
7174
7175 and c_quote str =
7176   let str = replace_str str "\r" "\\r" in
7177   let str = replace_str str "\n" "\\n" in
7178   let str = replace_str str "\t" "\\t" in
7179   let str = replace_str str "\000" "\\0" in
7180   str
7181
7182 (* Generate a lot of different functions for guestfish. *)
7183 and generate_fish_cmds () =
7184   generate_header CStyle GPLv2plus;
7185
7186   let all_functions =
7187     List.filter (
7188       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7189     ) all_functions in
7190   let all_functions_sorted =
7191     List.filter (
7192       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7193     ) all_functions_sorted in
7194
7195   pr "#include <config.h>\n";
7196   pr "\n";
7197   pr "#include <stdio.h>\n";
7198   pr "#include <stdlib.h>\n";
7199   pr "#include <string.h>\n";
7200   pr "#include <inttypes.h>\n";
7201   pr "\n";
7202   pr "#include <guestfs.h>\n";
7203   pr "#include \"c-ctype.h\"\n";
7204   pr "#include \"full-write.h\"\n";
7205   pr "#include \"xstrtol.h\"\n";
7206   pr "#include \"fish.h\"\n";
7207   pr "\n";
7208
7209   (* list_commands function, which implements guestfish -h *)
7210   pr "void list_commands (void)\n";
7211   pr "{\n";
7212   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7213   pr "  list_builtin_commands ();\n";
7214   List.iter (
7215     fun (name, _, _, flags, _, shortdesc, _) ->
7216       let name = replace_char name '_' '-' in
7217       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7218         name shortdesc
7219   ) all_functions_sorted;
7220   pr "  printf (\"    %%s\\n\",";
7221   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7222   pr "}\n";
7223   pr "\n";
7224
7225   (* display_command function, which implements guestfish -h cmd *)
7226   pr "int display_command (const char *cmd)\n";
7227   pr "{\n";
7228   List.iter (
7229     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7230       let name2 = replace_char name '_' '-' in
7231       let alias =
7232         try find_map (function FishAlias n -> Some n | _ -> None) flags
7233         with Not_found -> name in
7234       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7235       let synopsis =
7236         match snd style with
7237         | [] -> name2
7238         | args ->
7239             sprintf "%s %s"
7240               name2 (String.concat " " (List.map name_of_argt args)) in
7241
7242       let warnings =
7243         if List.mem ProtocolLimitWarning flags then
7244           ("\n\n" ^ protocol_limit_warning)
7245         else "" in
7246
7247       (* For DangerWillRobinson commands, we should probably have
7248        * guestfish prompt before allowing you to use them (especially
7249        * in interactive mode). XXX
7250        *)
7251       let warnings =
7252         warnings ^
7253           if List.mem DangerWillRobinson flags then
7254             ("\n\n" ^ danger_will_robinson)
7255           else "" in
7256
7257       let warnings =
7258         warnings ^
7259           match deprecation_notice flags with
7260           | None -> ""
7261           | Some txt -> "\n\n" ^ txt in
7262
7263       let describe_alias =
7264         if name <> alias then
7265           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7266         else "" in
7267
7268       pr "  if (";
7269       pr "STRCASEEQ (cmd, \"%s\")" name;
7270       if name <> name2 then
7271         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7272       if name <> alias then
7273         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7274       pr ") {\n";
7275       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7276         name2 shortdesc
7277         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7278          "=head1 DESCRIPTION\n\n" ^
7279          longdesc ^ warnings ^ describe_alias);
7280       pr "    return 0;\n";
7281       pr "  }\n";
7282       pr "  else\n"
7283   ) all_functions;
7284   pr "    return display_builtin_command (cmd);\n";
7285   pr "}\n";
7286   pr "\n";
7287
7288   let emit_print_list_function typ =
7289     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7290       typ typ typ;
7291     pr "{\n";
7292     pr "  unsigned int i;\n";
7293     pr "\n";
7294     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7295     pr "    printf (\"[%%d] = {\\n\", i);\n";
7296     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7297     pr "    printf (\"}\\n\");\n";
7298     pr "  }\n";
7299     pr "}\n";
7300     pr "\n";
7301   in
7302
7303   (* print_* functions *)
7304   List.iter (
7305     fun (typ, cols) ->
7306       let needs_i =
7307         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7308
7309       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7310       pr "{\n";
7311       if needs_i then (
7312         pr "  unsigned int i;\n";
7313         pr "\n"
7314       );
7315       List.iter (
7316         function
7317         | name, FString ->
7318             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7319         | name, FUUID ->
7320             pr "  printf (\"%%s%s: \", indent);\n" name;
7321             pr "  for (i = 0; i < 32; ++i)\n";
7322             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7323             pr "  printf (\"\\n\");\n"
7324         | name, FBuffer ->
7325             pr "  printf (\"%%s%s: \", indent);\n" name;
7326             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7327             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7328             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7329             pr "    else\n";
7330             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7331             pr "  printf (\"\\n\");\n"
7332         | name, (FUInt64|FBytes) ->
7333             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7334               name typ name
7335         | name, FInt64 ->
7336             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7337               name typ name
7338         | name, FUInt32 ->
7339             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7340               name typ name
7341         | name, FInt32 ->
7342             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7343               name typ name
7344         | name, FChar ->
7345             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7346               name typ name
7347         | name, FOptPercent ->
7348             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7349               typ name name typ name;
7350             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7351       ) cols;
7352       pr "}\n";
7353       pr "\n";
7354   ) structs;
7355
7356   (* Emit a print_TYPE_list function definition only if that function is used. *)
7357   List.iter (
7358     function
7359     | typ, (RStructListOnly | RStructAndList) ->
7360         (* generate the function for typ *)
7361         emit_print_list_function typ
7362     | typ, _ -> () (* empty *)
7363   ) (rstructs_used_by all_functions);
7364
7365   (* Emit a print_TYPE function definition only if that function is used. *)
7366   List.iter (
7367     function
7368     | typ, (RStructOnly | RStructAndList) ->
7369         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7370         pr "{\n";
7371         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7372         pr "}\n";
7373         pr "\n";
7374     | typ, _ -> () (* empty *)
7375   ) (rstructs_used_by all_functions);
7376
7377   (* run_<action> actions *)
7378   List.iter (
7379     fun (name, style, _, flags, _, _, _) ->
7380       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7381       pr "{\n";
7382       (match fst style with
7383        | RErr
7384        | RInt _
7385        | RBool _ -> pr "  int r;\n"
7386        | RInt64 _ -> pr "  int64_t r;\n"
7387        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7388        | RString _ -> pr "  char *r;\n"
7389        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7390        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7391        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7392        | RBufferOut _ ->
7393            pr "  char *r;\n";
7394            pr "  size_t size;\n";
7395       );
7396       List.iter (
7397         function
7398         | Device n
7399         | String n
7400         | OptString n
7401         | FileIn n
7402         | FileOut n -> pr "  const char *%s;\n" n
7403         | Pathname n
7404         | Dev_or_Path n -> pr "  char *%s;\n" n
7405         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7406         | Bool n -> pr "  int %s;\n" n
7407         | Int n -> pr "  int %s;\n" n
7408         | Int64 n -> pr "  int64_t %s;\n" n
7409       ) (snd style);
7410
7411       (* Check and convert parameters. *)
7412       let argc_expected = List.length (snd style) in
7413       pr "  if (argc != %d) {\n" argc_expected;
7414       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7415         argc_expected;
7416       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7417       pr "    return -1;\n";
7418       pr "  }\n";
7419
7420       let parse_integer fn fntyp rtyp range name i =
7421         pr "  {\n";
7422         pr "    strtol_error xerr;\n";
7423         pr "    %s r;\n" fntyp;
7424         pr "\n";
7425         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7426         pr "    if (xerr != LONGINT_OK) {\n";
7427         pr "      fprintf (stderr,\n";
7428         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7429         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7430         pr "      return -1;\n";
7431         pr "    }\n";
7432         (match range with
7433          | None -> ()
7434          | Some (min, max, comment) ->
7435              pr "    /* %s */\n" comment;
7436              pr "    if (r < %s || r > %s) {\n" min max;
7437              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7438                name;
7439              pr "      return -1;\n";
7440              pr "    }\n";
7441              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7442         );
7443         pr "    %s = r;\n" name;
7444         pr "  }\n";
7445       in
7446
7447       iteri (
7448         fun i ->
7449           function
7450           | Device name
7451           | String name ->
7452               pr "  %s = argv[%d];\n" name i
7453           | Pathname name
7454           | Dev_or_Path name ->
7455               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7456               pr "  if (%s == NULL) return -1;\n" name
7457           | OptString name ->
7458               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7459                 name i i
7460           | FileIn name ->
7461               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7462                 name i i
7463           | FileOut name ->
7464               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7465                 name i i
7466           | StringList name | DeviceList name ->
7467               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7468               pr "  if (%s == NULL) return -1;\n" name;
7469           | Bool name ->
7470               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7471           | Int name ->
7472               let range =
7473                 let min = "(-(2LL<<30))"
7474                 and max = "((2LL<<30)-1)"
7475                 and comment =
7476                   "The Int type in the generator is a signed 31 bit int." in
7477                 Some (min, max, comment) in
7478               parse_integer "xstrtoll" "long long" "int" range name i
7479           | Int64 name ->
7480               parse_integer "xstrtoll" "long long" "int64_t" None name i
7481       ) (snd style);
7482
7483       (* Call C API function. *)
7484       let fn =
7485         try find_map (function FishAction n -> Some n | _ -> None) flags
7486         with Not_found -> sprintf "guestfs_%s" name in
7487       pr "  r = %s " fn;
7488       generate_c_call_args ~handle:"g" style;
7489       pr ";\n";
7490
7491       List.iter (
7492         function
7493         | Device name | String name
7494         | OptString name | FileIn name | FileOut name | Bool name
7495         | Int name | Int64 name -> ()
7496         | Pathname name | Dev_or_Path name ->
7497             pr "  free (%s);\n" name
7498         | StringList name | DeviceList name ->
7499             pr "  free_strings (%s);\n" name
7500       ) (snd style);
7501
7502       (* Check return value for errors and display command results. *)
7503       (match fst style with
7504        | RErr -> pr "  return r;\n"
7505        | RInt _ ->
7506            pr "  if (r == -1) return -1;\n";
7507            pr "  printf (\"%%d\\n\", r);\n";
7508            pr "  return 0;\n"
7509        | RInt64 _ ->
7510            pr "  if (r == -1) return -1;\n";
7511            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7512            pr "  return 0;\n"
7513        | RBool _ ->
7514            pr "  if (r == -1) return -1;\n";
7515            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7516            pr "  return 0;\n"
7517        | RConstString _ ->
7518            pr "  if (r == NULL) return -1;\n";
7519            pr "  printf (\"%%s\\n\", r);\n";
7520            pr "  return 0;\n"
7521        | RConstOptString _ ->
7522            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7523            pr "  return 0;\n"
7524        | RString _ ->
7525            pr "  if (r == NULL) return -1;\n";
7526            pr "  printf (\"%%s\\n\", r);\n";
7527            pr "  free (r);\n";
7528            pr "  return 0;\n"
7529        | RStringList _ ->
7530            pr "  if (r == NULL) return -1;\n";
7531            pr "  print_strings (r);\n";
7532            pr "  free_strings (r);\n";
7533            pr "  return 0;\n"
7534        | RStruct (_, typ) ->
7535            pr "  if (r == NULL) return -1;\n";
7536            pr "  print_%s (r);\n" typ;
7537            pr "  guestfs_free_%s (r);\n" typ;
7538            pr "  return 0;\n"
7539        | RStructList (_, typ) ->
7540            pr "  if (r == NULL) return -1;\n";
7541            pr "  print_%s_list (r);\n" typ;
7542            pr "  guestfs_free_%s_list (r);\n" typ;
7543            pr "  return 0;\n"
7544        | RHashtable _ ->
7545            pr "  if (r == NULL) return -1;\n";
7546            pr "  print_table (r);\n";
7547            pr "  free_strings (r);\n";
7548            pr "  return 0;\n"
7549        | RBufferOut _ ->
7550            pr "  if (r == NULL) return -1;\n";
7551            pr "  if (full_write (1, r, size) != size) {\n";
7552            pr "    perror (\"write\");\n";
7553            pr "    free (r);\n";
7554            pr "    return -1;\n";
7555            pr "  }\n";
7556            pr "  free (r);\n";
7557            pr "  return 0;\n"
7558       );
7559       pr "}\n";
7560       pr "\n"
7561   ) all_functions;
7562
7563   (* run_action function *)
7564   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7565   pr "{\n";
7566   List.iter (
7567     fun (name, _, _, flags, _, _, _) ->
7568       let name2 = replace_char name '_' '-' in
7569       let alias =
7570         try find_map (function FishAlias n -> Some n | _ -> None) flags
7571         with Not_found -> name in
7572       pr "  if (";
7573       pr "STRCASEEQ (cmd, \"%s\")" name;
7574       if name <> name2 then
7575         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7576       if name <> alias then
7577         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7578       pr ")\n";
7579       pr "    return run_%s (cmd, argc, argv);\n" name;
7580       pr "  else\n";
7581   ) all_functions;
7582   pr "    {\n";
7583   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7584   pr "      if (command_num == 1)\n";
7585   pr "        extended_help_message ();\n";
7586   pr "      return -1;\n";
7587   pr "    }\n";
7588   pr "  return 0;\n";
7589   pr "}\n";
7590   pr "\n"
7591
7592 (* Readline completion for guestfish. *)
7593 and generate_fish_completion () =
7594   generate_header CStyle GPLv2plus;
7595
7596   let all_functions =
7597     List.filter (
7598       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7599     ) all_functions in
7600
7601   pr "\
7602 #include <config.h>
7603
7604 #include <stdio.h>
7605 #include <stdlib.h>
7606 #include <string.h>
7607
7608 #ifdef HAVE_LIBREADLINE
7609 #include <readline/readline.h>
7610 #endif
7611
7612 #include \"fish.h\"
7613
7614 #ifdef HAVE_LIBREADLINE
7615
7616 static const char *const commands[] = {
7617   BUILTIN_COMMANDS_FOR_COMPLETION,
7618 ";
7619
7620   (* Get the commands, including the aliases.  They don't need to be
7621    * sorted - the generator() function just does a dumb linear search.
7622    *)
7623   let commands =
7624     List.map (
7625       fun (name, _, _, flags, _, _, _) ->
7626         let name2 = replace_char name '_' '-' in
7627         let alias =
7628           try find_map (function FishAlias n -> Some n | _ -> None) flags
7629           with Not_found -> name in
7630
7631         if name <> alias then [name2; alias] else [name2]
7632     ) all_functions in
7633   let commands = List.flatten commands in
7634
7635   List.iter (pr "  \"%s\",\n") commands;
7636
7637   pr "  NULL
7638 };
7639
7640 static char *
7641 generator (const char *text, int state)
7642 {
7643   static int index, len;
7644   const char *name;
7645
7646   if (!state) {
7647     index = 0;
7648     len = strlen (text);
7649   }
7650
7651   rl_attempted_completion_over = 1;
7652
7653   while ((name = commands[index]) != NULL) {
7654     index++;
7655     if (STRCASEEQLEN (name, text, len))
7656       return strdup (name);
7657   }
7658
7659   return NULL;
7660 }
7661
7662 #endif /* HAVE_LIBREADLINE */
7663
7664 #ifdef HAVE_RL_COMPLETION_MATCHES
7665 #define RL_COMPLETION_MATCHES rl_completion_matches
7666 #else
7667 #ifdef HAVE_COMPLETION_MATCHES
7668 #define RL_COMPLETION_MATCHES completion_matches
7669 #endif
7670 #endif /* else just fail if we don't have either symbol */
7671
7672 char **
7673 do_completion (const char *text, int start, int end)
7674 {
7675   char **matches = NULL;
7676
7677 #ifdef HAVE_LIBREADLINE
7678   rl_completion_append_character = ' ';
7679
7680   if (start == 0)
7681     matches = RL_COMPLETION_MATCHES (text, generator);
7682   else if (complete_dest_paths)
7683     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7684 #endif
7685
7686   return matches;
7687 }
7688 ";
7689
7690 (* Generate the POD documentation for guestfish. *)
7691 and generate_fish_actions_pod () =
7692   let all_functions_sorted =
7693     List.filter (
7694       fun (_, _, _, flags, _, _, _) ->
7695         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7696     ) all_functions_sorted in
7697
7698   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7699
7700   List.iter (
7701     fun (name, style, _, flags, _, _, longdesc) ->
7702       let longdesc =
7703         Str.global_substitute rex (
7704           fun s ->
7705             let sub =
7706               try Str.matched_group 1 s
7707               with Not_found ->
7708                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7709             "C<" ^ replace_char sub '_' '-' ^ ">"
7710         ) longdesc in
7711       let name = replace_char name '_' '-' in
7712       let alias =
7713         try find_map (function FishAlias n -> Some n | _ -> None) flags
7714         with Not_found -> name in
7715
7716       pr "=head2 %s" name;
7717       if name <> alias then
7718         pr " | %s" alias;
7719       pr "\n";
7720       pr "\n";
7721       pr " %s" name;
7722       List.iter (
7723         function
7724         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7725         | OptString n -> pr " %s" n
7726         | StringList n | DeviceList n -> pr " '%s ...'" n
7727         | Bool _ -> pr " true|false"
7728         | Int n -> pr " %s" n
7729         | Int64 n -> pr " %s" n
7730         | FileIn n | FileOut n -> pr " (%s|-)" n
7731       ) (snd style);
7732       pr "\n";
7733       pr "\n";
7734       pr "%s\n\n" longdesc;
7735
7736       if List.exists (function FileIn _ | FileOut _ -> true
7737                       | _ -> false) (snd style) then
7738         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7739
7740       if List.mem ProtocolLimitWarning flags then
7741         pr "%s\n\n" protocol_limit_warning;
7742
7743       if List.mem DangerWillRobinson flags then
7744         pr "%s\n\n" danger_will_robinson;
7745
7746       match deprecation_notice flags with
7747       | None -> ()
7748       | Some txt -> pr "%s\n\n" txt
7749   ) all_functions_sorted
7750
7751 (* Generate a C function prototype. *)
7752 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7753     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7754     ?(prefix = "")
7755     ?handle name style =
7756   if extern then pr "extern ";
7757   if static then pr "static ";
7758   (match fst style with
7759    | RErr -> pr "int "
7760    | RInt _ -> pr "int "
7761    | RInt64 _ -> pr "int64_t "
7762    | RBool _ -> pr "int "
7763    | RConstString _ | RConstOptString _ -> pr "const char *"
7764    | RString _ | RBufferOut _ -> pr "char *"
7765    | RStringList _ | RHashtable _ -> pr "char **"
7766    | RStruct (_, typ) ->
7767        if not in_daemon then pr "struct guestfs_%s *" typ
7768        else pr "guestfs_int_%s *" typ
7769    | RStructList (_, typ) ->
7770        if not in_daemon then pr "struct guestfs_%s_list *" typ
7771        else pr "guestfs_int_%s_list *" typ
7772   );
7773   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7774   pr "%s%s (" prefix name;
7775   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7776     pr "void"
7777   else (
7778     let comma = ref false in
7779     (match handle with
7780      | None -> ()
7781      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7782     );
7783     let next () =
7784       if !comma then (
7785         if single_line then pr ", " else pr ",\n\t\t"
7786       );
7787       comma := true
7788     in
7789     List.iter (
7790       function
7791       | Pathname n
7792       | Device n | Dev_or_Path n
7793       | String n
7794       | OptString n ->
7795           next ();
7796           pr "const char *%s" n
7797       | StringList n | DeviceList n ->
7798           next ();
7799           pr "char *const *%s" n
7800       | Bool n -> next (); pr "int %s" n
7801       | Int n -> next (); pr "int %s" n
7802       | Int64 n -> next (); pr "int64_t %s" n
7803       | FileIn n
7804       | FileOut n ->
7805           if not in_daemon then (next (); pr "const char *%s" n)
7806     ) (snd style);
7807     if is_RBufferOut then (next (); pr "size_t *size_r");
7808   );
7809   pr ")";
7810   if semicolon then pr ";";
7811   if newline then pr "\n"
7812
7813 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7814 and generate_c_call_args ?handle ?(decl = false) style =
7815   pr "(";
7816   let comma = ref false in
7817   let next () =
7818     if !comma then pr ", ";
7819     comma := true
7820   in
7821   (match handle with
7822    | None -> ()
7823    | Some handle -> pr "%s" handle; comma := true
7824   );
7825   List.iter (
7826     fun arg ->
7827       next ();
7828       pr "%s" (name_of_argt arg)
7829   ) (snd style);
7830   (* For RBufferOut calls, add implicit &size parameter. *)
7831   if not decl then (
7832     match fst style with
7833     | RBufferOut _ ->
7834         next ();
7835         pr "&size"
7836     | _ -> ()
7837   );
7838   pr ")"
7839
7840 (* Generate the OCaml bindings interface. *)
7841 and generate_ocaml_mli () =
7842   generate_header OCamlStyle LGPLv2plus;
7843
7844   pr "\
7845 (** For API documentation you should refer to the C API
7846     in the guestfs(3) manual page.  The OCaml API uses almost
7847     exactly the same calls. *)
7848
7849 type t
7850 (** A [guestfs_h] handle. *)
7851
7852 exception Error of string
7853 (** This exception is raised when there is an error. *)
7854
7855 exception Handle_closed of string
7856 (** This exception is raised if you use a {!Guestfs.t} handle
7857     after calling {!close} on it.  The string is the name of
7858     the function. *)
7859
7860 val create : unit -> t
7861 (** Create a {!Guestfs.t} handle. *)
7862
7863 val close : t -> unit
7864 (** Close the {!Guestfs.t} handle and free up all resources used
7865     by it immediately.
7866
7867     Handles are closed by the garbage collector when they become
7868     unreferenced, but callers can call this in order to provide
7869     predictable cleanup. *)
7870
7871 ";
7872   generate_ocaml_structure_decls ();
7873
7874   (* The actions. *)
7875   List.iter (
7876     fun (name, style, _, _, _, shortdesc, _) ->
7877       generate_ocaml_prototype name style;
7878       pr "(** %s *)\n" shortdesc;
7879       pr "\n"
7880   ) all_functions_sorted
7881
7882 (* Generate the OCaml bindings implementation. *)
7883 and generate_ocaml_ml () =
7884   generate_header OCamlStyle LGPLv2plus;
7885
7886   pr "\
7887 type t
7888
7889 exception Error of string
7890 exception Handle_closed of string
7891
7892 external create : unit -> t = \"ocaml_guestfs_create\"
7893 external close : t -> unit = \"ocaml_guestfs_close\"
7894
7895 (* Give the exceptions names, so they can be raised from the C code. *)
7896 let () =
7897   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7898   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7899
7900 ";
7901
7902   generate_ocaml_structure_decls ();
7903
7904   (* The actions. *)
7905   List.iter (
7906     fun (name, style, _, _, _, shortdesc, _) ->
7907       generate_ocaml_prototype ~is_external:true name style;
7908   ) all_functions_sorted
7909
7910 (* Generate the OCaml bindings C implementation. *)
7911 and generate_ocaml_c () =
7912   generate_header CStyle LGPLv2plus;
7913
7914   pr "\
7915 #include <stdio.h>
7916 #include <stdlib.h>
7917 #include <string.h>
7918
7919 #include <caml/config.h>
7920 #include <caml/alloc.h>
7921 #include <caml/callback.h>
7922 #include <caml/fail.h>
7923 #include <caml/memory.h>
7924 #include <caml/mlvalues.h>
7925 #include <caml/signals.h>
7926
7927 #include \"guestfs.h\"
7928
7929 #include \"guestfs_c.h\"
7930
7931 /* Copy a hashtable of string pairs into an assoc-list.  We return
7932  * the list in reverse order, but hashtables aren't supposed to be
7933  * ordered anyway.
7934  */
7935 static CAMLprim value
7936 copy_table (char * const * argv)
7937 {
7938   CAMLparam0 ();
7939   CAMLlocal5 (rv, pairv, kv, vv, cons);
7940   int i;
7941
7942   rv = Val_int (0);
7943   for (i = 0; argv[i] != NULL; i += 2) {
7944     kv = caml_copy_string (argv[i]);
7945     vv = caml_copy_string (argv[i+1]);
7946     pairv = caml_alloc (2, 0);
7947     Store_field (pairv, 0, kv);
7948     Store_field (pairv, 1, vv);
7949     cons = caml_alloc (2, 0);
7950     Store_field (cons, 1, rv);
7951     rv = cons;
7952     Store_field (cons, 0, pairv);
7953   }
7954
7955   CAMLreturn (rv);
7956 }
7957
7958 ";
7959
7960   (* Struct copy functions. *)
7961
7962   let emit_ocaml_copy_list_function typ =
7963     pr "static CAMLprim value\n";
7964     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7965     pr "{\n";
7966     pr "  CAMLparam0 ();\n";
7967     pr "  CAMLlocal2 (rv, v);\n";
7968     pr "  unsigned int i;\n";
7969     pr "\n";
7970     pr "  if (%ss->len == 0)\n" typ;
7971     pr "    CAMLreturn (Atom (0));\n";
7972     pr "  else {\n";
7973     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7974     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7975     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7976     pr "      caml_modify (&Field (rv, i), v);\n";
7977     pr "    }\n";
7978     pr "    CAMLreturn (rv);\n";
7979     pr "  }\n";
7980     pr "}\n";
7981     pr "\n";
7982   in
7983
7984   List.iter (
7985     fun (typ, cols) ->
7986       let has_optpercent_col =
7987         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7988
7989       pr "static CAMLprim value\n";
7990       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7991       pr "{\n";
7992       pr "  CAMLparam0 ();\n";
7993       if has_optpercent_col then
7994         pr "  CAMLlocal3 (rv, v, v2);\n"
7995       else
7996         pr "  CAMLlocal2 (rv, v);\n";
7997       pr "\n";
7998       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7999       iteri (
8000         fun i col ->
8001           (match col with
8002            | name, FString ->
8003                pr "  v = caml_copy_string (%s->%s);\n" typ name
8004            | name, FBuffer ->
8005                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8006                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8007                  typ name typ name
8008            | name, FUUID ->
8009                pr "  v = caml_alloc_string (32);\n";
8010                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8011            | name, (FBytes|FInt64|FUInt64) ->
8012                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8013            | name, (FInt32|FUInt32) ->
8014                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8015            | name, FOptPercent ->
8016                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8017                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8018                pr "    v = caml_alloc (1, 0);\n";
8019                pr "    Store_field (v, 0, v2);\n";
8020                pr "  } else /* None */\n";
8021                pr "    v = Val_int (0);\n";
8022            | name, FChar ->
8023                pr "  v = Val_int (%s->%s);\n" typ name
8024           );
8025           pr "  Store_field (rv, %d, v);\n" i
8026       ) cols;
8027       pr "  CAMLreturn (rv);\n";
8028       pr "}\n";
8029       pr "\n";
8030   ) structs;
8031
8032   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8033   List.iter (
8034     function
8035     | typ, (RStructListOnly | RStructAndList) ->
8036         (* generate the function for typ *)
8037         emit_ocaml_copy_list_function typ
8038     | typ, _ -> () (* empty *)
8039   ) (rstructs_used_by all_functions);
8040
8041   (* The wrappers. *)
8042   List.iter (
8043     fun (name, style, _, _, _, _, _) ->
8044       pr "/* Automatically generated wrapper for function\n";
8045       pr " * ";
8046       generate_ocaml_prototype name style;
8047       pr " */\n";
8048       pr "\n";
8049
8050       let params =
8051         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8052
8053       let needs_extra_vs =
8054         match fst style with RConstOptString _ -> true | _ -> false in
8055
8056       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8057       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8058       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8059       pr "\n";
8060
8061       pr "CAMLprim value\n";
8062       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8063       List.iter (pr ", value %s") (List.tl params);
8064       pr ")\n";
8065       pr "{\n";
8066
8067       (match params with
8068        | [p1; p2; p3; p4; p5] ->
8069            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8070        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8071            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8072            pr "  CAMLxparam%d (%s);\n"
8073              (List.length rest) (String.concat ", " rest)
8074        | ps ->
8075            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8076       );
8077       if not needs_extra_vs then
8078         pr "  CAMLlocal1 (rv);\n"
8079       else
8080         pr "  CAMLlocal3 (rv, v, v2);\n";
8081       pr "\n";
8082
8083       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8084       pr "  if (g == NULL)\n";
8085       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8086       pr "\n";
8087
8088       List.iter (
8089         function
8090         | Pathname n
8091         | Device n | Dev_or_Path n
8092         | String n
8093         | FileIn n
8094         | FileOut n ->
8095             (* Copy strings in case the GC moves them: RHBZ#604691 *)
8096             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
8097         | OptString n ->
8098             pr "  char *%s =\n" n;
8099             pr "    %sv != Val_int (0) ?" n;
8100             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
8101         | StringList n | DeviceList n ->
8102             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8103         | Bool n ->
8104             pr "  int %s = Bool_val (%sv);\n" n n
8105         | Int n ->
8106             pr "  int %s = Int_val (%sv);\n" n n
8107         | Int64 n ->
8108             pr "  int64_t %s = Int64_val (%sv);\n" n n
8109       ) (snd style);
8110       let error_code =
8111         match fst style with
8112         | RErr -> pr "  int r;\n"; "-1"
8113         | RInt _ -> pr "  int r;\n"; "-1"
8114         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8115         | RBool _ -> pr "  int r;\n"; "-1"
8116         | RConstString _ | RConstOptString _ ->
8117             pr "  const char *r;\n"; "NULL"
8118         | RString _ -> pr "  char *r;\n"; "NULL"
8119         | RStringList _ ->
8120             pr "  int i;\n";
8121             pr "  char **r;\n";
8122             "NULL"
8123         | RStruct (_, typ) ->
8124             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8125         | RStructList (_, typ) ->
8126             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8127         | RHashtable _ ->
8128             pr "  int i;\n";
8129             pr "  char **r;\n";
8130             "NULL"
8131         | RBufferOut _ ->
8132             pr "  char *r;\n";
8133             pr "  size_t size;\n";
8134             "NULL" in
8135       pr "\n";
8136
8137       pr "  caml_enter_blocking_section ();\n";
8138       pr "  r = guestfs_%s " name;
8139       generate_c_call_args ~handle:"g" style;
8140       pr ";\n";
8141       pr "  caml_leave_blocking_section ();\n";
8142
8143       (* Free strings if we copied them above. *)
8144       List.iter (
8145         function
8146         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
8147         | FileIn n | FileOut n ->
8148             pr "  free (%s);\n" n
8149         | StringList n | DeviceList n ->
8150             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8151         | Bool _ | Int _ | Int64 _ -> ()
8152       ) (snd style);
8153
8154       pr "  if (r == %s)\n" error_code;
8155       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8156       pr "\n";
8157
8158       (match fst style with
8159        | RErr -> pr "  rv = Val_unit;\n"
8160        | RInt _ -> pr "  rv = Val_int (r);\n"
8161        | RInt64 _ ->
8162            pr "  rv = caml_copy_int64 (r);\n"
8163        | RBool _ -> pr "  rv = Val_bool (r);\n"
8164        | RConstString _ ->
8165            pr "  rv = caml_copy_string (r);\n"
8166        | RConstOptString _ ->
8167            pr "  if (r) { /* Some string */\n";
8168            pr "    v = caml_alloc (1, 0);\n";
8169            pr "    v2 = caml_copy_string (r);\n";
8170            pr "    Store_field (v, 0, v2);\n";
8171            pr "  } else /* None */\n";
8172            pr "    v = Val_int (0);\n";
8173        | RString _ ->
8174            pr "  rv = caml_copy_string (r);\n";
8175            pr "  free (r);\n"
8176        | RStringList _ ->
8177            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8178            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8179            pr "  free (r);\n"
8180        | RStruct (_, typ) ->
8181            pr "  rv = copy_%s (r);\n" typ;
8182            pr "  guestfs_free_%s (r);\n" typ;
8183        | RStructList (_, typ) ->
8184            pr "  rv = copy_%s_list (r);\n" typ;
8185            pr "  guestfs_free_%s_list (r);\n" typ;
8186        | RHashtable _ ->
8187            pr "  rv = copy_table (r);\n";
8188            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8189            pr "  free (r);\n";
8190        | RBufferOut _ ->
8191            pr "  rv = caml_alloc_string (size);\n";
8192            pr "  memcpy (String_val (rv), r, size);\n";
8193       );
8194
8195       pr "  CAMLreturn (rv);\n";
8196       pr "}\n";
8197       pr "\n";
8198
8199       if List.length params > 5 then (
8200         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8201         pr "CAMLprim value ";
8202         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8203         pr "CAMLprim value\n";
8204         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8205         pr "{\n";
8206         pr "  return ocaml_guestfs_%s (argv[0]" name;
8207         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8208         pr ");\n";
8209         pr "}\n";
8210         pr "\n"
8211       )
8212   ) all_functions_sorted
8213
8214 and generate_ocaml_structure_decls () =
8215   List.iter (
8216     fun (typ, cols) ->
8217       pr "type %s = {\n" typ;
8218       List.iter (
8219         function
8220         | name, FString -> pr "  %s : string;\n" name
8221         | name, FBuffer -> pr "  %s : string;\n" name
8222         | name, FUUID -> pr "  %s : string;\n" name
8223         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8224         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8225         | name, FChar -> pr "  %s : char;\n" name
8226         | name, FOptPercent -> pr "  %s : float option;\n" name
8227       ) cols;
8228       pr "}\n";
8229       pr "\n"
8230   ) structs
8231
8232 and generate_ocaml_prototype ?(is_external = false) name style =
8233   if is_external then pr "external " else pr "val ";
8234   pr "%s : t -> " name;
8235   List.iter (
8236     function
8237     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8238     | OptString _ -> pr "string option -> "
8239     | StringList _ | DeviceList _ -> pr "string array -> "
8240     | Bool _ -> pr "bool -> "
8241     | Int _ -> pr "int -> "
8242     | Int64 _ -> pr "int64 -> "
8243   ) (snd style);
8244   (match fst style with
8245    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8246    | RInt _ -> pr "int"
8247    | RInt64 _ -> pr "int64"
8248    | RBool _ -> pr "bool"
8249    | RConstString _ -> pr "string"
8250    | RConstOptString _ -> pr "string option"
8251    | RString _ | RBufferOut _ -> pr "string"
8252    | RStringList _ -> pr "string array"
8253    | RStruct (_, typ) -> pr "%s" typ
8254    | RStructList (_, typ) -> pr "%s array" typ
8255    | RHashtable _ -> pr "(string * string) list"
8256   );
8257   if is_external then (
8258     pr " = ";
8259     if List.length (snd style) + 1 > 5 then
8260       pr "\"ocaml_guestfs_%s_byte\" " name;
8261     pr "\"ocaml_guestfs_%s\"" name
8262   );
8263   pr "\n"
8264
8265 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8266 and generate_perl_xs () =
8267   generate_header CStyle LGPLv2plus;
8268
8269   pr "\
8270 #include \"EXTERN.h\"
8271 #include \"perl.h\"
8272 #include \"XSUB.h\"
8273
8274 #include <guestfs.h>
8275
8276 #ifndef PRId64
8277 #define PRId64 \"lld\"
8278 #endif
8279
8280 static SV *
8281 my_newSVll(long long val) {
8282 #ifdef USE_64_BIT_ALL
8283   return newSViv(val);
8284 #else
8285   char buf[100];
8286   int len;
8287   len = snprintf(buf, 100, \"%%\" PRId64, val);
8288   return newSVpv(buf, len);
8289 #endif
8290 }
8291
8292 #ifndef PRIu64
8293 #define PRIu64 \"llu\"
8294 #endif
8295
8296 static SV *
8297 my_newSVull(unsigned long long val) {
8298 #ifdef USE_64_BIT_ALL
8299   return newSVuv(val);
8300 #else
8301   char buf[100];
8302   int len;
8303   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8304   return newSVpv(buf, len);
8305 #endif
8306 }
8307
8308 /* http://www.perlmonks.org/?node_id=680842 */
8309 static char **
8310 XS_unpack_charPtrPtr (SV *arg) {
8311   char **ret;
8312   AV *av;
8313   I32 i;
8314
8315   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8316     croak (\"array reference expected\");
8317
8318   av = (AV *)SvRV (arg);
8319   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8320   if (!ret)
8321     croak (\"malloc failed\");
8322
8323   for (i = 0; i <= av_len (av); i++) {
8324     SV **elem = av_fetch (av, i, 0);
8325
8326     if (!elem || !*elem)
8327       croak (\"missing element in list\");
8328
8329     ret[i] = SvPV_nolen (*elem);
8330   }
8331
8332   ret[i] = NULL;
8333
8334   return ret;
8335 }
8336
8337 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8338
8339 PROTOTYPES: ENABLE
8340
8341 guestfs_h *
8342 _create ()
8343    CODE:
8344       RETVAL = guestfs_create ();
8345       if (!RETVAL)
8346         croak (\"could not create guestfs handle\");
8347       guestfs_set_error_handler (RETVAL, NULL, NULL);
8348  OUTPUT:
8349       RETVAL
8350
8351 void
8352 DESTROY (g)
8353       guestfs_h *g;
8354  PPCODE:
8355       guestfs_close (g);
8356
8357 ";
8358
8359   List.iter (
8360     fun (name, style, _, _, _, _, _) ->
8361       (match fst style with
8362        | RErr -> pr "void\n"
8363        | RInt _ -> pr "SV *\n"
8364        | RInt64 _ -> pr "SV *\n"
8365        | RBool _ -> pr "SV *\n"
8366        | RConstString _ -> pr "SV *\n"
8367        | RConstOptString _ -> pr "SV *\n"
8368        | RString _ -> pr "SV *\n"
8369        | RBufferOut _ -> pr "SV *\n"
8370        | RStringList _
8371        | RStruct _ | RStructList _
8372        | RHashtable _ ->
8373            pr "void\n" (* all lists returned implictly on the stack *)
8374       );
8375       (* Call and arguments. *)
8376       pr "%s " name;
8377       generate_c_call_args ~handle:"g" ~decl:true style;
8378       pr "\n";
8379       pr "      guestfs_h *g;\n";
8380       iteri (
8381         fun i ->
8382           function
8383           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8384               pr "      char *%s;\n" n
8385           | OptString n ->
8386               (* http://www.perlmonks.org/?node_id=554277
8387                * Note that the implicit handle argument means we have
8388                * to add 1 to the ST(x) operator.
8389                *)
8390               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8391           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8392           | Bool n -> pr "      int %s;\n" n
8393           | Int n -> pr "      int %s;\n" n
8394           | Int64 n -> pr "      int64_t %s;\n" n
8395       ) (snd style);
8396
8397       let do_cleanups () =
8398         List.iter (
8399           function
8400           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8401           | Bool _ | Int _ | Int64 _
8402           | FileIn _ | FileOut _ -> ()
8403           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8404         ) (snd style)
8405       in
8406
8407       (* Code. *)
8408       (match fst style with
8409        | RErr ->
8410            pr "PREINIT:\n";
8411            pr "      int r;\n";
8412            pr " PPCODE:\n";
8413            pr "      r = guestfs_%s " name;
8414            generate_c_call_args ~handle:"g" style;
8415            pr ";\n";
8416            do_cleanups ();
8417            pr "      if (r == -1)\n";
8418            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8419        | RInt n
8420        | RBool n ->
8421            pr "PREINIT:\n";
8422            pr "      int %s;\n" n;
8423            pr "   CODE:\n";
8424            pr "      %s = guestfs_%s " n name;
8425            generate_c_call_args ~handle:"g" style;
8426            pr ";\n";
8427            do_cleanups ();
8428            pr "      if (%s == -1)\n" n;
8429            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8430            pr "      RETVAL = newSViv (%s);\n" n;
8431            pr " OUTPUT:\n";
8432            pr "      RETVAL\n"
8433        | RInt64 n ->
8434            pr "PREINIT:\n";
8435            pr "      int64_t %s;\n" n;
8436            pr "   CODE:\n";
8437            pr "      %s = guestfs_%s " n name;
8438            generate_c_call_args ~handle:"g" style;
8439            pr ";\n";
8440            do_cleanups ();
8441            pr "      if (%s == -1)\n" n;
8442            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8443            pr "      RETVAL = my_newSVll (%s);\n" n;
8444            pr " OUTPUT:\n";
8445            pr "      RETVAL\n"
8446        | RConstString n ->
8447            pr "PREINIT:\n";
8448            pr "      const char *%s;\n" n;
8449            pr "   CODE:\n";
8450            pr "      %s = guestfs_%s " n name;
8451            generate_c_call_args ~handle:"g" style;
8452            pr ";\n";
8453            do_cleanups ();
8454            pr "      if (%s == NULL)\n" n;
8455            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8456            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8457            pr " OUTPUT:\n";
8458            pr "      RETVAL\n"
8459        | RConstOptString n ->
8460            pr "PREINIT:\n";
8461            pr "      const char *%s;\n" n;
8462            pr "   CODE:\n";
8463            pr "      %s = guestfs_%s " n name;
8464            generate_c_call_args ~handle:"g" style;
8465            pr ";\n";
8466            do_cleanups ();
8467            pr "      if (%s == NULL)\n" n;
8468            pr "        RETVAL = &PL_sv_undef;\n";
8469            pr "      else\n";
8470            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8471            pr " OUTPUT:\n";
8472            pr "      RETVAL\n"
8473        | RString n ->
8474            pr "PREINIT:\n";
8475            pr "      char *%s;\n" n;
8476            pr "   CODE:\n";
8477            pr "      %s = guestfs_%s " n name;
8478            generate_c_call_args ~handle:"g" style;
8479            pr ";\n";
8480            do_cleanups ();
8481            pr "      if (%s == NULL)\n" n;
8482            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8483            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8484            pr "      free (%s);\n" n;
8485            pr " OUTPUT:\n";
8486            pr "      RETVAL\n"
8487        | RStringList n | RHashtable n ->
8488            pr "PREINIT:\n";
8489            pr "      char **%s;\n" n;
8490            pr "      int i, n;\n";
8491            pr " PPCODE:\n";
8492            pr "      %s = guestfs_%s " n name;
8493            generate_c_call_args ~handle:"g" style;
8494            pr ";\n";
8495            do_cleanups ();
8496            pr "      if (%s == NULL)\n" n;
8497            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8498            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8499            pr "      EXTEND (SP, n);\n";
8500            pr "      for (i = 0; i < n; ++i) {\n";
8501            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8502            pr "        free (%s[i]);\n" n;
8503            pr "      }\n";
8504            pr "      free (%s);\n" n;
8505        | RStruct (n, typ) ->
8506            let cols = cols_of_struct typ in
8507            generate_perl_struct_code typ cols name style n do_cleanups
8508        | RStructList (n, typ) ->
8509            let cols = cols_of_struct typ in
8510            generate_perl_struct_list_code typ cols name style n do_cleanups
8511        | RBufferOut n ->
8512            pr "PREINIT:\n";
8513            pr "      char *%s;\n" n;
8514            pr "      size_t size;\n";
8515            pr "   CODE:\n";
8516            pr "      %s = guestfs_%s " n name;
8517            generate_c_call_args ~handle:"g" style;
8518            pr ";\n";
8519            do_cleanups ();
8520            pr "      if (%s == NULL)\n" n;
8521            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8522            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8523            pr "      free (%s);\n" n;
8524            pr " OUTPUT:\n";
8525            pr "      RETVAL\n"
8526       );
8527
8528       pr "\n"
8529   ) all_functions
8530
8531 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8532   pr "PREINIT:\n";
8533   pr "      struct guestfs_%s_list *%s;\n" typ n;
8534   pr "      int i;\n";
8535   pr "      HV *hv;\n";
8536   pr " PPCODE:\n";
8537   pr "      %s = guestfs_%s " n name;
8538   generate_c_call_args ~handle:"g" style;
8539   pr ";\n";
8540   do_cleanups ();
8541   pr "      if (%s == NULL)\n" n;
8542   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8543   pr "      EXTEND (SP, %s->len);\n" n;
8544   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8545   pr "        hv = newHV ();\n";
8546   List.iter (
8547     function
8548     | name, FString ->
8549         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8550           name (String.length name) n name
8551     | name, FUUID ->
8552         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8553           name (String.length name) n name
8554     | name, FBuffer ->
8555         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8556           name (String.length name) n name n name
8557     | name, (FBytes|FUInt64) ->
8558         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8559           name (String.length name) n name
8560     | name, FInt64 ->
8561         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8562           name (String.length name) n name
8563     | name, (FInt32|FUInt32) ->
8564         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8565           name (String.length name) n name
8566     | name, FChar ->
8567         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8568           name (String.length name) n name
8569     | name, FOptPercent ->
8570         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8571           name (String.length name) n name
8572   ) cols;
8573   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8574   pr "      }\n";
8575   pr "      guestfs_free_%s_list (%s);\n" typ n
8576
8577 and generate_perl_struct_code typ cols name style n do_cleanups =
8578   pr "PREINIT:\n";
8579   pr "      struct guestfs_%s *%s;\n" typ n;
8580   pr " PPCODE:\n";
8581   pr "      %s = guestfs_%s " n name;
8582   generate_c_call_args ~handle:"g" style;
8583   pr ";\n";
8584   do_cleanups ();
8585   pr "      if (%s == NULL)\n" n;
8586   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8587   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8588   List.iter (
8589     fun ((name, _) as col) ->
8590       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8591
8592       match col with
8593       | name, FString ->
8594           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8595             n name
8596       | name, FBuffer ->
8597           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8598             n name n name
8599       | name, FUUID ->
8600           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8601             n name
8602       | name, (FBytes|FUInt64) ->
8603           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8604             n name
8605       | name, FInt64 ->
8606           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8607             n name
8608       | name, (FInt32|FUInt32) ->
8609           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8610             n name
8611       | name, FChar ->
8612           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8613             n name
8614       | name, FOptPercent ->
8615           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8616             n name
8617   ) cols;
8618   pr "      free (%s);\n" n
8619
8620 (* Generate Sys/Guestfs.pm. *)
8621 and generate_perl_pm () =
8622   generate_header HashStyle LGPLv2plus;
8623
8624   pr "\
8625 =pod
8626
8627 =head1 NAME
8628
8629 Sys::Guestfs - Perl bindings for libguestfs
8630
8631 =head1 SYNOPSIS
8632
8633  use Sys::Guestfs;
8634
8635  my $h = Sys::Guestfs->new ();
8636  $h->add_drive ('guest.img');
8637  $h->launch ();
8638  $h->mount ('/dev/sda1', '/');
8639  $h->touch ('/hello');
8640  $h->sync ();
8641
8642 =head1 DESCRIPTION
8643
8644 The C<Sys::Guestfs> module provides a Perl XS binding to the
8645 libguestfs API for examining and modifying virtual machine
8646 disk images.
8647
8648 Amongst the things this is good for: making batch configuration
8649 changes to guests, getting disk used/free statistics (see also:
8650 virt-df), migrating between virtualization systems (see also:
8651 virt-p2v), performing partial backups, performing partial guest
8652 clones, cloning guests and changing registry/UUID/hostname info, and
8653 much else besides.
8654
8655 Libguestfs uses Linux kernel and qemu code, and can access any type of
8656 guest filesystem that Linux and qemu can, including but not limited
8657 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8658 schemes, qcow, qcow2, vmdk.
8659
8660 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8661 LVs, what filesystem is in each LV, etc.).  It can also run commands
8662 in the context of the guest.  Also you can access filesystems over
8663 FUSE.
8664
8665 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8666 functions for using libguestfs from Perl, including integration
8667 with libvirt.
8668
8669 =head1 ERRORS
8670
8671 All errors turn into calls to C<croak> (see L<Carp(3)>).
8672
8673 =head1 METHODS
8674
8675 =over 4
8676
8677 =cut
8678
8679 package Sys::Guestfs;
8680
8681 use strict;
8682 use warnings;
8683
8684 require XSLoader;
8685 XSLoader::load ('Sys::Guestfs');
8686
8687 =item $h = Sys::Guestfs->new ();
8688
8689 Create a new guestfs handle.
8690
8691 =cut
8692
8693 sub new {
8694   my $proto = shift;
8695   my $class = ref ($proto) || $proto;
8696
8697   my $self = Sys::Guestfs::_create ();
8698   bless $self, $class;
8699   return $self;
8700 }
8701
8702 ";
8703
8704   (* Actions.  We only need to print documentation for these as
8705    * they are pulled in from the XS code automatically.
8706    *)
8707   List.iter (
8708     fun (name, style, _, flags, _, _, longdesc) ->
8709       if not (List.mem NotInDocs flags) then (
8710         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8711         pr "=item ";
8712         generate_perl_prototype name style;
8713         pr "\n\n";
8714         pr "%s\n\n" longdesc;
8715         if List.mem ProtocolLimitWarning flags then
8716           pr "%s\n\n" protocol_limit_warning;
8717         if List.mem DangerWillRobinson flags then
8718           pr "%s\n\n" danger_will_robinson;
8719         match deprecation_notice flags with
8720         | None -> ()
8721         | Some txt -> pr "%s\n\n" txt
8722       )
8723   ) all_functions_sorted;
8724
8725   (* End of file. *)
8726   pr "\
8727 =cut
8728
8729 1;
8730
8731 =back
8732
8733 =head1 COPYRIGHT
8734
8735 Copyright (C) %s Red Hat Inc.
8736
8737 =head1 LICENSE
8738
8739 Please see the file COPYING.LIB for the full license.
8740
8741 =head1 SEE ALSO
8742
8743 L<guestfs(3)>,
8744 L<guestfish(1)>,
8745 L<http://libguestfs.org>,
8746 L<Sys::Guestfs::Lib(3)>.
8747
8748 =cut
8749 " copyright_years
8750
8751 and generate_perl_prototype name style =
8752   (match fst style with
8753    | RErr -> ()
8754    | RBool n
8755    | RInt n
8756    | RInt64 n
8757    | RConstString n
8758    | RConstOptString n
8759    | RString n
8760    | RBufferOut n -> pr "$%s = " n
8761    | RStruct (n,_)
8762    | RHashtable n -> pr "%%%s = " n
8763    | RStringList n
8764    | RStructList (n,_) -> pr "@%s = " n
8765   );
8766   pr "$h->%s (" name;
8767   let comma = ref false in
8768   List.iter (
8769     fun arg ->
8770       if !comma then pr ", ";
8771       comma := true;
8772       match arg with
8773       | Pathname n | Device n | Dev_or_Path n | String n
8774       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8775           pr "$%s" n
8776       | StringList n | DeviceList n ->
8777           pr "\\@%s" n
8778   ) (snd style);
8779   pr ");"
8780
8781 (* Generate Python C module. *)
8782 and generate_python_c () =
8783   generate_header CStyle LGPLv2plus;
8784
8785   pr "\
8786 #include <Python.h>
8787
8788 #include <stdio.h>
8789 #include <stdlib.h>
8790 #include <assert.h>
8791
8792 #include \"guestfs.h\"
8793
8794 typedef struct {
8795   PyObject_HEAD
8796   guestfs_h *g;
8797 } Pyguestfs_Object;
8798
8799 static guestfs_h *
8800 get_handle (PyObject *obj)
8801 {
8802   assert (obj);
8803   assert (obj != Py_None);
8804   return ((Pyguestfs_Object *) obj)->g;
8805 }
8806
8807 static PyObject *
8808 put_handle (guestfs_h *g)
8809 {
8810   assert (g);
8811   return
8812     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8813 }
8814
8815 /* This list should be freed (but not the strings) after use. */
8816 static char **
8817 get_string_list (PyObject *obj)
8818 {
8819   int i, len;
8820   char **r;
8821
8822   assert (obj);
8823
8824   if (!PyList_Check (obj)) {
8825     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8826     return NULL;
8827   }
8828
8829   len = PyList_Size (obj);
8830   r = malloc (sizeof (char *) * (len+1));
8831   if (r == NULL) {
8832     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8833     return NULL;
8834   }
8835
8836   for (i = 0; i < len; ++i)
8837     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8838   r[len] = NULL;
8839
8840   return r;
8841 }
8842
8843 static PyObject *
8844 put_string_list (char * const * const argv)
8845 {
8846   PyObject *list;
8847   int argc, i;
8848
8849   for (argc = 0; argv[argc] != NULL; ++argc)
8850     ;
8851
8852   list = PyList_New (argc);
8853   for (i = 0; i < argc; ++i)
8854     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8855
8856   return list;
8857 }
8858
8859 static PyObject *
8860 put_table (char * const * const argv)
8861 {
8862   PyObject *list, *item;
8863   int argc, i;
8864
8865   for (argc = 0; argv[argc] != NULL; ++argc)
8866     ;
8867
8868   list = PyList_New (argc >> 1);
8869   for (i = 0; i < argc; i += 2) {
8870     item = PyTuple_New (2);
8871     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8872     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8873     PyList_SetItem (list, i >> 1, item);
8874   }
8875
8876   return list;
8877 }
8878
8879 static void
8880 free_strings (char **argv)
8881 {
8882   int argc;
8883
8884   for (argc = 0; argv[argc] != NULL; ++argc)
8885     free (argv[argc]);
8886   free (argv);
8887 }
8888
8889 static PyObject *
8890 py_guestfs_create (PyObject *self, PyObject *args)
8891 {
8892   guestfs_h *g;
8893
8894   g = guestfs_create ();
8895   if (g == NULL) {
8896     PyErr_SetString (PyExc_RuntimeError,
8897                      \"guestfs.create: failed to allocate handle\");
8898     return NULL;
8899   }
8900   guestfs_set_error_handler (g, NULL, NULL);
8901   return put_handle (g);
8902 }
8903
8904 static PyObject *
8905 py_guestfs_close (PyObject *self, PyObject *args)
8906 {
8907   PyObject *py_g;
8908   guestfs_h *g;
8909
8910   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8911     return NULL;
8912   g = get_handle (py_g);
8913
8914   guestfs_close (g);
8915
8916   Py_INCREF (Py_None);
8917   return Py_None;
8918 }
8919
8920 ";
8921
8922   let emit_put_list_function typ =
8923     pr "static PyObject *\n";
8924     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8925     pr "{\n";
8926     pr "  PyObject *list;\n";
8927     pr "  int i;\n";
8928     pr "\n";
8929     pr "  list = PyList_New (%ss->len);\n" typ;
8930     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8931     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8932     pr "  return list;\n";
8933     pr "};\n";
8934     pr "\n"
8935   in
8936
8937   (* Structures, turned into Python dictionaries. *)
8938   List.iter (
8939     fun (typ, cols) ->
8940       pr "static PyObject *\n";
8941       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8942       pr "{\n";
8943       pr "  PyObject *dict;\n";
8944       pr "\n";
8945       pr "  dict = PyDict_New ();\n";
8946       List.iter (
8947         function
8948         | name, FString ->
8949             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8950             pr "                        PyString_FromString (%s->%s));\n"
8951               typ name
8952         | name, FBuffer ->
8953             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8954             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8955               typ name typ name
8956         | name, FUUID ->
8957             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8958             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8959               typ name
8960         | name, (FBytes|FUInt64) ->
8961             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8962             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8963               typ name
8964         | name, FInt64 ->
8965             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8966             pr "                        PyLong_FromLongLong (%s->%s));\n"
8967               typ name
8968         | name, FUInt32 ->
8969             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8970             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8971               typ name
8972         | name, FInt32 ->
8973             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8974             pr "                        PyLong_FromLong (%s->%s));\n"
8975               typ name
8976         | name, FOptPercent ->
8977             pr "  if (%s->%s >= 0)\n" typ name;
8978             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8979             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8980               typ name;
8981             pr "  else {\n";
8982             pr "    Py_INCREF (Py_None);\n";
8983             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8984             pr "  }\n"
8985         | name, FChar ->
8986             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8987             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8988       ) cols;
8989       pr "  return dict;\n";
8990       pr "};\n";
8991       pr "\n";
8992
8993   ) structs;
8994
8995   (* Emit a put_TYPE_list function definition only if that function is used. *)
8996   List.iter (
8997     function
8998     | typ, (RStructListOnly | RStructAndList) ->
8999         (* generate the function for typ *)
9000         emit_put_list_function typ
9001     | typ, _ -> () (* empty *)
9002   ) (rstructs_used_by all_functions);
9003
9004   (* Python wrapper functions. *)
9005   List.iter (
9006     fun (name, style, _, _, _, _, _) ->
9007       pr "static PyObject *\n";
9008       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9009       pr "{\n";
9010
9011       pr "  PyObject *py_g;\n";
9012       pr "  guestfs_h *g;\n";
9013       pr "  PyObject *py_r;\n";
9014
9015       let error_code =
9016         match fst style with
9017         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9018         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9019         | RConstString _ | RConstOptString _ ->
9020             pr "  const char *r;\n"; "NULL"
9021         | RString _ -> pr "  char *r;\n"; "NULL"
9022         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9023         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9024         | RStructList (_, typ) ->
9025             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9026         | RBufferOut _ ->
9027             pr "  char *r;\n";
9028             pr "  size_t size;\n";
9029             "NULL" in
9030
9031       List.iter (
9032         function
9033         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9034             pr "  const char *%s;\n" n
9035         | OptString n -> pr "  const char *%s;\n" n
9036         | StringList n | DeviceList n ->
9037             pr "  PyObject *py_%s;\n" n;
9038             pr "  char **%s;\n" n
9039         | Bool n -> pr "  int %s;\n" n
9040         | Int n -> pr "  int %s;\n" n
9041         | Int64 n -> pr "  long long %s;\n" n
9042       ) (snd style);
9043
9044       pr "\n";
9045
9046       (* Convert the parameters. *)
9047       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9048       List.iter (
9049         function
9050         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9051         | OptString _ -> pr "z"
9052         | StringList _ | DeviceList _ -> pr "O"
9053         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9054         | Int _ -> pr "i"
9055         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9056                              * emulate C's int/long/long long in Python?
9057                              *)
9058       ) (snd style);
9059       pr ":guestfs_%s\",\n" name;
9060       pr "                         &py_g";
9061       List.iter (
9062         function
9063         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9064         | OptString n -> pr ", &%s" n
9065         | StringList n | DeviceList n -> pr ", &py_%s" n
9066         | Bool n -> pr ", &%s" n
9067         | Int n -> pr ", &%s" n
9068         | Int64 n -> pr ", &%s" n
9069       ) (snd style);
9070
9071       pr "))\n";
9072       pr "    return NULL;\n";
9073
9074       pr "  g = get_handle (py_g);\n";
9075       List.iter (
9076         function
9077         | Pathname _ | Device _ | Dev_or_Path _ | String _
9078         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9079         | StringList n | DeviceList n ->
9080             pr "  %s = get_string_list (py_%s);\n" n n;
9081             pr "  if (!%s) return NULL;\n" n
9082       ) (snd style);
9083
9084       pr "\n";
9085
9086       pr "  r = guestfs_%s " name;
9087       generate_c_call_args ~handle:"g" style;
9088       pr ";\n";
9089
9090       List.iter (
9091         function
9092         | Pathname _ | Device _ | Dev_or_Path _ | String _
9093         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9094         | StringList n | DeviceList n ->
9095             pr "  free (%s);\n" n
9096       ) (snd style);
9097
9098       pr "  if (r == %s) {\n" error_code;
9099       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9100       pr "    return NULL;\n";
9101       pr "  }\n";
9102       pr "\n";
9103
9104       (match fst style with
9105        | RErr ->
9106            pr "  Py_INCREF (Py_None);\n";
9107            pr "  py_r = Py_None;\n"
9108        | RInt _
9109        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9110        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9111        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9112        | RConstOptString _ ->
9113            pr "  if (r)\n";
9114            pr "    py_r = PyString_FromString (r);\n";
9115            pr "  else {\n";
9116            pr "    Py_INCREF (Py_None);\n";
9117            pr "    py_r = Py_None;\n";
9118            pr "  }\n"
9119        | RString _ ->
9120            pr "  py_r = PyString_FromString (r);\n";
9121            pr "  free (r);\n"
9122        | RStringList _ ->
9123            pr "  py_r = put_string_list (r);\n";
9124            pr "  free_strings (r);\n"
9125        | RStruct (_, typ) ->
9126            pr "  py_r = put_%s (r);\n" typ;
9127            pr "  guestfs_free_%s (r);\n" typ
9128        | RStructList (_, typ) ->
9129            pr "  py_r = put_%s_list (r);\n" typ;
9130            pr "  guestfs_free_%s_list (r);\n" typ
9131        | RHashtable n ->
9132            pr "  py_r = put_table (r);\n";
9133            pr "  free_strings (r);\n"
9134        | RBufferOut _ ->
9135            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9136            pr "  free (r);\n"
9137       );
9138
9139       pr "  return py_r;\n";
9140       pr "}\n";
9141       pr "\n"
9142   ) all_functions;
9143
9144   (* Table of functions. *)
9145   pr "static PyMethodDef methods[] = {\n";
9146   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9147   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9148   List.iter (
9149     fun (name, _, _, _, _, _, _) ->
9150       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9151         name name
9152   ) all_functions;
9153   pr "  { NULL, NULL, 0, NULL }\n";
9154   pr "};\n";
9155   pr "\n";
9156
9157   (* Init function. *)
9158   pr "\
9159 void
9160 initlibguestfsmod (void)
9161 {
9162   static int initialized = 0;
9163
9164   if (initialized) return;
9165   Py_InitModule ((char *) \"libguestfsmod\", methods);
9166   initialized = 1;
9167 }
9168 "
9169
9170 (* Generate Python module. *)
9171 and generate_python_py () =
9172   generate_header HashStyle LGPLv2plus;
9173
9174   pr "\
9175 u\"\"\"Python bindings for libguestfs
9176
9177 import guestfs
9178 g = guestfs.GuestFS ()
9179 g.add_drive (\"guest.img\")
9180 g.launch ()
9181 parts = g.list_partitions ()
9182
9183 The guestfs module provides a Python binding to the libguestfs API
9184 for examining and modifying virtual machine disk images.
9185
9186 Amongst the things this is good for: making batch configuration
9187 changes to guests, getting disk used/free statistics (see also:
9188 virt-df), migrating between virtualization systems (see also:
9189 virt-p2v), performing partial backups, performing partial guest
9190 clones, cloning guests and changing registry/UUID/hostname info, and
9191 much else besides.
9192
9193 Libguestfs uses Linux kernel and qemu code, and can access any type of
9194 guest filesystem that Linux and qemu can, including but not limited
9195 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9196 schemes, qcow, qcow2, vmdk.
9197
9198 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9199 LVs, what filesystem is in each LV, etc.).  It can also run commands
9200 in the context of the guest.  Also you can access filesystems over
9201 FUSE.
9202
9203 Errors which happen while using the API are turned into Python
9204 RuntimeError exceptions.
9205
9206 To create a guestfs handle you usually have to perform the following
9207 sequence of calls:
9208
9209 # Create the handle, call add_drive at least once, and possibly
9210 # several times if the guest has multiple block devices:
9211 g = guestfs.GuestFS ()
9212 g.add_drive (\"guest.img\")
9213
9214 # Launch the qemu subprocess and wait for it to become ready:
9215 g.launch ()
9216
9217 # Now you can issue commands, for example:
9218 logvols = g.lvs ()
9219
9220 \"\"\"
9221
9222 import libguestfsmod
9223
9224 class GuestFS:
9225     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9226
9227     def __init__ (self):
9228         \"\"\"Create a new libguestfs handle.\"\"\"
9229         self._o = libguestfsmod.create ()
9230
9231     def __del__ (self):
9232         libguestfsmod.close (self._o)
9233
9234 ";
9235
9236   List.iter (
9237     fun (name, style, _, flags, _, _, longdesc) ->
9238       pr "    def %s " name;
9239       generate_py_call_args ~handle:"self" (snd style);
9240       pr ":\n";
9241
9242       if not (List.mem NotInDocs flags) then (
9243         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9244         let doc =
9245           match fst style with
9246           | RErr | RInt _ | RInt64 _ | RBool _
9247           | RConstOptString _ | RConstString _
9248           | RString _ | RBufferOut _ -> doc
9249           | RStringList _ ->
9250               doc ^ "\n\nThis function returns a list of strings."
9251           | RStruct (_, typ) ->
9252               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9253           | RStructList (_, typ) ->
9254               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9255           | RHashtable _ ->
9256               doc ^ "\n\nThis function returns a dictionary." in
9257         let doc =
9258           if List.mem ProtocolLimitWarning flags then
9259             doc ^ "\n\n" ^ protocol_limit_warning
9260           else doc in
9261         let doc =
9262           if List.mem DangerWillRobinson flags then
9263             doc ^ "\n\n" ^ danger_will_robinson
9264           else doc in
9265         let doc =
9266           match deprecation_notice flags with
9267           | None -> doc
9268           | Some txt -> doc ^ "\n\n" ^ txt in
9269         let doc = pod2text ~width:60 name doc in
9270         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9271         let doc = String.concat "\n        " doc in
9272         pr "        u\"\"\"%s\"\"\"\n" doc;
9273       );
9274       pr "        return libguestfsmod.%s " name;
9275       generate_py_call_args ~handle:"self._o" (snd style);
9276       pr "\n";
9277       pr "\n";
9278   ) all_functions
9279
9280 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9281 and generate_py_call_args ~handle args =
9282   pr "(%s" handle;
9283   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9284   pr ")"
9285
9286 (* Useful if you need the longdesc POD text as plain text.  Returns a
9287  * list of lines.
9288  *
9289  * Because this is very slow (the slowest part of autogeneration),
9290  * we memoize the results.
9291  *)
9292 and pod2text ~width name longdesc =
9293   let key = width, name, longdesc in
9294   try Hashtbl.find pod2text_memo key
9295   with Not_found ->
9296     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9297     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9298     close_out chan;
9299     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9300     let chan = open_process_in cmd in
9301     let lines = ref [] in
9302     let rec loop i =
9303       let line = input_line chan in
9304       if i = 1 then             (* discard the first line of output *)
9305         loop (i+1)
9306       else (
9307         let line = triml line in
9308         lines := line :: !lines;
9309         loop (i+1)
9310       ) in
9311     let lines = try loop 1 with End_of_file -> List.rev !lines in
9312     unlink filename;
9313     (match close_process_in chan with
9314      | WEXITED 0 -> ()
9315      | WEXITED i ->
9316          failwithf "pod2text: process exited with non-zero status (%d)" i
9317      | WSIGNALED i | WSTOPPED i ->
9318          failwithf "pod2text: process signalled or stopped by signal %d" i
9319     );
9320     Hashtbl.add pod2text_memo key lines;
9321     pod2text_memo_updated ();
9322     lines
9323
9324 (* Generate ruby bindings. *)
9325 and generate_ruby_c () =
9326   generate_header CStyle LGPLv2plus;
9327
9328   pr "\
9329 #include <stdio.h>
9330 #include <stdlib.h>
9331
9332 #include <ruby.h>
9333
9334 #include \"guestfs.h\"
9335
9336 #include \"extconf.h\"
9337
9338 /* For Ruby < 1.9 */
9339 #ifndef RARRAY_LEN
9340 #define RARRAY_LEN(r) (RARRAY((r))->len)
9341 #endif
9342
9343 static VALUE m_guestfs;                 /* guestfs module */
9344 static VALUE c_guestfs;                 /* guestfs_h handle */
9345 static VALUE e_Error;                   /* used for all errors */
9346
9347 static void ruby_guestfs_free (void *p)
9348 {
9349   if (!p) return;
9350   guestfs_close ((guestfs_h *) p);
9351 }
9352
9353 static VALUE ruby_guestfs_create (VALUE m)
9354 {
9355   guestfs_h *g;
9356
9357   g = guestfs_create ();
9358   if (!g)
9359     rb_raise (e_Error, \"failed to create guestfs handle\");
9360
9361   /* Don't print error messages to stderr by default. */
9362   guestfs_set_error_handler (g, NULL, NULL);
9363
9364   /* Wrap it, and make sure the close function is called when the
9365    * handle goes away.
9366    */
9367   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9368 }
9369
9370 static VALUE ruby_guestfs_close (VALUE gv)
9371 {
9372   guestfs_h *g;
9373   Data_Get_Struct (gv, guestfs_h, g);
9374
9375   ruby_guestfs_free (g);
9376   DATA_PTR (gv) = NULL;
9377
9378   return Qnil;
9379 }
9380
9381 ";
9382
9383   List.iter (
9384     fun (name, style, _, _, _, _, _) ->
9385       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9386       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9387       pr ")\n";
9388       pr "{\n";
9389       pr "  guestfs_h *g;\n";
9390       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9391       pr "  if (!g)\n";
9392       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9393         name;
9394       pr "\n";
9395
9396       List.iter (
9397         function
9398         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9399             pr "  Check_Type (%sv, T_STRING);\n" n;
9400             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9401             pr "  if (!%s)\n" n;
9402             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9403             pr "              \"%s\", \"%s\");\n" n name
9404         | OptString n ->
9405             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9406         | StringList n | DeviceList n ->
9407             pr "  char **%s;\n" n;
9408             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9409             pr "  {\n";
9410             pr "    int i, len;\n";
9411             pr "    len = RARRAY_LEN (%sv);\n" n;
9412             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9413               n;
9414             pr "    for (i = 0; i < len; ++i) {\n";
9415             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9416             pr "      %s[i] = StringValueCStr (v);\n" n;
9417             pr "    }\n";
9418             pr "    %s[len] = NULL;\n" n;
9419             pr "  }\n";
9420         | Bool n ->
9421             pr "  int %s = RTEST (%sv);\n" n n
9422         | Int n ->
9423             pr "  int %s = NUM2INT (%sv);\n" n n
9424         | Int64 n ->
9425             pr "  long long %s = NUM2LL (%sv);\n" n n
9426       ) (snd style);
9427       pr "\n";
9428
9429       let error_code =
9430         match fst style with
9431         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9432         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9433         | RConstString _ | RConstOptString _ ->
9434             pr "  const char *r;\n"; "NULL"
9435         | RString _ -> pr "  char *r;\n"; "NULL"
9436         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9437         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9438         | RStructList (_, typ) ->
9439             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9440         | RBufferOut _ ->
9441             pr "  char *r;\n";
9442             pr "  size_t size;\n";
9443             "NULL" in
9444       pr "\n";
9445
9446       pr "  r = guestfs_%s " name;
9447       generate_c_call_args ~handle:"g" style;
9448       pr ";\n";
9449
9450       List.iter (
9451         function
9452         | Pathname _ | Device _ | Dev_or_Path _ | String _
9453         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9454         | StringList n | DeviceList n ->
9455             pr "  free (%s);\n" n
9456       ) (snd style);
9457
9458       pr "  if (r == %s)\n" error_code;
9459       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9460       pr "\n";
9461
9462       (match fst style with
9463        | RErr ->
9464            pr "  return Qnil;\n"
9465        | RInt _ | RBool _ ->
9466            pr "  return INT2NUM (r);\n"
9467        | RInt64 _ ->
9468            pr "  return ULL2NUM (r);\n"
9469        | RConstString _ ->
9470            pr "  return rb_str_new2 (r);\n";
9471        | RConstOptString _ ->
9472            pr "  if (r)\n";
9473            pr "    return rb_str_new2 (r);\n";
9474            pr "  else\n";
9475            pr "    return Qnil;\n";
9476        | RString _ ->
9477            pr "  VALUE rv = rb_str_new2 (r);\n";
9478            pr "  free (r);\n";
9479            pr "  return rv;\n";
9480        | RStringList _ ->
9481            pr "  int i, len = 0;\n";
9482            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9483            pr "  VALUE rv = rb_ary_new2 (len);\n";
9484            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9485            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9486            pr "    free (r[i]);\n";
9487            pr "  }\n";
9488            pr "  free (r);\n";
9489            pr "  return rv;\n"
9490        | RStruct (_, typ) ->
9491            let cols = cols_of_struct typ in
9492            generate_ruby_struct_code typ cols
9493        | RStructList (_, typ) ->
9494            let cols = cols_of_struct typ in
9495            generate_ruby_struct_list_code typ cols
9496        | RHashtable _ ->
9497            pr "  VALUE rv = rb_hash_new ();\n";
9498            pr "  int i;\n";
9499            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9500            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9501            pr "    free (r[i]);\n";
9502            pr "    free (r[i+1]);\n";
9503            pr "  }\n";
9504            pr "  free (r);\n";
9505            pr "  return rv;\n"
9506        | RBufferOut _ ->
9507            pr "  VALUE rv = rb_str_new (r, size);\n";
9508            pr "  free (r);\n";
9509            pr "  return rv;\n";
9510       );
9511
9512       pr "}\n";
9513       pr "\n"
9514   ) all_functions;
9515
9516   pr "\
9517 /* Initialize the module. */
9518 void Init__guestfs ()
9519 {
9520   m_guestfs = rb_define_module (\"Guestfs\");
9521   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9522   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9523
9524   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9525   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9526
9527 ";
9528   (* Define the rest of the methods. *)
9529   List.iter (
9530     fun (name, style, _, _, _, _, _) ->
9531       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9532       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9533   ) all_functions;
9534
9535   pr "}\n"
9536
9537 (* Ruby code to return a struct. *)
9538 and generate_ruby_struct_code typ cols =
9539   pr "  VALUE rv = rb_hash_new ();\n";
9540   List.iter (
9541     function
9542     | name, FString ->
9543         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9544     | name, FBuffer ->
9545         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9546     | name, FUUID ->
9547         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9548     | name, (FBytes|FUInt64) ->
9549         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9550     | name, FInt64 ->
9551         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9552     | name, FUInt32 ->
9553         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9554     | name, FInt32 ->
9555         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9556     | name, FOptPercent ->
9557         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9558     | name, FChar -> (* XXX wrong? *)
9559         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9560   ) cols;
9561   pr "  guestfs_free_%s (r);\n" typ;
9562   pr "  return rv;\n"
9563
9564 (* Ruby code to return a struct list. *)
9565 and generate_ruby_struct_list_code typ cols =
9566   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9567   pr "  int i;\n";
9568   pr "  for (i = 0; i < r->len; ++i) {\n";
9569   pr "    VALUE hv = rb_hash_new ();\n";
9570   List.iter (
9571     function
9572     | name, FString ->
9573         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9574     | name, FBuffer ->
9575         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
9576     | name, FUUID ->
9577         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9578     | name, (FBytes|FUInt64) ->
9579         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9580     | name, FInt64 ->
9581         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9582     | name, FUInt32 ->
9583         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9584     | name, FInt32 ->
9585         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9586     | name, FOptPercent ->
9587         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9588     | name, FChar -> (* XXX wrong? *)
9589         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9590   ) cols;
9591   pr "    rb_ary_push (rv, hv);\n";
9592   pr "  }\n";
9593   pr "  guestfs_free_%s_list (r);\n" typ;
9594   pr "  return rv;\n"
9595
9596 (* Generate Java bindings GuestFS.java file. *)
9597 and generate_java_java () =
9598   generate_header CStyle LGPLv2plus;
9599
9600   pr "\
9601 package com.redhat.et.libguestfs;
9602
9603 import java.util.HashMap;
9604 import com.redhat.et.libguestfs.LibGuestFSException;
9605 import com.redhat.et.libguestfs.PV;
9606 import com.redhat.et.libguestfs.VG;
9607 import com.redhat.et.libguestfs.LV;
9608 import com.redhat.et.libguestfs.Stat;
9609 import com.redhat.et.libguestfs.StatVFS;
9610 import com.redhat.et.libguestfs.IntBool;
9611 import com.redhat.et.libguestfs.Dirent;
9612
9613 /**
9614  * The GuestFS object is a libguestfs handle.
9615  *
9616  * @author rjones
9617  */
9618 public class GuestFS {
9619   // Load the native code.
9620   static {
9621     System.loadLibrary (\"guestfs_jni\");
9622   }
9623
9624   /**
9625    * The native guestfs_h pointer.
9626    */
9627   long g;
9628
9629   /**
9630    * Create a libguestfs handle.
9631    *
9632    * @throws LibGuestFSException
9633    */
9634   public GuestFS () throws LibGuestFSException
9635   {
9636     g = _create ();
9637   }
9638   private native long _create () throws LibGuestFSException;
9639
9640   /**
9641    * Close a libguestfs handle.
9642    *
9643    * You can also leave handles to be collected by the garbage
9644    * collector, but this method ensures that the resources used
9645    * by the handle are freed up immediately.  If you call any
9646    * other methods after closing the handle, you will get an
9647    * exception.
9648    *
9649    * @throws LibGuestFSException
9650    */
9651   public void close () throws LibGuestFSException
9652   {
9653     if (g != 0)
9654       _close (g);
9655     g = 0;
9656   }
9657   private native void _close (long g) throws LibGuestFSException;
9658
9659   public void finalize () throws LibGuestFSException
9660   {
9661     close ();
9662   }
9663
9664 ";
9665
9666   List.iter (
9667     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9668       if not (List.mem NotInDocs flags); then (
9669         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9670         let doc =
9671           if List.mem ProtocolLimitWarning flags then
9672             doc ^ "\n\n" ^ protocol_limit_warning
9673           else doc in
9674         let doc =
9675           if List.mem DangerWillRobinson flags then
9676             doc ^ "\n\n" ^ danger_will_robinson
9677           else doc in
9678         let doc =
9679           match deprecation_notice flags with
9680           | None -> doc
9681           | Some txt -> doc ^ "\n\n" ^ txt in
9682         let doc = pod2text ~width:60 name doc in
9683         let doc = List.map (            (* RHBZ#501883 *)
9684           function
9685           | "" -> "<p>"
9686           | nonempty -> nonempty
9687         ) doc in
9688         let doc = String.concat "\n   * " doc in
9689
9690         pr "  /**\n";
9691         pr "   * %s\n" shortdesc;
9692         pr "   * <p>\n";
9693         pr "   * %s\n" doc;
9694         pr "   * @throws LibGuestFSException\n";
9695         pr "   */\n";
9696         pr "  ";
9697       );
9698       generate_java_prototype ~public:true ~semicolon:false name style;
9699       pr "\n";
9700       pr "  {\n";
9701       pr "    if (g == 0)\n";
9702       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9703         name;
9704       pr "    ";
9705       if fst style <> RErr then pr "return ";
9706       pr "_%s " name;
9707       generate_java_call_args ~handle:"g" (snd style);
9708       pr ";\n";
9709       pr "  }\n";
9710       pr "  ";
9711       generate_java_prototype ~privat:true ~native:true name style;
9712       pr "\n";
9713       pr "\n";
9714   ) all_functions;
9715
9716   pr "}\n"
9717
9718 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9719 and generate_java_call_args ~handle args =
9720   pr "(%s" handle;
9721   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9722   pr ")"
9723
9724 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9725     ?(semicolon=true) name style =
9726   if privat then pr "private ";
9727   if public then pr "public ";
9728   if native then pr "native ";
9729
9730   (* return type *)
9731   (match fst style with
9732    | RErr -> pr "void ";
9733    | RInt _ -> pr "int ";
9734    | RInt64 _ -> pr "long ";
9735    | RBool _ -> pr "boolean ";
9736    | RConstString _ | RConstOptString _ | RString _
9737    | RBufferOut _ -> pr "String ";
9738    | RStringList _ -> pr "String[] ";
9739    | RStruct (_, typ) ->
9740        let name = java_name_of_struct typ in
9741        pr "%s " name;
9742    | RStructList (_, typ) ->
9743        let name = java_name_of_struct typ in
9744        pr "%s[] " name;
9745    | RHashtable _ -> pr "HashMap<String,String> ";
9746   );
9747
9748   if native then pr "_%s " name else pr "%s " name;
9749   pr "(";
9750   let needs_comma = ref false in
9751   if native then (
9752     pr "long g";
9753     needs_comma := true
9754   );
9755
9756   (* args *)
9757   List.iter (
9758     fun arg ->
9759       if !needs_comma then pr ", ";
9760       needs_comma := true;
9761
9762       match arg with
9763       | Pathname n
9764       | Device n | Dev_or_Path n
9765       | String n
9766       | OptString n
9767       | FileIn n
9768       | FileOut n ->
9769           pr "String %s" n
9770       | StringList n | DeviceList n ->
9771           pr "String[] %s" n
9772       | Bool n ->
9773           pr "boolean %s" n
9774       | Int n ->
9775           pr "int %s" n
9776       | Int64 n ->
9777           pr "long %s" n
9778   ) (snd style);
9779
9780   pr ")\n";
9781   pr "    throws LibGuestFSException";
9782   if semicolon then pr ";"
9783
9784 and generate_java_struct jtyp cols () =
9785   generate_header CStyle LGPLv2plus;
9786
9787   pr "\
9788 package com.redhat.et.libguestfs;
9789
9790 /**
9791  * Libguestfs %s structure.
9792  *
9793  * @author rjones
9794  * @see GuestFS
9795  */
9796 public class %s {
9797 " jtyp jtyp;
9798
9799   List.iter (
9800     function
9801     | name, FString
9802     | name, FUUID
9803     | name, FBuffer -> pr "  public String %s;\n" name
9804     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9805     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9806     | name, FChar -> pr "  public char %s;\n" name
9807     | name, FOptPercent ->
9808         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9809         pr "  public float %s;\n" name
9810   ) cols;
9811
9812   pr "}\n"
9813
9814 and generate_java_c () =
9815   generate_header CStyle LGPLv2plus;
9816
9817   pr "\
9818 #include <stdio.h>
9819 #include <stdlib.h>
9820 #include <string.h>
9821
9822 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9823 #include \"guestfs.h\"
9824
9825 /* Note that this function returns.  The exception is not thrown
9826  * until after the wrapper function returns.
9827  */
9828 static void
9829 throw_exception (JNIEnv *env, const char *msg)
9830 {
9831   jclass cl;
9832   cl = (*env)->FindClass (env,
9833                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9834   (*env)->ThrowNew (env, cl, msg);
9835 }
9836
9837 JNIEXPORT jlong JNICALL
9838 Java_com_redhat_et_libguestfs_GuestFS__1create
9839   (JNIEnv *env, jobject obj)
9840 {
9841   guestfs_h *g;
9842
9843   g = guestfs_create ();
9844   if (g == NULL) {
9845     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9846     return 0;
9847   }
9848   guestfs_set_error_handler (g, NULL, NULL);
9849   return (jlong) (long) g;
9850 }
9851
9852 JNIEXPORT void JNICALL
9853 Java_com_redhat_et_libguestfs_GuestFS__1close
9854   (JNIEnv *env, jobject obj, jlong jg)
9855 {
9856   guestfs_h *g = (guestfs_h *) (long) jg;
9857   guestfs_close (g);
9858 }
9859
9860 ";
9861
9862   List.iter (
9863     fun (name, style, _, _, _, _, _) ->
9864       pr "JNIEXPORT ";
9865       (match fst style with
9866        | RErr -> pr "void ";
9867        | RInt _ -> pr "jint ";
9868        | RInt64 _ -> pr "jlong ";
9869        | RBool _ -> pr "jboolean ";
9870        | RConstString _ | RConstOptString _ | RString _
9871        | RBufferOut _ -> pr "jstring ";
9872        | RStruct _ | RHashtable _ ->
9873            pr "jobject ";
9874        | RStringList _ | RStructList _ ->
9875            pr "jobjectArray ";
9876       );
9877       pr "JNICALL\n";
9878       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9879       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9880       pr "\n";
9881       pr "  (JNIEnv *env, jobject obj, jlong jg";
9882       List.iter (
9883         function
9884         | Pathname n
9885         | Device n | Dev_or_Path n
9886         | String n
9887         | OptString n
9888         | FileIn n
9889         | FileOut n ->
9890             pr ", jstring j%s" n
9891         | StringList n | DeviceList n ->
9892             pr ", jobjectArray j%s" n
9893         | Bool n ->
9894             pr ", jboolean j%s" n
9895         | Int n ->
9896             pr ", jint j%s" n
9897         | Int64 n ->
9898             pr ", jlong j%s" n
9899       ) (snd style);
9900       pr ")\n";
9901       pr "{\n";
9902       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9903       let error_code, no_ret =
9904         match fst style with
9905         | RErr -> pr "  int r;\n"; "-1", ""
9906         | RBool _
9907         | RInt _ -> pr "  int r;\n"; "-1", "0"
9908         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9909         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9910         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9911         | RString _ ->
9912             pr "  jstring jr;\n";
9913             pr "  char *r;\n"; "NULL", "NULL"
9914         | RStringList _ ->
9915             pr "  jobjectArray jr;\n";
9916             pr "  int r_len;\n";
9917             pr "  jclass cl;\n";
9918             pr "  jstring jstr;\n";
9919             pr "  char **r;\n"; "NULL", "NULL"
9920         | RStruct (_, typ) ->
9921             pr "  jobject jr;\n";
9922             pr "  jclass cl;\n";
9923             pr "  jfieldID fl;\n";
9924             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9925         | RStructList (_, typ) ->
9926             pr "  jobjectArray jr;\n";
9927             pr "  jclass cl;\n";
9928             pr "  jfieldID fl;\n";
9929             pr "  jobject jfl;\n";
9930             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9931         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9932         | RBufferOut _ ->
9933             pr "  jstring jr;\n";
9934             pr "  char *r;\n";
9935             pr "  size_t size;\n";
9936             "NULL", "NULL" in
9937       List.iter (
9938         function
9939         | Pathname n
9940         | Device n | Dev_or_Path n
9941         | String n
9942         | OptString n
9943         | FileIn n
9944         | FileOut n ->
9945             pr "  const char *%s;\n" n
9946         | StringList n | DeviceList n ->
9947             pr "  int %s_len;\n" n;
9948             pr "  const char **%s;\n" n
9949         | Bool n
9950         | Int n ->
9951             pr "  int %s;\n" n
9952         | Int64 n ->
9953             pr "  int64_t %s;\n" n
9954       ) (snd style);
9955
9956       let needs_i =
9957         (match fst style with
9958          | RStringList _ | RStructList _ -> true
9959          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9960          | RConstOptString _
9961          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9962           List.exists (function
9963                        | StringList _ -> true
9964                        | DeviceList _ -> true
9965                        | _ -> false) (snd style) in
9966       if needs_i then
9967         pr "  int i;\n";
9968
9969       pr "\n";
9970
9971       (* Get the parameters. *)
9972       List.iter (
9973         function
9974         | Pathname n
9975         | Device n | Dev_or_Path n
9976         | String n
9977         | FileIn n
9978         | FileOut n ->
9979             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9980         | OptString n ->
9981             (* This is completely undocumented, but Java null becomes
9982              * a NULL parameter.
9983              *)
9984             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9985         | StringList n | DeviceList n ->
9986             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9987             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9988             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9989             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9990               n;
9991             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9992             pr "  }\n";
9993             pr "  %s[%s_len] = NULL;\n" n n;
9994         | Bool n
9995         | Int n
9996         | Int64 n ->
9997             pr "  %s = j%s;\n" n n
9998       ) (snd style);
9999
10000       (* Make the call. *)
10001       pr "  r = guestfs_%s " name;
10002       generate_c_call_args ~handle:"g" style;
10003       pr ";\n";
10004
10005       (* Release the parameters. *)
10006       List.iter (
10007         function
10008         | Pathname n
10009         | Device n | Dev_or_Path n
10010         | String n
10011         | FileIn n
10012         | FileOut n ->
10013             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10014         | OptString n ->
10015             pr "  if (j%s)\n" n;
10016             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10017         | StringList n | DeviceList n ->
10018             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10019             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10020               n;
10021             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10022             pr "  }\n";
10023             pr "  free (%s);\n" n
10024         | Bool n
10025         | Int n
10026         | Int64 n -> ()
10027       ) (snd style);
10028
10029       (* Check for errors. *)
10030       pr "  if (r == %s) {\n" error_code;
10031       pr "    throw_exception (env, guestfs_last_error (g));\n";
10032       pr "    return %s;\n" no_ret;
10033       pr "  }\n";
10034
10035       (* Return value. *)
10036       (match fst style with
10037        | RErr -> ()
10038        | RInt _ -> pr "  return (jint) r;\n"
10039        | RBool _ -> pr "  return (jboolean) r;\n"
10040        | RInt64 _ -> pr "  return (jlong) r;\n"
10041        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10042        | RConstOptString _ ->
10043            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10044        | RString _ ->
10045            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10046            pr "  free (r);\n";
10047            pr "  return jr;\n"
10048        | RStringList _ ->
10049            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10050            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10051            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10052            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10053            pr "  for (i = 0; i < r_len; ++i) {\n";
10054            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10055            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10056            pr "    free (r[i]);\n";
10057            pr "  }\n";
10058            pr "  free (r);\n";
10059            pr "  return jr;\n"
10060        | RStruct (_, typ) ->
10061            let jtyp = java_name_of_struct typ in
10062            let cols = cols_of_struct typ in
10063            generate_java_struct_return typ jtyp cols
10064        | RStructList (_, typ) ->
10065            let jtyp = java_name_of_struct typ in
10066            let cols = cols_of_struct typ in
10067            generate_java_struct_list_return typ jtyp cols
10068        | RHashtable _ ->
10069            (* XXX *)
10070            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10071            pr "  return NULL;\n"
10072        | RBufferOut _ ->
10073            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10074            pr "  free (r);\n";
10075            pr "  return jr;\n"
10076       );
10077
10078       pr "}\n";
10079       pr "\n"
10080   ) all_functions
10081
10082 and generate_java_struct_return typ jtyp cols =
10083   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10084   pr "  jr = (*env)->AllocObject (env, cl);\n";
10085   List.iter (
10086     function
10087     | name, FString ->
10088         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10089         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10090     | name, FUUID ->
10091         pr "  {\n";
10092         pr "    char s[33];\n";
10093         pr "    memcpy (s, r->%s, 32);\n" name;
10094         pr "    s[32] = 0;\n";
10095         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10096         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10097         pr "  }\n";
10098     | name, FBuffer ->
10099         pr "  {\n";
10100         pr "    int len = r->%s_len;\n" name;
10101         pr "    char s[len+1];\n";
10102         pr "    memcpy (s, r->%s, len);\n" name;
10103         pr "    s[len] = 0;\n";
10104         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10105         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10106         pr "  }\n";
10107     | name, (FBytes|FUInt64|FInt64) ->
10108         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10109         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10110     | name, (FUInt32|FInt32) ->
10111         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10112         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10113     | name, FOptPercent ->
10114         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10115         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10116     | name, FChar ->
10117         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10118         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10119   ) cols;
10120   pr "  free (r);\n";
10121   pr "  return jr;\n"
10122
10123 and generate_java_struct_list_return typ jtyp cols =
10124   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10125   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10126   pr "  for (i = 0; i < r->len; ++i) {\n";
10127   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10128   List.iter (
10129     function
10130     | name, FString ->
10131         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10132         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10133     | name, FUUID ->
10134         pr "    {\n";
10135         pr "      char s[33];\n";
10136         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10137         pr "      s[32] = 0;\n";
10138         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10139         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10140         pr "    }\n";
10141     | name, FBuffer ->
10142         pr "    {\n";
10143         pr "      int len = r->val[i].%s_len;\n" name;
10144         pr "      char s[len+1];\n";
10145         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10146         pr "      s[len] = 0;\n";
10147         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10148         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10149         pr "    }\n";
10150     | name, (FBytes|FUInt64|FInt64) ->
10151         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10152         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10153     | name, (FUInt32|FInt32) ->
10154         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10155         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10156     | name, FOptPercent ->
10157         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10158         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10159     | name, FChar ->
10160         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10161         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10162   ) cols;
10163   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10164   pr "  }\n";
10165   pr "  guestfs_free_%s_list (r);\n" typ;
10166   pr "  return jr;\n"
10167
10168 and generate_java_makefile_inc () =
10169   generate_header HashStyle GPLv2plus;
10170
10171   pr "java_built_sources = \\\n";
10172   List.iter (
10173     fun (typ, jtyp) ->
10174         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10175   ) java_structs;
10176   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10177
10178 and generate_haskell_hs () =
10179   generate_header HaskellStyle LGPLv2plus;
10180
10181   (* XXX We only know how to generate partial FFI for Haskell
10182    * at the moment.  Please help out!
10183    *)
10184   let can_generate style =
10185     match style with
10186     | RErr, _
10187     | RInt _, _
10188     | RInt64 _, _ -> true
10189     | RBool _, _
10190     | RConstString _, _
10191     | RConstOptString _, _
10192     | RString _, _
10193     | RStringList _, _
10194     | RStruct _, _
10195     | RStructList _, _
10196     | RHashtable _, _
10197     | RBufferOut _, _ -> false in
10198
10199   pr "\
10200 {-# INCLUDE <guestfs.h> #-}
10201 {-# LANGUAGE ForeignFunctionInterface #-}
10202
10203 module Guestfs (
10204   create";
10205
10206   (* List out the names of the actions we want to export. *)
10207   List.iter (
10208     fun (name, style, _, _, _, _, _) ->
10209       if can_generate style then pr ",\n  %s" name
10210   ) all_functions;
10211
10212   pr "
10213   ) where
10214
10215 -- Unfortunately some symbols duplicate ones already present
10216 -- in Prelude.  We don't know which, so we hard-code a list
10217 -- here.
10218 import Prelude hiding (truncate)
10219
10220 import Foreign
10221 import Foreign.C
10222 import Foreign.C.Types
10223 import IO
10224 import Control.Exception
10225 import Data.Typeable
10226
10227 data GuestfsS = GuestfsS            -- represents the opaque C struct
10228 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10229 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10230
10231 -- XXX define properly later XXX
10232 data PV = PV
10233 data VG = VG
10234 data LV = LV
10235 data IntBool = IntBool
10236 data Stat = Stat
10237 data StatVFS = StatVFS
10238 data Hashtable = Hashtable
10239
10240 foreign import ccall unsafe \"guestfs_create\" c_create
10241   :: IO GuestfsP
10242 foreign import ccall unsafe \"&guestfs_close\" c_close
10243   :: FunPtr (GuestfsP -> IO ())
10244 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10245   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10246
10247 create :: IO GuestfsH
10248 create = do
10249   p <- c_create
10250   c_set_error_handler p nullPtr nullPtr
10251   h <- newForeignPtr c_close p
10252   return h
10253
10254 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10255   :: GuestfsP -> IO CString
10256
10257 -- last_error :: GuestfsH -> IO (Maybe String)
10258 -- last_error h = do
10259 --   str <- withForeignPtr h (\\p -> c_last_error p)
10260 --   maybePeek peekCString str
10261
10262 last_error :: GuestfsH -> IO (String)
10263 last_error h = do
10264   str <- withForeignPtr h (\\p -> c_last_error p)
10265   if (str == nullPtr)
10266     then return \"no error\"
10267     else peekCString str
10268
10269 ";
10270
10271   (* Generate wrappers for each foreign function. *)
10272   List.iter (
10273     fun (name, style, _, _, _, _, _) ->
10274       if can_generate style then (
10275         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10276         pr "  :: ";
10277         generate_haskell_prototype ~handle:"GuestfsP" style;
10278         pr "\n";
10279         pr "\n";
10280         pr "%s :: " name;
10281         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10282         pr "\n";
10283         pr "%s %s = do\n" name
10284           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10285         pr "  r <- ";
10286         (* Convert pointer arguments using with* functions. *)
10287         List.iter (
10288           function
10289           | FileIn n
10290           | FileOut n
10291           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10292           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10293           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10294           | Bool _ | Int _ | Int64 _ -> ()
10295         ) (snd style);
10296         (* Convert integer arguments. *)
10297         let args =
10298           List.map (
10299             function
10300             | Bool n -> sprintf "(fromBool %s)" n
10301             | Int n -> sprintf "(fromIntegral %s)" n
10302             | Int64 n -> sprintf "(fromIntegral %s)" n
10303             | FileIn n | FileOut n
10304             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10305           ) (snd style) in
10306         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10307           (String.concat " " ("p" :: args));
10308         (match fst style with
10309          | RErr | RInt _ | RInt64 _ | RBool _ ->
10310              pr "  if (r == -1)\n";
10311              pr "    then do\n";
10312              pr "      err <- last_error h\n";
10313              pr "      fail err\n";
10314          | RConstString _ | RConstOptString _ | RString _
10315          | RStringList _ | RStruct _
10316          | RStructList _ | RHashtable _ | RBufferOut _ ->
10317              pr "  if (r == nullPtr)\n";
10318              pr "    then do\n";
10319              pr "      err <- last_error h\n";
10320              pr "      fail err\n";
10321         );
10322         (match fst style with
10323          | RErr ->
10324              pr "    else return ()\n"
10325          | RInt _ ->
10326              pr "    else return (fromIntegral r)\n"
10327          | RInt64 _ ->
10328              pr "    else return (fromIntegral r)\n"
10329          | RBool _ ->
10330              pr "    else return (toBool r)\n"
10331          | RConstString _
10332          | RConstOptString _
10333          | RString _
10334          | RStringList _
10335          | RStruct _
10336          | RStructList _
10337          | RHashtable _
10338          | RBufferOut _ ->
10339              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10340         );
10341         pr "\n";
10342       )
10343   ) all_functions
10344
10345 and generate_haskell_prototype ~handle ?(hs = false) style =
10346   pr "%s -> " handle;
10347   let string = if hs then "String" else "CString" in
10348   let int = if hs then "Int" else "CInt" in
10349   let bool = if hs then "Bool" else "CInt" in
10350   let int64 = if hs then "Integer" else "Int64" in
10351   List.iter (
10352     fun arg ->
10353       (match arg with
10354        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10355        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10356        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10357        | Bool _ -> pr "%s" bool
10358        | Int _ -> pr "%s" int
10359        | Int64 _ -> pr "%s" int
10360        | FileIn _ -> pr "%s" string
10361        | FileOut _ -> pr "%s" string
10362       );
10363       pr " -> ";
10364   ) (snd style);
10365   pr "IO (";
10366   (match fst style with
10367    | RErr -> if not hs then pr "CInt"
10368    | RInt _ -> pr "%s" int
10369    | RInt64 _ -> pr "%s" int64
10370    | RBool _ -> pr "%s" bool
10371    | RConstString _ -> pr "%s" string
10372    | RConstOptString _ -> pr "Maybe %s" string
10373    | RString _ -> pr "%s" string
10374    | RStringList _ -> pr "[%s]" string
10375    | RStruct (_, typ) ->
10376        let name = java_name_of_struct typ in
10377        pr "%s" name
10378    | RStructList (_, typ) ->
10379        let name = java_name_of_struct typ in
10380        pr "[%s]" name
10381    | RHashtable _ -> pr "Hashtable"
10382    | RBufferOut _ -> pr "%s" string
10383   );
10384   pr ")"
10385
10386 and generate_csharp () =
10387   generate_header CPlusPlusStyle LGPLv2plus;
10388
10389   (* XXX Make this configurable by the C# assembly users. *)
10390   let library = "libguestfs.so.0" in
10391
10392   pr "\
10393 // These C# bindings are highly experimental at present.
10394 //
10395 // Firstly they only work on Linux (ie. Mono).  In order to get them
10396 // to work on Windows (ie. .Net) you would need to port the library
10397 // itself to Windows first.
10398 //
10399 // The second issue is that some calls are known to be incorrect and
10400 // can cause Mono to segfault.  Particularly: calls which pass or
10401 // return string[], or return any structure value.  This is because
10402 // we haven't worked out the correct way to do this from C#.
10403 //
10404 // The third issue is that when compiling you get a lot of warnings.
10405 // We are not sure whether the warnings are important or not.
10406 //
10407 // Fourthly we do not routinely build or test these bindings as part
10408 // of the make && make check cycle, which means that regressions might
10409 // go unnoticed.
10410 //
10411 // Suggestions and patches are welcome.
10412
10413 // To compile:
10414 //
10415 // gmcs Libguestfs.cs
10416 // mono Libguestfs.exe
10417 //
10418 // (You'll probably want to add a Test class / static main function
10419 // otherwise this won't do anything useful).
10420
10421 using System;
10422 using System.IO;
10423 using System.Runtime.InteropServices;
10424 using System.Runtime.Serialization;
10425 using System.Collections;
10426
10427 namespace Guestfs
10428 {
10429   class Error : System.ApplicationException
10430   {
10431     public Error (string message) : base (message) {}
10432     protected Error (SerializationInfo info, StreamingContext context) {}
10433   }
10434
10435   class Guestfs
10436   {
10437     IntPtr _handle;
10438
10439     [DllImport (\"%s\")]
10440     static extern IntPtr guestfs_create ();
10441
10442     public Guestfs ()
10443     {
10444       _handle = guestfs_create ();
10445       if (_handle == IntPtr.Zero)
10446         throw new Error (\"could not create guestfs handle\");
10447     }
10448
10449     [DllImport (\"%s\")]
10450     static extern void guestfs_close (IntPtr h);
10451
10452     ~Guestfs ()
10453     {
10454       guestfs_close (_handle);
10455     }
10456
10457     [DllImport (\"%s\")]
10458     static extern string guestfs_last_error (IntPtr h);
10459
10460 " library library library;
10461
10462   (* Generate C# structure bindings.  We prefix struct names with
10463    * underscore because C# cannot have conflicting struct names and
10464    * method names (eg. "class stat" and "stat").
10465    *)
10466   List.iter (
10467     fun (typ, cols) ->
10468       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10469       pr "    public class _%s {\n" typ;
10470       List.iter (
10471         function
10472         | name, FChar -> pr "      char %s;\n" name
10473         | name, FString -> pr "      string %s;\n" name
10474         | name, FBuffer ->
10475             pr "      uint %s_len;\n" name;
10476             pr "      string %s;\n" name
10477         | name, FUUID ->
10478             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10479             pr "      string %s;\n" name
10480         | name, FUInt32 -> pr "      uint %s;\n" name
10481         | name, FInt32 -> pr "      int %s;\n" name
10482         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10483         | name, FInt64 -> pr "      long %s;\n" name
10484         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10485       ) cols;
10486       pr "    }\n";
10487       pr "\n"
10488   ) structs;
10489
10490   (* Generate C# function bindings. *)
10491   List.iter (
10492     fun (name, style, _, _, _, shortdesc, _) ->
10493       let rec csharp_return_type () =
10494         match fst style with
10495         | RErr -> "void"
10496         | RBool n -> "bool"
10497         | RInt n -> "int"
10498         | RInt64 n -> "long"
10499         | RConstString n
10500         | RConstOptString n
10501         | RString n
10502         | RBufferOut n -> "string"
10503         | RStruct (_,n) -> "_" ^ n
10504         | RHashtable n -> "Hashtable"
10505         | RStringList n -> "string[]"
10506         | RStructList (_,n) -> sprintf "_%s[]" n
10507
10508       and c_return_type () =
10509         match fst style with
10510         | RErr
10511         | RBool _
10512         | RInt _ -> "int"
10513         | RInt64 _ -> "long"
10514         | RConstString _
10515         | RConstOptString _
10516         | RString _
10517         | RBufferOut _ -> "string"
10518         | RStruct (_,n) -> "_" ^ n
10519         | RHashtable _
10520         | RStringList _ -> "string[]"
10521         | RStructList (_,n) -> sprintf "_%s[]" n
10522
10523       and c_error_comparison () =
10524         match fst style with
10525         | RErr
10526         | RBool _
10527         | RInt _
10528         | RInt64 _ -> "== -1"
10529         | RConstString _
10530         | RConstOptString _
10531         | RString _
10532         | RBufferOut _
10533         | RStruct (_,_)
10534         | RHashtable _
10535         | RStringList _
10536         | RStructList (_,_) -> "== null"
10537
10538       and generate_extern_prototype () =
10539         pr "    static extern %s guestfs_%s (IntPtr h"
10540           (c_return_type ()) name;
10541         List.iter (
10542           function
10543           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10544           | FileIn n | FileOut n ->
10545               pr ", [In] string %s" n
10546           | StringList n | DeviceList n ->
10547               pr ", [In] string[] %s" n
10548           | Bool n ->
10549               pr ", bool %s" n
10550           | Int n ->
10551               pr ", int %s" n
10552           | Int64 n ->
10553               pr ", long %s" n
10554         ) (snd style);
10555         pr ");\n"
10556
10557       and generate_public_prototype () =
10558         pr "    public %s %s (" (csharp_return_type ()) name;
10559         let comma = ref false in
10560         let next () =
10561           if !comma then pr ", ";
10562           comma := true
10563         in
10564         List.iter (
10565           function
10566           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10567           | FileIn n | FileOut n ->
10568               next (); pr "string %s" n
10569           | StringList n | DeviceList n ->
10570               next (); pr "string[] %s" n
10571           | Bool n ->
10572               next (); pr "bool %s" n
10573           | Int n ->
10574               next (); pr "int %s" n
10575           | Int64 n ->
10576               next (); pr "long %s" n
10577         ) (snd style);
10578         pr ")\n"
10579
10580       and generate_call () =
10581         pr "guestfs_%s (_handle" name;
10582         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10583         pr ");\n";
10584       in
10585
10586       pr "    [DllImport (\"%s\")]\n" library;
10587       generate_extern_prototype ();
10588       pr "\n";
10589       pr "    /// <summary>\n";
10590       pr "    /// %s\n" shortdesc;
10591       pr "    /// </summary>\n";
10592       generate_public_prototype ();
10593       pr "    {\n";
10594       pr "      %s r;\n" (c_return_type ());
10595       pr "      r = ";
10596       generate_call ();
10597       pr "      if (r %s)\n" (c_error_comparison ());
10598       pr "        throw new Error (guestfs_last_error (_handle));\n";
10599       (match fst style with
10600        | RErr -> ()
10601        | RBool _ ->
10602            pr "      return r != 0 ? true : false;\n"
10603        | RHashtable _ ->
10604            pr "      Hashtable rr = new Hashtable ();\n";
10605            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10606            pr "        rr.Add (r[i], r[i+1]);\n";
10607            pr "      return rr;\n"
10608        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10609        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10610        | RStructList _ ->
10611            pr "      return r;\n"
10612       );
10613       pr "    }\n";
10614       pr "\n";
10615   ) all_functions_sorted;
10616
10617   pr "  }
10618 }
10619 "
10620
10621 and generate_bindtests () =
10622   generate_header CStyle LGPLv2plus;
10623
10624   pr "\
10625 #include <stdio.h>
10626 #include <stdlib.h>
10627 #include <inttypes.h>
10628 #include <string.h>
10629
10630 #include \"guestfs.h\"
10631 #include \"guestfs-internal.h\"
10632 #include \"guestfs-internal-actions.h\"
10633 #include \"guestfs_protocol.h\"
10634
10635 #define error guestfs_error
10636 #define safe_calloc guestfs_safe_calloc
10637 #define safe_malloc guestfs_safe_malloc
10638
10639 static void
10640 print_strings (char *const *argv)
10641 {
10642   int argc;
10643
10644   printf (\"[\");
10645   for (argc = 0; argv[argc] != NULL; ++argc) {
10646     if (argc > 0) printf (\", \");
10647     printf (\"\\\"%%s\\\"\", argv[argc]);
10648   }
10649   printf (\"]\\n\");
10650 }
10651
10652 /* The test0 function prints its parameters to stdout. */
10653 ";
10654
10655   let test0, tests =
10656     match test_functions with
10657     | [] -> assert false
10658     | test0 :: tests -> test0, tests in
10659
10660   let () =
10661     let (name, style, _, _, _, _, _) = test0 in
10662     generate_prototype ~extern:false ~semicolon:false ~newline:true
10663       ~handle:"g" ~prefix:"guestfs__" name style;
10664     pr "{\n";
10665     List.iter (
10666       function
10667       | Pathname n
10668       | Device n | Dev_or_Path n
10669       | String n
10670       | FileIn n
10671       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10672       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10673       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10674       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10675       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10676       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10677     ) (snd style);
10678     pr "  /* Java changes stdout line buffering so we need this: */\n";
10679     pr "  fflush (stdout);\n";
10680     pr "  return 0;\n";
10681     pr "}\n";
10682     pr "\n" in
10683
10684   List.iter (
10685     fun (name, style, _, _, _, _, _) ->
10686       if String.sub name (String.length name - 3) 3 <> "err" then (
10687         pr "/* Test normal return. */\n";
10688         generate_prototype ~extern:false ~semicolon:false ~newline:true
10689           ~handle:"g" ~prefix:"guestfs__" name style;
10690         pr "{\n";
10691         (match fst style with
10692          | RErr ->
10693              pr "  return 0;\n"
10694          | RInt _ ->
10695              pr "  int r;\n";
10696              pr "  sscanf (val, \"%%d\", &r);\n";
10697              pr "  return r;\n"
10698          | RInt64 _ ->
10699              pr "  int64_t r;\n";
10700              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10701              pr "  return r;\n"
10702          | RBool _ ->
10703              pr "  return STREQ (val, \"true\");\n"
10704          | RConstString _
10705          | RConstOptString _ ->
10706              (* Can't return the input string here.  Return a static
10707               * string so we ensure we get a segfault if the caller
10708               * tries to free it.
10709               *)
10710              pr "  return \"static string\";\n"
10711          | RString _ ->
10712              pr "  return strdup (val);\n"
10713          | RStringList _ ->
10714              pr "  char **strs;\n";
10715              pr "  int n, i;\n";
10716              pr "  sscanf (val, \"%%d\", &n);\n";
10717              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10718              pr "  for (i = 0; i < n; ++i) {\n";
10719              pr "    strs[i] = safe_malloc (g, 16);\n";
10720              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10721              pr "  }\n";
10722              pr "  strs[n] = NULL;\n";
10723              pr "  return strs;\n"
10724          | RStruct (_, typ) ->
10725              pr "  struct guestfs_%s *r;\n" typ;
10726              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10727              pr "  return r;\n"
10728          | RStructList (_, typ) ->
10729              pr "  struct guestfs_%s_list *r;\n" typ;
10730              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10731              pr "  sscanf (val, \"%%d\", &r->len);\n";
10732              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10733              pr "  return r;\n"
10734          | RHashtable _ ->
10735              pr "  char **strs;\n";
10736              pr "  int n, i;\n";
10737              pr "  sscanf (val, \"%%d\", &n);\n";
10738              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10739              pr "  for (i = 0; i < n; ++i) {\n";
10740              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10741              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10742              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10743              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10744              pr "  }\n";
10745              pr "  strs[n*2] = NULL;\n";
10746              pr "  return strs;\n"
10747          | RBufferOut _ ->
10748              pr "  return strdup (val);\n"
10749         );
10750         pr "}\n";
10751         pr "\n"
10752       ) else (
10753         pr "/* Test error return. */\n";
10754         generate_prototype ~extern:false ~semicolon:false ~newline:true
10755           ~handle:"g" ~prefix:"guestfs__" name style;
10756         pr "{\n";
10757         pr "  error (g, \"error\");\n";
10758         (match fst style with
10759          | RErr | RInt _ | RInt64 _ | RBool _ ->
10760              pr "  return -1;\n"
10761          | RConstString _ | RConstOptString _
10762          | RString _ | RStringList _ | RStruct _
10763          | RStructList _
10764          | RHashtable _
10765          | RBufferOut _ ->
10766              pr "  return NULL;\n"
10767         );
10768         pr "}\n";
10769         pr "\n"
10770       )
10771   ) tests
10772
10773 and generate_ocaml_bindtests () =
10774   generate_header OCamlStyle GPLv2plus;
10775
10776   pr "\
10777 let () =
10778   let g = Guestfs.create () in
10779 ";
10780
10781   let mkargs args =
10782     String.concat " " (
10783       List.map (
10784         function
10785         | CallString s -> "\"" ^ s ^ "\""
10786         | CallOptString None -> "None"
10787         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10788         | CallStringList xs ->
10789             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10790         | CallInt i when i >= 0 -> string_of_int i
10791         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10792         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10793         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10794         | CallBool b -> string_of_bool b
10795       ) args
10796     )
10797   in
10798
10799   generate_lang_bindtests (
10800     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10801   );
10802
10803   pr "print_endline \"EOF\"\n"
10804
10805 and generate_perl_bindtests () =
10806   pr "#!/usr/bin/perl -w\n";
10807   generate_header HashStyle GPLv2plus;
10808
10809   pr "\
10810 use strict;
10811
10812 use Sys::Guestfs;
10813
10814 my $g = Sys::Guestfs->new ();
10815 ";
10816
10817   let mkargs args =
10818     String.concat ", " (
10819       List.map (
10820         function
10821         | CallString s -> "\"" ^ s ^ "\""
10822         | CallOptString None -> "undef"
10823         | CallOptString (Some s) -> sprintf "\"%s\"" s
10824         | CallStringList xs ->
10825             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10826         | CallInt i -> string_of_int i
10827         | CallInt64 i -> Int64.to_string i
10828         | CallBool b -> if b then "1" else "0"
10829       ) args
10830     )
10831   in
10832
10833   generate_lang_bindtests (
10834     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10835   );
10836
10837   pr "print \"EOF\\n\"\n"
10838
10839 and generate_python_bindtests () =
10840   generate_header HashStyle GPLv2plus;
10841
10842   pr "\
10843 import guestfs
10844
10845 g = guestfs.GuestFS ()
10846 ";
10847
10848   let mkargs args =
10849     String.concat ", " (
10850       List.map (
10851         function
10852         | CallString s -> "\"" ^ s ^ "\""
10853         | CallOptString None -> "None"
10854         | CallOptString (Some s) -> sprintf "\"%s\"" s
10855         | CallStringList xs ->
10856             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10857         | CallInt i -> string_of_int i
10858         | CallInt64 i -> Int64.to_string i
10859         | CallBool b -> if b then "1" else "0"
10860       ) args
10861     )
10862   in
10863
10864   generate_lang_bindtests (
10865     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10866   );
10867
10868   pr "print \"EOF\"\n"
10869
10870 and generate_ruby_bindtests () =
10871   generate_header HashStyle GPLv2plus;
10872
10873   pr "\
10874 require 'guestfs'
10875
10876 g = Guestfs::create()
10877 ";
10878
10879   let mkargs args =
10880     String.concat ", " (
10881       List.map (
10882         function
10883         | CallString s -> "\"" ^ s ^ "\""
10884         | CallOptString None -> "nil"
10885         | CallOptString (Some s) -> sprintf "\"%s\"" s
10886         | CallStringList xs ->
10887             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10888         | CallInt i -> string_of_int i
10889         | CallInt64 i -> Int64.to_string i
10890         | CallBool b -> string_of_bool b
10891       ) args
10892     )
10893   in
10894
10895   generate_lang_bindtests (
10896     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10897   );
10898
10899   pr "print \"EOF\\n\"\n"
10900
10901 and generate_java_bindtests () =
10902   generate_header CStyle GPLv2plus;
10903
10904   pr "\
10905 import com.redhat.et.libguestfs.*;
10906
10907 public class Bindtests {
10908     public static void main (String[] argv)
10909     {
10910         try {
10911             GuestFS g = new GuestFS ();
10912 ";
10913
10914   let mkargs args =
10915     String.concat ", " (
10916       List.map (
10917         function
10918         | CallString s -> "\"" ^ s ^ "\""
10919         | CallOptString None -> "null"
10920         | CallOptString (Some s) -> sprintf "\"%s\"" s
10921         | CallStringList xs ->
10922             "new String[]{" ^
10923               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10924         | CallInt i -> string_of_int i
10925         | CallInt64 i -> Int64.to_string i
10926         | CallBool b -> string_of_bool b
10927       ) args
10928     )
10929   in
10930
10931   generate_lang_bindtests (
10932     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10933   );
10934
10935   pr "
10936             System.out.println (\"EOF\");
10937         }
10938         catch (Exception exn) {
10939             System.err.println (exn);
10940             System.exit (1);
10941         }
10942     }
10943 }
10944 "
10945
10946 and generate_haskell_bindtests () =
10947   generate_header HaskellStyle GPLv2plus;
10948
10949   pr "\
10950 module Bindtests where
10951 import qualified Guestfs
10952
10953 main = do
10954   g <- Guestfs.create
10955 ";
10956
10957   let mkargs args =
10958     String.concat " " (
10959       List.map (
10960         function
10961         | CallString s -> "\"" ^ s ^ "\""
10962         | CallOptString None -> "Nothing"
10963         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10964         | CallStringList xs ->
10965             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10966         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10967         | CallInt i -> string_of_int i
10968         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10969         | CallInt64 i -> Int64.to_string i
10970         | CallBool true -> "True"
10971         | CallBool false -> "False"
10972       ) args
10973     )
10974   in
10975
10976   generate_lang_bindtests (
10977     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10978   );
10979
10980   pr "  putStrLn \"EOF\"\n"
10981
10982 (* Language-independent bindings tests - we do it this way to
10983  * ensure there is parity in testing bindings across all languages.
10984  *)
10985 and generate_lang_bindtests call =
10986   call "test0" [CallString "abc"; CallOptString (Some "def");
10987                 CallStringList []; CallBool false;
10988                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10989   call "test0" [CallString "abc"; CallOptString None;
10990                 CallStringList []; CallBool false;
10991                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10992   call "test0" [CallString ""; CallOptString (Some "def");
10993                 CallStringList []; CallBool false;
10994                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10995   call "test0" [CallString ""; CallOptString (Some "");
10996                 CallStringList []; CallBool false;
10997                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10998   call "test0" [CallString "abc"; CallOptString (Some "def");
10999                 CallStringList ["1"]; CallBool false;
11000                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11001   call "test0" [CallString "abc"; CallOptString (Some "def");
11002                 CallStringList ["1"; "2"]; CallBool false;
11003                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11004   call "test0" [CallString "abc"; CallOptString (Some "def");
11005                 CallStringList ["1"]; CallBool true;
11006                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11007   call "test0" [CallString "abc"; CallOptString (Some "def");
11008                 CallStringList ["1"]; CallBool false;
11009                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
11010   call "test0" [CallString "abc"; CallOptString (Some "def");
11011                 CallStringList ["1"]; CallBool false;
11012                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
11013   call "test0" [CallString "abc"; CallOptString (Some "def");
11014                 CallStringList ["1"]; CallBool false;
11015                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
11016   call "test0" [CallString "abc"; CallOptString (Some "def");
11017                 CallStringList ["1"]; CallBool false;
11018                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11019   call "test0" [CallString "abc"; CallOptString (Some "def");
11020                 CallStringList ["1"]; CallBool false;
11021                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11022   call "test0" [CallString "abc"; CallOptString (Some "def");
11023                 CallStringList ["1"]; CallBool false;
11024                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11025
11026 (* XXX Add here tests of the return and error functions. *)
11027
11028 (* Code to generator bindings for virt-inspector.  Currently only
11029  * implemented for OCaml code (for virt-p2v 2.0).
11030  *)
11031 let rng_input = "inspector/virt-inspector.rng"
11032
11033 (* Read the input file and parse it into internal structures.  This is
11034  * by no means a complete RELAX NG parser, but is just enough to be
11035  * able to parse the specific input file.
11036  *)
11037 type rng =
11038   | Element of string * rng list        (* <element name=name/> *)
11039   | Attribute of string * rng list        (* <attribute name=name/> *)
11040   | Interleave of rng list                (* <interleave/> *)
11041   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11042   | OneOrMore of rng                        (* <oneOrMore/> *)
11043   | Optional of rng                        (* <optional/> *)
11044   | Choice of string list                (* <choice><value/>*</choice> *)
11045   | Value of string                        (* <value>str</value> *)
11046   | Text                                (* <text/> *)
11047
11048 let rec string_of_rng = function
11049   | Element (name, xs) ->
11050       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11051   | Attribute (name, xs) ->
11052       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11053   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11054   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11055   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11056   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11057   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11058   | Value value -> "Value \"" ^ value ^ "\""
11059   | Text -> "Text"
11060
11061 and string_of_rng_list xs =
11062   String.concat ", " (List.map string_of_rng xs)
11063
11064 let rec parse_rng ?defines context = function
11065   | [] -> []
11066   | Xml.Element ("element", ["name", name], children) :: rest ->
11067       Element (name, parse_rng ?defines context children)
11068       :: parse_rng ?defines context rest
11069   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11070       Attribute (name, parse_rng ?defines context children)
11071       :: parse_rng ?defines context rest
11072   | Xml.Element ("interleave", [], children) :: rest ->
11073       Interleave (parse_rng ?defines context children)
11074       :: parse_rng ?defines context rest
11075   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11076       let rng = parse_rng ?defines context [child] in
11077       (match rng with
11078        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11079        | _ ->
11080            failwithf "%s: <zeroOrMore> contains more than one child element"
11081              context
11082       )
11083   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11084       let rng = parse_rng ?defines context [child] in
11085       (match rng with
11086        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11087        | _ ->
11088            failwithf "%s: <oneOrMore> contains more than one child element"
11089              context
11090       )
11091   | Xml.Element ("optional", [], [child]) :: rest ->
11092       let rng = parse_rng ?defines context [child] in
11093       (match rng with
11094        | [child] -> Optional child :: parse_rng ?defines context rest
11095        | _ ->
11096            failwithf "%s: <optional> contains more than one child element"
11097              context
11098       )
11099   | Xml.Element ("choice", [], children) :: rest ->
11100       let values = List.map (
11101         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11102         | _ ->
11103             failwithf "%s: can't handle anything except <value> in <choice>"
11104               context
11105       ) children in
11106       Choice values
11107       :: parse_rng ?defines context rest
11108   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11109       Value value :: parse_rng ?defines context rest
11110   | Xml.Element ("text", [], []) :: rest ->
11111       Text :: parse_rng ?defines context rest
11112   | Xml.Element ("ref", ["name", name], []) :: rest ->
11113       (* Look up the reference.  Because of limitations in this parser,
11114        * we can't handle arbitrarily nested <ref> yet.  You can only
11115        * use <ref> from inside <start>.
11116        *)
11117       (match defines with
11118        | None ->
11119            failwithf "%s: contains <ref>, but no refs are defined yet" context
11120        | Some map ->
11121            let rng = StringMap.find name map in
11122            rng @ parse_rng ?defines context rest
11123       )
11124   | x :: _ ->
11125       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11126
11127 let grammar =
11128   let xml = Xml.parse_file rng_input in
11129   match xml with
11130   | Xml.Element ("grammar", _,
11131                  Xml.Element ("start", _, gram) :: defines) ->
11132       (* The <define/> elements are referenced in the <start> section,
11133        * so build a map of those first.
11134        *)
11135       let defines = List.fold_left (
11136         fun map ->
11137           function Xml.Element ("define", ["name", name], defn) ->
11138             StringMap.add name defn map
11139           | _ ->
11140               failwithf "%s: expected <define name=name/>" rng_input
11141       ) StringMap.empty defines in
11142       let defines = StringMap.mapi parse_rng defines in
11143
11144       (* Parse the <start> clause, passing the defines. *)
11145       parse_rng ~defines "<start>" gram
11146   | _ ->
11147       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11148         rng_input
11149
11150 let name_of_field = function
11151   | Element (name, _) | Attribute (name, _)
11152   | ZeroOrMore (Element (name, _))
11153   | OneOrMore (Element (name, _))
11154   | Optional (Element (name, _)) -> name
11155   | Optional (Attribute (name, _)) -> name
11156   | Text -> (* an unnamed field in an element *)
11157       "data"
11158   | rng ->
11159       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11160
11161 (* At the moment this function only generates OCaml types.  However we
11162  * should parameterize it later so it can generate types/structs in a
11163  * variety of languages.
11164  *)
11165 let generate_types xs =
11166   (* A simple type is one that can be printed out directly, eg.
11167    * "string option".  A complex type is one which has a name and has
11168    * to be defined via another toplevel definition, eg. a struct.
11169    *
11170    * generate_type generates code for either simple or complex types.
11171    * In the simple case, it returns the string ("string option").  In
11172    * the complex case, it returns the name ("mountpoint").  In the
11173    * complex case it has to print out the definition before returning,
11174    * so it should only be called when we are at the beginning of a
11175    * new line (BOL context).
11176    *)
11177   let rec generate_type = function
11178     | Text ->                                (* string *)
11179         "string", true
11180     | Choice values ->                        (* [`val1|`val2|...] *)
11181         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11182     | ZeroOrMore rng ->                        (* <rng> list *)
11183         let t, is_simple = generate_type rng in
11184         t ^ " list (* 0 or more *)", is_simple
11185     | OneOrMore rng ->                        (* <rng> list *)
11186         let t, is_simple = generate_type rng in
11187         t ^ " list (* 1 or more *)", is_simple
11188                                         (* virt-inspector hack: bool *)
11189     | Optional (Attribute (name, [Value "1"])) ->
11190         "bool", true
11191     | Optional rng ->                        (* <rng> list *)
11192         let t, is_simple = generate_type rng in
11193         t ^ " option", is_simple
11194                                         (* type name = { fields ... } *)
11195     | Element (name, fields) when is_attrs_interleave fields ->
11196         generate_type_struct name (get_attrs_interleave fields)
11197     | Element (name, [field])                (* type name = field *)
11198     | Attribute (name, [field]) ->
11199         let t, is_simple = generate_type field in
11200         if is_simple then (t, true)
11201         else (
11202           pr "type %s = %s\n" name t;
11203           name, false
11204         )
11205     | Element (name, fields) ->              (* type name = { fields ... } *)
11206         generate_type_struct name fields
11207     | rng ->
11208         failwithf "generate_type failed at: %s" (string_of_rng rng)
11209
11210   and is_attrs_interleave = function
11211     | [Interleave _] -> true
11212     | Attribute _ :: fields -> is_attrs_interleave fields
11213     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11214     | _ -> false
11215
11216   and get_attrs_interleave = function
11217     | [Interleave fields] -> fields
11218     | ((Attribute _) as field) :: fields
11219     | ((Optional (Attribute _)) as field) :: fields ->
11220         field :: get_attrs_interleave fields
11221     | _ -> assert false
11222
11223   and generate_types xs =
11224     List.iter (fun x -> ignore (generate_type x)) xs
11225
11226   and generate_type_struct name fields =
11227     (* Calculate the types of the fields first.  We have to do this
11228      * before printing anything so we are still in BOL context.
11229      *)
11230     let types = List.map fst (List.map generate_type fields) in
11231
11232     (* Special case of a struct containing just a string and another
11233      * field.  Turn it into an assoc list.
11234      *)
11235     match types with
11236     | ["string"; other] ->
11237         let fname1, fname2 =
11238           match fields with
11239           | [f1; f2] -> name_of_field f1, name_of_field f2
11240           | _ -> assert false in
11241         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11242         name, false
11243
11244     | types ->
11245         pr "type %s = {\n" name;
11246         List.iter (
11247           fun (field, ftype) ->
11248             let fname = name_of_field field in
11249             pr "  %s_%s : %s;\n" name fname ftype
11250         ) (List.combine fields types);
11251         pr "}\n";
11252         (* Return the name of this type, and
11253          * false because it's not a simple type.
11254          *)
11255         name, false
11256   in
11257
11258   generate_types xs
11259
11260 let generate_parsers xs =
11261   (* As for generate_type above, generate_parser makes a parser for
11262    * some type, and returns the name of the parser it has generated.
11263    * Because it (may) need to print something, it should always be
11264    * called in BOL context.
11265    *)
11266   let rec generate_parser = function
11267     | Text ->                                (* string *)
11268         "string_child_or_empty"
11269     | Choice values ->                        (* [`val1|`val2|...] *)
11270         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11271           (String.concat "|"
11272              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11273     | ZeroOrMore rng ->                        (* <rng> list *)
11274         let pa = generate_parser rng in
11275         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11276     | OneOrMore rng ->                        (* <rng> list *)
11277         let pa = generate_parser rng in
11278         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11279                                         (* virt-inspector hack: bool *)
11280     | Optional (Attribute (name, [Value "1"])) ->
11281         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11282     | Optional rng ->                        (* <rng> list *)
11283         let pa = generate_parser rng in
11284         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11285                                         (* type name = { fields ... } *)
11286     | Element (name, fields) when is_attrs_interleave fields ->
11287         generate_parser_struct name (get_attrs_interleave fields)
11288     | Element (name, [field]) ->        (* type name = field *)
11289         let pa = generate_parser field in
11290         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11291         pr "let %s =\n" parser_name;
11292         pr "  %s\n" pa;
11293         pr "let parse_%s = %s\n" name parser_name;
11294         parser_name
11295     | Attribute (name, [field]) ->
11296         let pa = generate_parser field in
11297         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11298         pr "let %s =\n" parser_name;
11299         pr "  %s\n" pa;
11300         pr "let parse_%s = %s\n" name parser_name;
11301         parser_name
11302     | Element (name, fields) ->              (* type name = { fields ... } *)
11303         generate_parser_struct name ([], fields)
11304     | rng ->
11305         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11306
11307   and is_attrs_interleave = function
11308     | [Interleave _] -> true
11309     | Attribute _ :: fields -> is_attrs_interleave fields
11310     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11311     | _ -> false
11312
11313   and get_attrs_interleave = function
11314     | [Interleave fields] -> [], fields
11315     | ((Attribute _) as field) :: fields
11316     | ((Optional (Attribute _)) as field) :: fields ->
11317         let attrs, interleaves = get_attrs_interleave fields in
11318         (field :: attrs), interleaves
11319     | _ -> assert false
11320
11321   and generate_parsers xs =
11322     List.iter (fun x -> ignore (generate_parser x)) xs
11323
11324   and generate_parser_struct name (attrs, interleaves) =
11325     (* Generate parsers for the fields first.  We have to do this
11326      * before printing anything so we are still in BOL context.
11327      *)
11328     let fields = attrs @ interleaves in
11329     let pas = List.map generate_parser fields in
11330
11331     (* Generate an intermediate tuple from all the fields first.
11332      * If the type is just a string + another field, then we will
11333      * return this directly, otherwise it is turned into a record.
11334      *
11335      * RELAX NG note: This code treats <interleave> and plain lists of
11336      * fields the same.  In other words, it doesn't bother enforcing
11337      * any ordering of fields in the XML.
11338      *)
11339     pr "let parse_%s x =\n" name;
11340     pr "  let t = (\n    ";
11341     let comma = ref false in
11342     List.iter (
11343       fun x ->
11344         if !comma then pr ",\n    ";
11345         comma := true;
11346         match x with
11347         | Optional (Attribute (fname, [field])), pa ->
11348             pr "%s x" pa
11349         | Optional (Element (fname, [field])), pa ->
11350             pr "%s (optional_child %S x)" pa fname
11351         | Attribute (fname, [Text]), _ ->
11352             pr "attribute %S x" fname
11353         | (ZeroOrMore _ | OneOrMore _), pa ->
11354             pr "%s x" pa
11355         | Text, pa ->
11356             pr "%s x" pa
11357         | (field, pa) ->
11358             let fname = name_of_field field in
11359             pr "%s (child %S x)" pa fname
11360     ) (List.combine fields pas);
11361     pr "\n  ) in\n";
11362
11363     (match fields with
11364      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11365          pr "  t\n"
11366
11367      | _ ->
11368          pr "  (Obj.magic t : %s)\n" name
11369 (*
11370          List.iter (
11371            function
11372            | (Optional (Attribute (fname, [field])), pa) ->
11373                pr "  %s_%s =\n" name fname;
11374                pr "    %s x;\n" pa
11375            | (Optional (Element (fname, [field])), pa) ->
11376                pr "  %s_%s =\n" name fname;
11377                pr "    (let x = optional_child %S x in\n" fname;
11378                pr "     %s x);\n" pa
11379            | (field, pa) ->
11380                let fname = name_of_field field in
11381                pr "  %s_%s =\n" name fname;
11382                pr "    (let x = child %S x in\n" fname;
11383                pr "     %s x);\n" pa
11384          ) (List.combine fields pas);
11385          pr "}\n"
11386 *)
11387     );
11388     sprintf "parse_%s" name
11389   in
11390
11391   generate_parsers xs
11392
11393 (* Generate ocaml/guestfs_inspector.mli. *)
11394 let generate_ocaml_inspector_mli () =
11395   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11396
11397   pr "\
11398 (** This is an OCaml language binding to the external [virt-inspector]
11399     program.
11400
11401     For more information, please read the man page [virt-inspector(1)].
11402 *)
11403
11404 ";
11405
11406   generate_types grammar;
11407   pr "(** The nested information returned from the {!inspect} function. *)\n";
11408   pr "\n";
11409
11410   pr "\
11411 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11412 (** To inspect a libvirt domain called [name], pass a singleton
11413     list: [inspect [name]].  When using libvirt only, you may
11414     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11415
11416     To inspect a disk image or images, pass a list of the filenames
11417     of the disk images: [inspect filenames]
11418
11419     This function inspects the given guest or disk images and
11420     returns a list of operating system(s) found and a large amount
11421     of information about them.  In the vast majority of cases,
11422     a virtual machine only contains a single operating system.
11423
11424     If the optional [~xml] parameter is given, then this function
11425     skips running the external virt-inspector program and just
11426     parses the given XML directly (which is expected to be XML
11427     produced from a previous run of virt-inspector).  The list of
11428     names and connect URI are ignored in this case.
11429
11430     This function can throw a wide variety of exceptions, for example
11431     if the external virt-inspector program cannot be found, or if
11432     it doesn't generate valid XML.
11433 *)
11434 "
11435
11436 (* Generate ocaml/guestfs_inspector.ml. *)
11437 let generate_ocaml_inspector_ml () =
11438   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11439
11440   pr "open Unix\n";
11441   pr "\n";
11442
11443   generate_types grammar;
11444   pr "\n";
11445
11446   pr "\
11447 (* Misc functions which are used by the parser code below. *)
11448 let first_child = function
11449   | Xml.Element (_, _, c::_) -> c
11450   | Xml.Element (name, _, []) ->
11451       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11452   | Xml.PCData str ->
11453       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11454
11455 let string_child_or_empty = function
11456   | Xml.Element (_, _, [Xml.PCData s]) -> s
11457   | Xml.Element (_, _, []) -> \"\"
11458   | Xml.Element (x, _, _) ->
11459       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11460                 x ^ \" instead\")
11461   | Xml.PCData str ->
11462       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11463
11464 let optional_child name xml =
11465   let children = Xml.children xml in
11466   try
11467     Some (List.find (function
11468                      | Xml.Element (n, _, _) when n = name -> true
11469                      | _ -> false) children)
11470   with
11471     Not_found -> None
11472
11473 let child name xml =
11474   match optional_child name xml with
11475   | Some c -> c
11476   | None ->
11477       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11478
11479 let attribute name xml =
11480   try Xml.attrib xml name
11481   with Xml.No_attribute _ ->
11482     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11483
11484 ";
11485
11486   generate_parsers grammar;
11487   pr "\n";
11488
11489   pr "\
11490 (* Run external virt-inspector, then use parser to parse the XML. *)
11491 let inspect ?connect ?xml names =
11492   let xml =
11493     match xml with
11494     | None ->
11495         if names = [] then invalid_arg \"inspect: no names given\";
11496         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11497           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11498           names in
11499         let cmd = List.map Filename.quote cmd in
11500         let cmd = String.concat \" \" cmd in
11501         let chan = open_process_in cmd in
11502         let xml = Xml.parse_in chan in
11503         (match close_process_in chan with
11504          | WEXITED 0 -> ()
11505          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11506          | WSIGNALED i | WSTOPPED i ->
11507              failwith (\"external virt-inspector command died or stopped on sig \" ^
11508                        string_of_int i)
11509         );
11510         xml
11511     | Some doc ->
11512         Xml.parse_string doc in
11513   parse_operatingsystems xml
11514 "
11515
11516 (* This is used to generate the src/MAX_PROC_NR file which
11517  * contains the maximum procedure number, a surrogate for the
11518  * ABI version number.  See src/Makefile.am for the details.
11519  *)
11520 and generate_max_proc_nr () =
11521   let proc_nrs = List.map (
11522     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11523   ) daemon_functions in
11524
11525   let max_proc_nr = List.fold_left max 0 proc_nrs in
11526
11527   pr "%d\n" max_proc_nr
11528
11529 let output_to filename k =
11530   let filename_new = filename ^ ".new" in
11531   chan := open_out filename_new;
11532   k ();
11533   close_out !chan;
11534   chan := Pervasives.stdout;
11535
11536   (* Is the new file different from the current file? *)
11537   if Sys.file_exists filename && files_equal filename filename_new then
11538     unlink filename_new                 (* same, so skip it *)
11539   else (
11540     (* different, overwrite old one *)
11541     (try chmod filename 0o644 with Unix_error _ -> ());
11542     rename filename_new filename;
11543     chmod filename 0o444;
11544     printf "written %s\n%!" filename;
11545   )
11546
11547 let perror msg = function
11548   | Unix_error (err, _, _) ->
11549       eprintf "%s: %s\n" msg (error_message err)
11550   | exn ->
11551       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11552
11553 (* Main program. *)
11554 let () =
11555   let lock_fd =
11556     try openfile "HACKING" [O_RDWR] 0
11557     with
11558     | Unix_error (ENOENT, _, _) ->
11559         eprintf "\
11560 You are probably running this from the wrong directory.
11561 Run it from the top source directory using the command
11562   src/generator.ml
11563 ";
11564         exit 1
11565     | exn ->
11566         perror "open: HACKING" exn;
11567         exit 1 in
11568
11569   (* Acquire a lock so parallel builds won't try to run the generator
11570    * twice at the same time.  Subsequent builds will wait for the first
11571    * one to finish.  Note the lock is released implicitly when the
11572    * program exits.
11573    *)
11574   (try lockf lock_fd F_LOCK 1
11575    with exn ->
11576      perror "lock: HACKING" exn;
11577      exit 1);
11578
11579   check_functions ();
11580
11581   output_to "src/guestfs_protocol.x" generate_xdr;
11582   output_to "src/guestfs-structs.h" generate_structs_h;
11583   output_to "src/guestfs-actions.h" generate_actions_h;
11584   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11585   output_to "src/guestfs-actions.c" generate_client_actions;
11586   output_to "src/guestfs-bindtests.c" generate_bindtests;
11587   output_to "src/guestfs-structs.pod" generate_structs_pod;
11588   output_to "src/guestfs-actions.pod" generate_actions_pod;
11589   output_to "src/guestfs-availability.pod" generate_availability_pod;
11590   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11591   output_to "src/libguestfs.syms" generate_linker_script;
11592   output_to "daemon/actions.h" generate_daemon_actions_h;
11593   output_to "daemon/stubs.c" generate_daemon_actions;
11594   output_to "daemon/names.c" generate_daemon_names;
11595   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11596   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11597   output_to "capitests/tests.c" generate_tests;
11598   output_to "fish/cmds.c" generate_fish_cmds;
11599   output_to "fish/completion.c" generate_fish_completion;
11600   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11601   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11602   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11603   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11604   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11605   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11606   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11607   output_to "perl/Guestfs.xs" generate_perl_xs;
11608   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11609   output_to "perl/bindtests.pl" generate_perl_bindtests;
11610   output_to "python/guestfs-py.c" generate_python_c;
11611   output_to "python/guestfs.py" generate_python_py;
11612   output_to "python/bindtests.py" generate_python_bindtests;
11613   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11614   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11615   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11616
11617   List.iter (
11618     fun (typ, jtyp) ->
11619       let cols = cols_of_struct typ in
11620       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11621       output_to filename (generate_java_struct jtyp cols);
11622   ) java_structs;
11623
11624   output_to "java/Makefile.inc" generate_java_makefile_inc;
11625   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11626   output_to "java/Bindtests.java" generate_java_bindtests;
11627   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11628   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11629   output_to "csharp/Libguestfs.cs" generate_csharp;
11630
11631   (* Always generate this file last, and unconditionally.  It's used
11632    * by the Makefile to know when we must re-run the generator.
11633    *)
11634   let chan = open_out "src/stamp-generator" in
11635   fprintf chan "1\n";
11636   close_out chan;
11637
11638   printf "generated %d lines of code\n" !lines