generator: Remove unnecessary parameter.
[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 "    size_t 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 "    size_t 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 "  size_t 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   size_t 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   size_t 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 "    size_t 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 _ | String _
7494         | OptString _ | Bool _
7495         | Int _ | Int64 _
7496         | FileIn _ | FileOut _ -> ()
7497         | Pathname name | Dev_or_Path name ->
7498             pr "  free (%s);\n" name
7499         | StringList name | DeviceList name ->
7500             pr "  free_strings (%s);\n" name
7501       ) (snd style);
7502
7503       (* Check return value for errors and display command results. *)
7504       (match fst style with
7505        | RErr -> pr "  return r;\n"
7506        | RInt _ ->
7507            pr "  if (r == -1) return -1;\n";
7508            pr "  printf (\"%%d\\n\", r);\n";
7509            pr "  return 0;\n"
7510        | RInt64 _ ->
7511            pr "  if (r == -1) return -1;\n";
7512            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7513            pr "  return 0;\n"
7514        | RBool _ ->
7515            pr "  if (r == -1) return -1;\n";
7516            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7517            pr "  return 0;\n"
7518        | RConstString _ ->
7519            pr "  if (r == NULL) return -1;\n";
7520            pr "  printf (\"%%s\\n\", r);\n";
7521            pr "  return 0;\n"
7522        | RConstOptString _ ->
7523            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7524            pr "  return 0;\n"
7525        | RString _ ->
7526            pr "  if (r == NULL) return -1;\n";
7527            pr "  printf (\"%%s\\n\", r);\n";
7528            pr "  free (r);\n";
7529            pr "  return 0;\n"
7530        | RStringList _ ->
7531            pr "  if (r == NULL) return -1;\n";
7532            pr "  print_strings (r);\n";
7533            pr "  free_strings (r);\n";
7534            pr "  return 0;\n"
7535        | RStruct (_, typ) ->
7536            pr "  if (r == NULL) return -1;\n";
7537            pr "  print_%s (r);\n" typ;
7538            pr "  guestfs_free_%s (r);\n" typ;
7539            pr "  return 0;\n"
7540        | RStructList (_, typ) ->
7541            pr "  if (r == NULL) return -1;\n";
7542            pr "  print_%s_list (r);\n" typ;
7543            pr "  guestfs_free_%s_list (r);\n" typ;
7544            pr "  return 0;\n"
7545        | RHashtable _ ->
7546            pr "  if (r == NULL) return -1;\n";
7547            pr "  print_table (r);\n";
7548            pr "  free_strings (r);\n";
7549            pr "  return 0;\n"
7550        | RBufferOut _ ->
7551            pr "  if (r == NULL) return -1;\n";
7552            pr "  if (full_write (1, r, size) != size) {\n";
7553            pr "    perror (\"write\");\n";
7554            pr "    free (r);\n";
7555            pr "    return -1;\n";
7556            pr "  }\n";
7557            pr "  free (r);\n";
7558            pr "  return 0;\n"
7559       );
7560       pr "}\n";
7561       pr "\n"
7562   ) all_functions;
7563
7564   (* run_action function *)
7565   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7566   pr "{\n";
7567   List.iter (
7568     fun (name, _, _, flags, _, _, _) ->
7569       let name2 = replace_char name '_' '-' in
7570       let alias =
7571         try find_map (function FishAlias n -> Some n | _ -> None) flags
7572         with Not_found -> name in
7573       pr "  if (";
7574       pr "STRCASEEQ (cmd, \"%s\")" name;
7575       if name <> name2 then
7576         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7577       if name <> alias then
7578         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7579       pr ")\n";
7580       pr "    return run_%s (cmd, argc, argv);\n" name;
7581       pr "  else\n";
7582   ) all_functions;
7583   pr "    {\n";
7584   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7585   pr "      if (command_num == 1)\n";
7586   pr "        extended_help_message ();\n";
7587   pr "      return -1;\n";
7588   pr "    }\n";
7589   pr "  return 0;\n";
7590   pr "}\n";
7591   pr "\n"
7592
7593 (* Readline completion for guestfish. *)
7594 and generate_fish_completion () =
7595   generate_header CStyle GPLv2plus;
7596
7597   let all_functions =
7598     List.filter (
7599       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7600     ) all_functions in
7601
7602   pr "\
7603 #include <config.h>
7604
7605 #include <stdio.h>
7606 #include <stdlib.h>
7607 #include <string.h>
7608
7609 #ifdef HAVE_LIBREADLINE
7610 #include <readline/readline.h>
7611 #endif
7612
7613 #include \"fish.h\"
7614
7615 #ifdef HAVE_LIBREADLINE
7616
7617 static const char *const commands[] = {
7618   BUILTIN_COMMANDS_FOR_COMPLETION,
7619 ";
7620
7621   (* Get the commands, including the aliases.  They don't need to be
7622    * sorted - the generator() function just does a dumb linear search.
7623    *)
7624   let commands =
7625     List.map (
7626       fun (name, _, _, flags, _, _, _) ->
7627         let name2 = replace_char name '_' '-' in
7628         let alias =
7629           try find_map (function FishAlias n -> Some n | _ -> None) flags
7630           with Not_found -> name in
7631
7632         if name <> alias then [name2; alias] else [name2]
7633     ) all_functions in
7634   let commands = List.flatten commands in
7635
7636   List.iter (pr "  \"%s\",\n") commands;
7637
7638   pr "  NULL
7639 };
7640
7641 static char *
7642 generator (const char *text, int state)
7643 {
7644   static size_t index, len;
7645   const char *name;
7646
7647   if (!state) {
7648     index = 0;
7649     len = strlen (text);
7650   }
7651
7652   rl_attempted_completion_over = 1;
7653
7654   while ((name = commands[index]) != NULL) {
7655     index++;
7656     if (STRCASEEQLEN (name, text, len))
7657       return strdup (name);
7658   }
7659
7660   return NULL;
7661 }
7662
7663 #endif /* HAVE_LIBREADLINE */
7664
7665 #ifdef HAVE_RL_COMPLETION_MATCHES
7666 #define RL_COMPLETION_MATCHES rl_completion_matches
7667 #else
7668 #ifdef HAVE_COMPLETION_MATCHES
7669 #define RL_COMPLETION_MATCHES completion_matches
7670 #endif
7671 #endif /* else just fail if we don't have either symbol */
7672
7673 char **
7674 do_completion (const char *text, int start, int end)
7675 {
7676   char **matches = NULL;
7677
7678 #ifdef HAVE_LIBREADLINE
7679   rl_completion_append_character = ' ';
7680
7681   if (start == 0)
7682     matches = RL_COMPLETION_MATCHES (text, generator);
7683   else if (complete_dest_paths)
7684     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7685 #endif
7686
7687   return matches;
7688 }
7689 ";
7690
7691 (* Generate the POD documentation for guestfish. *)
7692 and generate_fish_actions_pod () =
7693   let all_functions_sorted =
7694     List.filter (
7695       fun (_, _, _, flags, _, _, _) ->
7696         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7697     ) all_functions_sorted in
7698
7699   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7700
7701   List.iter (
7702     fun (name, style, _, flags, _, _, longdesc) ->
7703       let longdesc =
7704         Str.global_substitute rex (
7705           fun s ->
7706             let sub =
7707               try Str.matched_group 1 s
7708               with Not_found ->
7709                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7710             "C<" ^ replace_char sub '_' '-' ^ ">"
7711         ) longdesc in
7712       let name = replace_char name '_' '-' in
7713       let alias =
7714         try find_map (function FishAlias n -> Some n | _ -> None) flags
7715         with Not_found -> name in
7716
7717       pr "=head2 %s" name;
7718       if name <> alias then
7719         pr " | %s" alias;
7720       pr "\n";
7721       pr "\n";
7722       pr " %s" name;
7723       List.iter (
7724         function
7725         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7726         | OptString n -> pr " %s" n
7727         | StringList n | DeviceList n -> pr " '%s ...'" n
7728         | Bool _ -> pr " true|false"
7729         | Int n -> pr " %s" n
7730         | Int64 n -> pr " %s" n
7731         | FileIn n | FileOut n -> pr " (%s|-)" n
7732       ) (snd style);
7733       pr "\n";
7734       pr "\n";
7735       pr "%s\n\n" longdesc;
7736
7737       if List.exists (function FileIn _ | FileOut _ -> true
7738                       | _ -> false) (snd style) then
7739         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7740
7741       if List.mem ProtocolLimitWarning flags then
7742         pr "%s\n\n" protocol_limit_warning;
7743
7744       if List.mem DangerWillRobinson flags then
7745         pr "%s\n\n" danger_will_robinson;
7746
7747       match deprecation_notice flags with
7748       | None -> ()
7749       | Some txt -> pr "%s\n\n" txt
7750   ) all_functions_sorted
7751
7752 (* Generate a C function prototype. *)
7753 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7754     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7755     ?(prefix = "")
7756     ?handle name style =
7757   if extern then pr "extern ";
7758   if static then pr "static ";
7759   (match fst style with
7760    | RErr -> pr "int "
7761    | RInt _ -> pr "int "
7762    | RInt64 _ -> pr "int64_t "
7763    | RBool _ -> pr "int "
7764    | RConstString _ | RConstOptString _ -> pr "const char *"
7765    | RString _ | RBufferOut _ -> pr "char *"
7766    | RStringList _ | RHashtable _ -> pr "char **"
7767    | RStruct (_, typ) ->
7768        if not in_daemon then pr "struct guestfs_%s *" typ
7769        else pr "guestfs_int_%s *" typ
7770    | RStructList (_, typ) ->
7771        if not in_daemon then pr "struct guestfs_%s_list *" typ
7772        else pr "guestfs_int_%s_list *" typ
7773   );
7774   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7775   pr "%s%s (" prefix name;
7776   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7777     pr "void"
7778   else (
7779     let comma = ref false in
7780     (match handle with
7781      | None -> ()
7782      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7783     );
7784     let next () =
7785       if !comma then (
7786         if single_line then pr ", " else pr ",\n\t\t"
7787       );
7788       comma := true
7789     in
7790     List.iter (
7791       function
7792       | Pathname n
7793       | Device n | Dev_or_Path n
7794       | String n
7795       | OptString n ->
7796           next ();
7797           pr "const char *%s" n
7798       | StringList n | DeviceList n ->
7799           next ();
7800           pr "char *const *%s" n
7801       | Bool n -> next (); pr "int %s" n
7802       | Int n -> next (); pr "int %s" n
7803       | Int64 n -> next (); pr "int64_t %s" n
7804       | FileIn n
7805       | FileOut n ->
7806           if not in_daemon then (next (); pr "const char *%s" n)
7807     ) (snd style);
7808     if is_RBufferOut then (next (); pr "size_t *size_r");
7809   );
7810   pr ")";
7811   if semicolon then pr ";";
7812   if newline then pr "\n"
7813
7814 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7815 and generate_c_call_args ?handle ?(decl = false) style =
7816   pr "(";
7817   let comma = ref false in
7818   let next () =
7819     if !comma then pr ", ";
7820     comma := true
7821   in
7822   (match handle with
7823    | None -> ()
7824    | Some handle -> pr "%s" handle; comma := true
7825   );
7826   List.iter (
7827     fun arg ->
7828       next ();
7829       pr "%s" (name_of_argt arg)
7830   ) (snd style);
7831   (* For RBufferOut calls, add implicit &size parameter. *)
7832   if not decl then (
7833     match fst style with
7834     | RBufferOut _ ->
7835         next ();
7836         pr "&size"
7837     | _ -> ()
7838   );
7839   pr ")"
7840
7841 (* Generate the OCaml bindings interface. *)
7842 and generate_ocaml_mli () =
7843   generate_header OCamlStyle LGPLv2plus;
7844
7845   pr "\
7846 (** For API documentation you should refer to the C API
7847     in the guestfs(3) manual page.  The OCaml API uses almost
7848     exactly the same calls. *)
7849
7850 type t
7851 (** A [guestfs_h] handle. *)
7852
7853 exception Error of string
7854 (** This exception is raised when there is an error. *)
7855
7856 exception Handle_closed of string
7857 (** This exception is raised if you use a {!Guestfs.t} handle
7858     after calling {!close} on it.  The string is the name of
7859     the function. *)
7860
7861 val create : unit -> t
7862 (** Create a {!Guestfs.t} handle. *)
7863
7864 val close : t -> unit
7865 (** Close the {!Guestfs.t} handle and free up all resources used
7866     by it immediately.
7867
7868     Handles are closed by the garbage collector when they become
7869     unreferenced, but callers can call this in order to provide
7870     predictable cleanup. *)
7871
7872 ";
7873   generate_ocaml_structure_decls ();
7874
7875   (* The actions. *)
7876   List.iter (
7877     fun (name, style, _, _, _, shortdesc, _) ->
7878       generate_ocaml_prototype name style;
7879       pr "(** %s *)\n" shortdesc;
7880       pr "\n"
7881   ) all_functions_sorted
7882
7883 (* Generate the OCaml bindings implementation. *)
7884 and generate_ocaml_ml () =
7885   generate_header OCamlStyle LGPLv2plus;
7886
7887   pr "\
7888 type t
7889
7890 exception Error of string
7891 exception Handle_closed of string
7892
7893 external create : unit -> t = \"ocaml_guestfs_create\"
7894 external close : t -> unit = \"ocaml_guestfs_close\"
7895
7896 (* Give the exceptions names, so they can be raised from the C code. *)
7897 let () =
7898   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7899   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7900
7901 ";
7902
7903   generate_ocaml_structure_decls ();
7904
7905   (* The actions. *)
7906   List.iter (
7907     fun (name, style, _, _, _, shortdesc, _) ->
7908       generate_ocaml_prototype ~is_external:true name style;
7909   ) all_functions_sorted
7910
7911 (* Generate the OCaml bindings C implementation. *)
7912 and generate_ocaml_c () =
7913   generate_header CStyle LGPLv2plus;
7914
7915   pr "\
7916 #include <stdio.h>
7917 #include <stdlib.h>
7918 #include <string.h>
7919
7920 #include <caml/config.h>
7921 #include <caml/alloc.h>
7922 #include <caml/callback.h>
7923 #include <caml/fail.h>
7924 #include <caml/memory.h>
7925 #include <caml/mlvalues.h>
7926 #include <caml/signals.h>
7927
7928 #include \"guestfs.h\"
7929
7930 #include \"guestfs_c.h\"
7931
7932 /* Copy a hashtable of string pairs into an assoc-list.  We return
7933  * the list in reverse order, but hashtables aren't supposed to be
7934  * ordered anyway.
7935  */
7936 static CAMLprim value
7937 copy_table (char * const * argv)
7938 {
7939   CAMLparam0 ();
7940   CAMLlocal5 (rv, pairv, kv, vv, cons);
7941   size_t i;
7942
7943   rv = Val_int (0);
7944   for (i = 0; argv[i] != NULL; i += 2) {
7945     kv = caml_copy_string (argv[i]);
7946     vv = caml_copy_string (argv[i+1]);
7947     pairv = caml_alloc (2, 0);
7948     Store_field (pairv, 0, kv);
7949     Store_field (pairv, 1, vv);
7950     cons = caml_alloc (2, 0);
7951     Store_field (cons, 1, rv);
7952     rv = cons;
7953     Store_field (cons, 0, pairv);
7954   }
7955
7956   CAMLreturn (rv);
7957 }
7958
7959 ";
7960
7961   (* Struct copy functions. *)
7962
7963   let emit_ocaml_copy_list_function typ =
7964     pr "static CAMLprim value\n";
7965     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7966     pr "{\n";
7967     pr "  CAMLparam0 ();\n";
7968     pr "  CAMLlocal2 (rv, v);\n";
7969     pr "  unsigned int i;\n";
7970     pr "\n";
7971     pr "  if (%ss->len == 0)\n" typ;
7972     pr "    CAMLreturn (Atom (0));\n";
7973     pr "  else {\n";
7974     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7975     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7976     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7977     pr "      caml_modify (&Field (rv, i), v);\n";
7978     pr "    }\n";
7979     pr "    CAMLreturn (rv);\n";
7980     pr "  }\n";
7981     pr "}\n";
7982     pr "\n";
7983   in
7984
7985   List.iter (
7986     fun (typ, cols) ->
7987       let has_optpercent_col =
7988         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7989
7990       pr "static CAMLprim value\n";
7991       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7992       pr "{\n";
7993       pr "  CAMLparam0 ();\n";
7994       if has_optpercent_col then
7995         pr "  CAMLlocal3 (rv, v, v2);\n"
7996       else
7997         pr "  CAMLlocal2 (rv, v);\n";
7998       pr "\n";
7999       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
8000       iteri (
8001         fun i col ->
8002           (match col with
8003            | name, FString ->
8004                pr "  v = caml_copy_string (%s->%s);\n" typ name
8005            | name, FBuffer ->
8006                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8007                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8008                  typ name typ name
8009            | name, FUUID ->
8010                pr "  v = caml_alloc_string (32);\n";
8011                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8012            | name, (FBytes|FInt64|FUInt64) ->
8013                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8014            | name, (FInt32|FUInt32) ->
8015                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8016            | name, FOptPercent ->
8017                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8018                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8019                pr "    v = caml_alloc (1, 0);\n";
8020                pr "    Store_field (v, 0, v2);\n";
8021                pr "  } else /* None */\n";
8022                pr "    v = Val_int (0);\n";
8023            | name, FChar ->
8024                pr "  v = Val_int (%s->%s);\n" typ name
8025           );
8026           pr "  Store_field (rv, %d, v);\n" i
8027       ) cols;
8028       pr "  CAMLreturn (rv);\n";
8029       pr "}\n";
8030       pr "\n";
8031   ) structs;
8032
8033   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8034   List.iter (
8035     function
8036     | typ, (RStructListOnly | RStructAndList) ->
8037         (* generate the function for typ *)
8038         emit_ocaml_copy_list_function typ
8039     | typ, _ -> () (* empty *)
8040   ) (rstructs_used_by all_functions);
8041
8042   (* The wrappers. *)
8043   List.iter (
8044     fun (name, style, _, _, _, _, _) ->
8045       pr "/* Automatically generated wrapper for function\n";
8046       pr " * ";
8047       generate_ocaml_prototype name style;
8048       pr " */\n";
8049       pr "\n";
8050
8051       let params =
8052         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8053
8054       let needs_extra_vs =
8055         match fst style with RConstOptString _ -> true | _ -> false in
8056
8057       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8058       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8059       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8060       pr "\n";
8061
8062       pr "CAMLprim value\n";
8063       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8064       List.iter (pr ", value %s") (List.tl params);
8065       pr ")\n";
8066       pr "{\n";
8067
8068       (match params with
8069        | [p1; p2; p3; p4; p5] ->
8070            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8071        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8072            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8073            pr "  CAMLxparam%d (%s);\n"
8074              (List.length rest) (String.concat ", " rest)
8075        | ps ->
8076            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8077       );
8078       if not needs_extra_vs then
8079         pr "  CAMLlocal1 (rv);\n"
8080       else
8081         pr "  CAMLlocal3 (rv, v, v2);\n";
8082       pr "\n";
8083
8084       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8085       pr "  if (g == NULL)\n";
8086       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8087       pr "\n";
8088
8089       List.iter (
8090         function
8091         | Pathname n
8092         | Device n | Dev_or_Path n
8093         | String n
8094         | FileIn n
8095         | FileOut n ->
8096             (* Copy strings in case the GC moves them: RHBZ#604691 *)
8097             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
8098         | OptString n ->
8099             pr "  char *%s =\n" n;
8100             pr "    %sv != Val_int (0) ?" n;
8101             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
8102         | StringList n | DeviceList n ->
8103             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8104         | Bool n ->
8105             pr "  int %s = Bool_val (%sv);\n" n n
8106         | Int n ->
8107             pr "  int %s = Int_val (%sv);\n" n n
8108         | Int64 n ->
8109             pr "  int64_t %s = Int64_val (%sv);\n" n n
8110       ) (snd style);
8111       let error_code =
8112         match fst style with
8113         | RErr -> pr "  int r;\n"; "-1"
8114         | RInt _ -> pr "  int r;\n"; "-1"
8115         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8116         | RBool _ -> pr "  int r;\n"; "-1"
8117         | RConstString _ | RConstOptString _ ->
8118             pr "  const char *r;\n"; "NULL"
8119         | RString _ -> pr "  char *r;\n"; "NULL"
8120         | RStringList _ ->
8121             pr "  size_t i;\n";
8122             pr "  char **r;\n";
8123             "NULL"
8124         | RStruct (_, typ) ->
8125             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8126         | RStructList (_, typ) ->
8127             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8128         | RHashtable _ ->
8129             pr "  size_t i;\n";
8130             pr "  char **r;\n";
8131             "NULL"
8132         | RBufferOut _ ->
8133             pr "  char *r;\n";
8134             pr "  size_t size;\n";
8135             "NULL" in
8136       pr "\n";
8137
8138       pr "  caml_enter_blocking_section ();\n";
8139       pr "  r = guestfs_%s " name;
8140       generate_c_call_args ~handle:"g" style;
8141       pr ";\n";
8142       pr "  caml_leave_blocking_section ();\n";
8143
8144       (* Free strings if we copied them above. *)
8145       List.iter (
8146         function
8147         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
8148         | FileIn n | FileOut n ->
8149             pr "  free (%s);\n" n
8150         | StringList n | DeviceList n ->
8151             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8152         | Bool _ | Int _ | Int64 _ -> ()
8153       ) (snd style);
8154
8155       pr "  if (r == %s)\n" error_code;
8156       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8157       pr "\n";
8158
8159       (match fst style with
8160        | RErr -> pr "  rv = Val_unit;\n"
8161        | RInt _ -> pr "  rv = Val_int (r);\n"
8162        | RInt64 _ ->
8163            pr "  rv = caml_copy_int64 (r);\n"
8164        | RBool _ -> pr "  rv = Val_bool (r);\n"
8165        | RConstString _ ->
8166            pr "  rv = caml_copy_string (r);\n"
8167        | RConstOptString _ ->
8168            pr "  if (r) { /* Some string */\n";
8169            pr "    v = caml_alloc (1, 0);\n";
8170            pr "    v2 = caml_copy_string (r);\n";
8171            pr "    Store_field (v, 0, v2);\n";
8172            pr "  } else /* None */\n";
8173            pr "    v = Val_int (0);\n";
8174        | RString _ ->
8175            pr "  rv = caml_copy_string (r);\n";
8176            pr "  free (r);\n"
8177        | RStringList _ ->
8178            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8179            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8180            pr "  free (r);\n"
8181        | RStruct (_, typ) ->
8182            pr "  rv = copy_%s (r);\n" typ;
8183            pr "  guestfs_free_%s (r);\n" typ;
8184        | RStructList (_, typ) ->
8185            pr "  rv = copy_%s_list (r);\n" typ;
8186            pr "  guestfs_free_%s_list (r);\n" typ;
8187        | RHashtable _ ->
8188            pr "  rv = copy_table (r);\n";
8189            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8190            pr "  free (r);\n";
8191        | RBufferOut _ ->
8192            pr "  rv = caml_alloc_string (size);\n";
8193            pr "  memcpy (String_val (rv), r, size);\n";
8194       );
8195
8196       pr "  CAMLreturn (rv);\n";
8197       pr "}\n";
8198       pr "\n";
8199
8200       if List.length params > 5 then (
8201         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8202         pr "CAMLprim value ";
8203         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8204         pr "CAMLprim value\n";
8205         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8206         pr "{\n";
8207         pr "  return ocaml_guestfs_%s (argv[0]" name;
8208         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8209         pr ");\n";
8210         pr "}\n";
8211         pr "\n"
8212       )
8213   ) all_functions_sorted
8214
8215 and generate_ocaml_structure_decls () =
8216   List.iter (
8217     fun (typ, cols) ->
8218       pr "type %s = {\n" typ;
8219       List.iter (
8220         function
8221         | name, FString -> pr "  %s : string;\n" name
8222         | name, FBuffer -> pr "  %s : string;\n" name
8223         | name, FUUID -> pr "  %s : string;\n" name
8224         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8225         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8226         | name, FChar -> pr "  %s : char;\n" name
8227         | name, FOptPercent -> pr "  %s : float option;\n" name
8228       ) cols;
8229       pr "}\n";
8230       pr "\n"
8231   ) structs
8232
8233 and generate_ocaml_prototype ?(is_external = false) name style =
8234   if is_external then pr "external " else pr "val ";
8235   pr "%s : t -> " name;
8236   List.iter (
8237     function
8238     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8239     | OptString _ -> pr "string option -> "
8240     | StringList _ | DeviceList _ -> pr "string array -> "
8241     | Bool _ -> pr "bool -> "
8242     | Int _ -> pr "int -> "
8243     | Int64 _ -> pr "int64 -> "
8244   ) (snd style);
8245   (match fst style with
8246    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8247    | RInt _ -> pr "int"
8248    | RInt64 _ -> pr "int64"
8249    | RBool _ -> pr "bool"
8250    | RConstString _ -> pr "string"
8251    | RConstOptString _ -> pr "string option"
8252    | RString _ | RBufferOut _ -> pr "string"
8253    | RStringList _ -> pr "string array"
8254    | RStruct (_, typ) -> pr "%s" typ
8255    | RStructList (_, typ) -> pr "%s array" typ
8256    | RHashtable _ -> pr "(string * string) list"
8257   );
8258   if is_external then (
8259     pr " = ";
8260     if List.length (snd style) + 1 > 5 then
8261       pr "\"ocaml_guestfs_%s_byte\" " name;
8262     pr "\"ocaml_guestfs_%s\"" name
8263   );
8264   pr "\n"
8265
8266 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8267 and generate_perl_xs () =
8268   generate_header CStyle LGPLv2plus;
8269
8270   pr "\
8271 #include \"EXTERN.h\"
8272 #include \"perl.h\"
8273 #include \"XSUB.h\"
8274
8275 #include <guestfs.h>
8276
8277 #ifndef PRId64
8278 #define PRId64 \"lld\"
8279 #endif
8280
8281 static SV *
8282 my_newSVll(long long val) {
8283 #ifdef USE_64_BIT_ALL
8284   return newSViv(val);
8285 #else
8286   char buf[100];
8287   int len;
8288   len = snprintf(buf, 100, \"%%\" PRId64, val);
8289   return newSVpv(buf, len);
8290 #endif
8291 }
8292
8293 #ifndef PRIu64
8294 #define PRIu64 \"llu\"
8295 #endif
8296
8297 static SV *
8298 my_newSVull(unsigned long long val) {
8299 #ifdef USE_64_BIT_ALL
8300   return newSVuv(val);
8301 #else
8302   char buf[100];
8303   int len;
8304   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8305   return newSVpv(buf, len);
8306 #endif
8307 }
8308
8309 /* http://www.perlmonks.org/?node_id=680842 */
8310 static char **
8311 XS_unpack_charPtrPtr (SV *arg) {
8312   char **ret;
8313   AV *av;
8314   I32 i;
8315
8316   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8317     croak (\"array reference expected\");
8318
8319   av = (AV *)SvRV (arg);
8320   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8321   if (!ret)
8322     croak (\"malloc failed\");
8323
8324   for (i = 0; i <= av_len (av); i++) {
8325     SV **elem = av_fetch (av, i, 0);
8326
8327     if (!elem || !*elem)
8328       croak (\"missing element in list\");
8329
8330     ret[i] = SvPV_nolen (*elem);
8331   }
8332
8333   ret[i] = NULL;
8334
8335   return ret;
8336 }
8337
8338 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8339
8340 PROTOTYPES: ENABLE
8341
8342 guestfs_h *
8343 _create ()
8344    CODE:
8345       RETVAL = guestfs_create ();
8346       if (!RETVAL)
8347         croak (\"could not create guestfs handle\");
8348       guestfs_set_error_handler (RETVAL, NULL, NULL);
8349  OUTPUT:
8350       RETVAL
8351
8352 void
8353 DESTROY (g)
8354       guestfs_h *g;
8355  PPCODE:
8356       guestfs_close (g);
8357
8358 ";
8359
8360   List.iter (
8361     fun (name, style, _, _, _, _, _) ->
8362       (match fst style with
8363        | RErr -> pr "void\n"
8364        | RInt _ -> pr "SV *\n"
8365        | RInt64 _ -> pr "SV *\n"
8366        | RBool _ -> pr "SV *\n"
8367        | RConstString _ -> pr "SV *\n"
8368        | RConstOptString _ -> pr "SV *\n"
8369        | RString _ -> pr "SV *\n"
8370        | RBufferOut _ -> pr "SV *\n"
8371        | RStringList _
8372        | RStruct _ | RStructList _
8373        | RHashtable _ ->
8374            pr "void\n" (* all lists returned implictly on the stack *)
8375       );
8376       (* Call and arguments. *)
8377       pr "%s " name;
8378       generate_c_call_args ~handle:"g" ~decl:true style;
8379       pr "\n";
8380       pr "      guestfs_h *g;\n";
8381       iteri (
8382         fun i ->
8383           function
8384           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8385               pr "      char *%s;\n" n
8386           | OptString n ->
8387               (* http://www.perlmonks.org/?node_id=554277
8388                * Note that the implicit handle argument means we have
8389                * to add 1 to the ST(x) operator.
8390                *)
8391               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8392           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8393           | Bool n -> pr "      int %s;\n" n
8394           | Int n -> pr "      int %s;\n" n
8395           | Int64 n -> pr "      int64_t %s;\n" n
8396       ) (snd style);
8397
8398       let do_cleanups () =
8399         List.iter (
8400           function
8401           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8402           | Bool _ | Int _ | Int64 _
8403           | FileIn _ | FileOut _ -> ()
8404           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8405         ) (snd style)
8406       in
8407
8408       (* Code. *)
8409       (match fst style with
8410        | RErr ->
8411            pr "PREINIT:\n";
8412            pr "      int r;\n";
8413            pr " PPCODE:\n";
8414            pr "      r = guestfs_%s " name;
8415            generate_c_call_args ~handle:"g" style;
8416            pr ";\n";
8417            do_cleanups ();
8418            pr "      if (r == -1)\n";
8419            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8420        | RInt n
8421        | RBool n ->
8422            pr "PREINIT:\n";
8423            pr "      int %s;\n" n;
8424            pr "   CODE:\n";
8425            pr "      %s = guestfs_%s " n name;
8426            generate_c_call_args ~handle:"g" style;
8427            pr ";\n";
8428            do_cleanups ();
8429            pr "      if (%s == -1)\n" n;
8430            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8431            pr "      RETVAL = newSViv (%s);\n" n;
8432            pr " OUTPUT:\n";
8433            pr "      RETVAL\n"
8434        | RInt64 n ->
8435            pr "PREINIT:\n";
8436            pr "      int64_t %s;\n" n;
8437            pr "   CODE:\n";
8438            pr "      %s = guestfs_%s " n name;
8439            generate_c_call_args ~handle:"g" style;
8440            pr ";\n";
8441            do_cleanups ();
8442            pr "      if (%s == -1)\n" n;
8443            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8444            pr "      RETVAL = my_newSVll (%s);\n" n;
8445            pr " OUTPUT:\n";
8446            pr "      RETVAL\n"
8447        | RConstString n ->
8448            pr "PREINIT:\n";
8449            pr "      const char *%s;\n" n;
8450            pr "   CODE:\n";
8451            pr "      %s = guestfs_%s " n name;
8452            generate_c_call_args ~handle:"g" style;
8453            pr ";\n";
8454            do_cleanups ();
8455            pr "      if (%s == NULL)\n" n;
8456            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8457            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8458            pr " OUTPUT:\n";
8459            pr "      RETVAL\n"
8460        | RConstOptString n ->
8461            pr "PREINIT:\n";
8462            pr "      const char *%s;\n" n;
8463            pr "   CODE:\n";
8464            pr "      %s = guestfs_%s " n name;
8465            generate_c_call_args ~handle:"g" style;
8466            pr ";\n";
8467            do_cleanups ();
8468            pr "      if (%s == NULL)\n" n;
8469            pr "        RETVAL = &PL_sv_undef;\n";
8470            pr "      else\n";
8471            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8472            pr " OUTPUT:\n";
8473            pr "      RETVAL\n"
8474        | RString n ->
8475            pr "PREINIT:\n";
8476            pr "      char *%s;\n" n;
8477            pr "   CODE:\n";
8478            pr "      %s = guestfs_%s " n name;
8479            generate_c_call_args ~handle:"g" style;
8480            pr ";\n";
8481            do_cleanups ();
8482            pr "      if (%s == NULL)\n" n;
8483            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8484            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8485            pr "      free (%s);\n" n;
8486            pr " OUTPUT:\n";
8487            pr "      RETVAL\n"
8488        | RStringList n | RHashtable n ->
8489            pr "PREINIT:\n";
8490            pr "      char **%s;\n" n;
8491            pr "      size_t i, n;\n";
8492            pr " PPCODE:\n";
8493            pr "      %s = guestfs_%s " n name;
8494            generate_c_call_args ~handle:"g" style;
8495            pr ";\n";
8496            do_cleanups ();
8497            pr "      if (%s == NULL)\n" n;
8498            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8499            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8500            pr "      EXTEND (SP, n);\n";
8501            pr "      for (i = 0; i < n; ++i) {\n";
8502            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8503            pr "        free (%s[i]);\n" n;
8504            pr "      }\n";
8505            pr "      free (%s);\n" n;
8506        | RStruct (n, typ) ->
8507            let cols = cols_of_struct typ in
8508            generate_perl_struct_code typ cols name style n do_cleanups
8509        | RStructList (n, typ) ->
8510            let cols = cols_of_struct typ in
8511            generate_perl_struct_list_code typ cols name style n do_cleanups
8512        | RBufferOut n ->
8513            pr "PREINIT:\n";
8514            pr "      char *%s;\n" n;
8515            pr "      size_t size;\n";
8516            pr "   CODE:\n";
8517            pr "      %s = guestfs_%s " n name;
8518            generate_c_call_args ~handle:"g" style;
8519            pr ";\n";
8520            do_cleanups ();
8521            pr "      if (%s == NULL)\n" n;
8522            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8523            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8524            pr "      free (%s);\n" n;
8525            pr " OUTPUT:\n";
8526            pr "      RETVAL\n"
8527       );
8528
8529       pr "\n"
8530   ) all_functions
8531
8532 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8533   pr "PREINIT:\n";
8534   pr "      struct guestfs_%s_list *%s;\n" typ n;
8535   pr "      size_t i;\n";
8536   pr "      HV *hv;\n";
8537   pr " PPCODE:\n";
8538   pr "      %s = guestfs_%s " n name;
8539   generate_c_call_args ~handle:"g" style;
8540   pr ";\n";
8541   do_cleanups ();
8542   pr "      if (%s == NULL)\n" n;
8543   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8544   pr "      EXTEND (SP, %s->len);\n" n;
8545   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8546   pr "        hv = newHV ();\n";
8547   List.iter (
8548     function
8549     | name, FString ->
8550         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8551           name (String.length name) n name
8552     | name, FUUID ->
8553         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8554           name (String.length name) n name
8555     | name, FBuffer ->
8556         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8557           name (String.length name) n name n name
8558     | name, (FBytes|FUInt64) ->
8559         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8560           name (String.length name) n name
8561     | name, FInt64 ->
8562         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8563           name (String.length name) n name
8564     | name, (FInt32|FUInt32) ->
8565         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8566           name (String.length name) n name
8567     | name, FChar ->
8568         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8569           name (String.length name) n name
8570     | name, FOptPercent ->
8571         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8572           name (String.length name) n name
8573   ) cols;
8574   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8575   pr "      }\n";
8576   pr "      guestfs_free_%s_list (%s);\n" typ n
8577
8578 and generate_perl_struct_code typ cols name style n do_cleanups =
8579   pr "PREINIT:\n";
8580   pr "      struct guestfs_%s *%s;\n" typ n;
8581   pr " PPCODE:\n";
8582   pr "      %s = guestfs_%s " n name;
8583   generate_c_call_args ~handle:"g" style;
8584   pr ";\n";
8585   do_cleanups ();
8586   pr "      if (%s == NULL)\n" n;
8587   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8588   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8589   List.iter (
8590     fun ((name, _) as col) ->
8591       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8592
8593       match col with
8594       | name, FString ->
8595           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8596             n name
8597       | name, FBuffer ->
8598           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8599             n name n name
8600       | name, FUUID ->
8601           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8602             n name
8603       | name, (FBytes|FUInt64) ->
8604           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8605             n name
8606       | name, FInt64 ->
8607           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8608             n name
8609       | name, (FInt32|FUInt32) ->
8610           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8611             n name
8612       | name, FChar ->
8613           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8614             n name
8615       | name, FOptPercent ->
8616           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8617             n name
8618   ) cols;
8619   pr "      free (%s);\n" n
8620
8621 (* Generate Sys/Guestfs.pm. *)
8622 and generate_perl_pm () =
8623   generate_header HashStyle LGPLv2plus;
8624
8625   pr "\
8626 =pod
8627
8628 =head1 NAME
8629
8630 Sys::Guestfs - Perl bindings for libguestfs
8631
8632 =head1 SYNOPSIS
8633
8634  use Sys::Guestfs;
8635
8636  my $h = Sys::Guestfs->new ();
8637  $h->add_drive ('guest.img');
8638  $h->launch ();
8639  $h->mount ('/dev/sda1', '/');
8640  $h->touch ('/hello');
8641  $h->sync ();
8642
8643 =head1 DESCRIPTION
8644
8645 The C<Sys::Guestfs> module provides a Perl XS binding to the
8646 libguestfs API for examining and modifying virtual machine
8647 disk images.
8648
8649 Amongst the things this is good for: making batch configuration
8650 changes to guests, getting disk used/free statistics (see also:
8651 virt-df), migrating between virtualization systems (see also:
8652 virt-p2v), performing partial backups, performing partial guest
8653 clones, cloning guests and changing registry/UUID/hostname info, and
8654 much else besides.
8655
8656 Libguestfs uses Linux kernel and qemu code, and can access any type of
8657 guest filesystem that Linux and qemu can, including but not limited
8658 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8659 schemes, qcow, qcow2, vmdk.
8660
8661 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8662 LVs, what filesystem is in each LV, etc.).  It can also run commands
8663 in the context of the guest.  Also you can access filesystems over
8664 FUSE.
8665
8666 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8667 functions for using libguestfs from Perl, including integration
8668 with libvirt.
8669
8670 =head1 ERRORS
8671
8672 All errors turn into calls to C<croak> (see L<Carp(3)>).
8673
8674 =head1 METHODS
8675
8676 =over 4
8677
8678 =cut
8679
8680 package Sys::Guestfs;
8681
8682 use strict;
8683 use warnings;
8684
8685 require XSLoader;
8686 XSLoader::load ('Sys::Guestfs');
8687
8688 =item $h = Sys::Guestfs->new ();
8689
8690 Create a new guestfs handle.
8691
8692 =cut
8693
8694 sub new {
8695   my $proto = shift;
8696   my $class = ref ($proto) || $proto;
8697
8698   my $self = Sys::Guestfs::_create ();
8699   bless $self, $class;
8700   return $self;
8701 }
8702
8703 ";
8704
8705   (* Actions.  We only need to print documentation for these as
8706    * they are pulled in from the XS code automatically.
8707    *)
8708   List.iter (
8709     fun (name, style, _, flags, _, _, longdesc) ->
8710       if not (List.mem NotInDocs flags) then (
8711         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8712         pr "=item ";
8713         generate_perl_prototype name style;
8714         pr "\n\n";
8715         pr "%s\n\n" longdesc;
8716         if List.mem ProtocolLimitWarning flags then
8717           pr "%s\n\n" protocol_limit_warning;
8718         if List.mem DangerWillRobinson flags then
8719           pr "%s\n\n" danger_will_robinson;
8720         match deprecation_notice flags with
8721         | None -> ()
8722         | Some txt -> pr "%s\n\n" txt
8723       )
8724   ) all_functions_sorted;
8725
8726   (* End of file. *)
8727   pr "\
8728 =cut
8729
8730 1;
8731
8732 =back
8733
8734 =head1 COPYRIGHT
8735
8736 Copyright (C) %s Red Hat Inc.
8737
8738 =head1 LICENSE
8739
8740 Please see the file COPYING.LIB for the full license.
8741
8742 =head1 SEE ALSO
8743
8744 L<guestfs(3)>,
8745 L<guestfish(1)>,
8746 L<http://libguestfs.org>,
8747 L<Sys::Guestfs::Lib(3)>.
8748
8749 =cut
8750 " copyright_years
8751
8752 and generate_perl_prototype name style =
8753   (match fst style with
8754    | RErr -> ()
8755    | RBool n
8756    | RInt n
8757    | RInt64 n
8758    | RConstString n
8759    | RConstOptString n
8760    | RString n
8761    | RBufferOut n -> pr "$%s = " n
8762    | RStruct (n,_)
8763    | RHashtable n -> pr "%%%s = " n
8764    | RStringList n
8765    | RStructList (n,_) -> pr "@%s = " n
8766   );
8767   pr "$h->%s (" name;
8768   let comma = ref false in
8769   List.iter (
8770     fun arg ->
8771       if !comma then pr ", ";
8772       comma := true;
8773       match arg with
8774       | Pathname n | Device n | Dev_or_Path n | String n
8775       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8776           pr "$%s" n
8777       | StringList n | DeviceList n ->
8778           pr "\\@%s" n
8779   ) (snd style);
8780   pr ");"
8781
8782 (* Generate Python C module. *)
8783 and generate_python_c () =
8784   generate_header CStyle LGPLv2plus;
8785
8786   pr "\
8787 #include <Python.h>
8788
8789 #include <stdio.h>
8790 #include <stdlib.h>
8791 #include <assert.h>
8792
8793 #include \"guestfs.h\"
8794
8795 typedef struct {
8796   PyObject_HEAD
8797   guestfs_h *g;
8798 } Pyguestfs_Object;
8799
8800 static guestfs_h *
8801 get_handle (PyObject *obj)
8802 {
8803   assert (obj);
8804   assert (obj != Py_None);
8805   return ((Pyguestfs_Object *) obj)->g;
8806 }
8807
8808 static PyObject *
8809 put_handle (guestfs_h *g)
8810 {
8811   assert (g);
8812   return
8813     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8814 }
8815
8816 /* This list should be freed (but not the strings) after use. */
8817 static char **
8818 get_string_list (PyObject *obj)
8819 {
8820   size_t i, len;
8821   char **r;
8822
8823   assert (obj);
8824
8825   if (!PyList_Check (obj)) {
8826     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8827     return NULL;
8828   }
8829
8830   Py_ssize_t slen = PyList_Size (obj);
8831   if (slen == -1) {
8832     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
8833     return NULL;
8834   }
8835   len = (size_t) slen;
8836   r = malloc (sizeof (char *) * (len+1));
8837   if (r == NULL) {
8838     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8839     return NULL;
8840   }
8841
8842   for (i = 0; i < len; ++i)
8843     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8844   r[len] = NULL;
8845
8846   return r;
8847 }
8848
8849 static PyObject *
8850 put_string_list (char * const * const argv)
8851 {
8852   PyObject *list;
8853   int argc, i;
8854
8855   for (argc = 0; argv[argc] != NULL; ++argc)
8856     ;
8857
8858   list = PyList_New (argc);
8859   for (i = 0; i < argc; ++i)
8860     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8861
8862   return list;
8863 }
8864
8865 static PyObject *
8866 put_table (char * const * const argv)
8867 {
8868   PyObject *list, *item;
8869   int argc, i;
8870
8871   for (argc = 0; argv[argc] != NULL; ++argc)
8872     ;
8873
8874   list = PyList_New (argc >> 1);
8875   for (i = 0; i < argc; i += 2) {
8876     item = PyTuple_New (2);
8877     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8878     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8879     PyList_SetItem (list, i >> 1, item);
8880   }
8881
8882   return list;
8883 }
8884
8885 static void
8886 free_strings (char **argv)
8887 {
8888   int argc;
8889
8890   for (argc = 0; argv[argc] != NULL; ++argc)
8891     free (argv[argc]);
8892   free (argv);
8893 }
8894
8895 static PyObject *
8896 py_guestfs_create (PyObject *self, PyObject *args)
8897 {
8898   guestfs_h *g;
8899
8900   g = guestfs_create ();
8901   if (g == NULL) {
8902     PyErr_SetString (PyExc_RuntimeError,
8903                      \"guestfs.create: failed to allocate handle\");
8904     return NULL;
8905   }
8906   guestfs_set_error_handler (g, NULL, NULL);
8907   return put_handle (g);
8908 }
8909
8910 static PyObject *
8911 py_guestfs_close (PyObject *self, PyObject *args)
8912 {
8913   PyObject *py_g;
8914   guestfs_h *g;
8915
8916   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8917     return NULL;
8918   g = get_handle (py_g);
8919
8920   guestfs_close (g);
8921
8922   Py_INCREF (Py_None);
8923   return Py_None;
8924 }
8925
8926 ";
8927
8928   let emit_put_list_function typ =
8929     pr "static PyObject *\n";
8930     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8931     pr "{\n";
8932     pr "  PyObject *list;\n";
8933     pr "  size_t i;\n";
8934     pr "\n";
8935     pr "  list = PyList_New (%ss->len);\n" typ;
8936     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8937     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8938     pr "  return list;\n";
8939     pr "};\n";
8940     pr "\n"
8941   in
8942
8943   (* Structures, turned into Python dictionaries. *)
8944   List.iter (
8945     fun (typ, cols) ->
8946       pr "static PyObject *\n";
8947       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8948       pr "{\n";
8949       pr "  PyObject *dict;\n";
8950       pr "\n";
8951       pr "  dict = PyDict_New ();\n";
8952       List.iter (
8953         function
8954         | name, FString ->
8955             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8956             pr "                        PyString_FromString (%s->%s));\n"
8957               typ name
8958         | name, FBuffer ->
8959             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8960             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8961               typ name typ name
8962         | name, FUUID ->
8963             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8964             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8965               typ name
8966         | name, (FBytes|FUInt64) ->
8967             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8968             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8969               typ name
8970         | name, FInt64 ->
8971             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8972             pr "                        PyLong_FromLongLong (%s->%s));\n"
8973               typ name
8974         | name, FUInt32 ->
8975             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8976             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8977               typ name
8978         | name, FInt32 ->
8979             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8980             pr "                        PyLong_FromLong (%s->%s));\n"
8981               typ name
8982         | name, FOptPercent ->
8983             pr "  if (%s->%s >= 0)\n" typ name;
8984             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8985             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8986               typ name;
8987             pr "  else {\n";
8988             pr "    Py_INCREF (Py_None);\n";
8989             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8990             pr "  }\n"
8991         | name, FChar ->
8992             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8993             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8994       ) cols;
8995       pr "  return dict;\n";
8996       pr "};\n";
8997       pr "\n";
8998
8999   ) structs;
9000
9001   (* Emit a put_TYPE_list function definition only if that function is used. *)
9002   List.iter (
9003     function
9004     | typ, (RStructListOnly | RStructAndList) ->
9005         (* generate the function for typ *)
9006         emit_put_list_function typ
9007     | typ, _ -> () (* empty *)
9008   ) (rstructs_used_by all_functions);
9009
9010   (* Python wrapper functions. *)
9011   List.iter (
9012     fun (name, style, _, _, _, _, _) ->
9013       pr "static PyObject *\n";
9014       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9015       pr "{\n";
9016
9017       pr "  PyObject *py_g;\n";
9018       pr "  guestfs_h *g;\n";
9019       pr "  PyObject *py_r;\n";
9020
9021       let error_code =
9022         match fst style with
9023         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9024         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9025         | RConstString _ | RConstOptString _ ->
9026             pr "  const char *r;\n"; "NULL"
9027         | RString _ -> pr "  char *r;\n"; "NULL"
9028         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9029         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9030         | RStructList (_, typ) ->
9031             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9032         | RBufferOut _ ->
9033             pr "  char *r;\n";
9034             pr "  size_t size;\n";
9035             "NULL" in
9036
9037       List.iter (
9038         function
9039         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9040             pr "  const char *%s;\n" n
9041         | OptString n -> pr "  const char *%s;\n" n
9042         | StringList n | DeviceList n ->
9043             pr "  PyObject *py_%s;\n" n;
9044             pr "  char **%s;\n" n
9045         | Bool n -> pr "  int %s;\n" n
9046         | Int n -> pr "  int %s;\n" n
9047         | Int64 n -> pr "  long long %s;\n" n
9048       ) (snd style);
9049
9050       pr "\n";
9051
9052       (* Convert the parameters. *)
9053       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9054       List.iter (
9055         function
9056         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9057         | OptString _ -> pr "z"
9058         | StringList _ | DeviceList _ -> pr "O"
9059         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9060         | Int _ -> pr "i"
9061         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9062                              * emulate C's int/long/long long in Python?
9063                              *)
9064       ) (snd style);
9065       pr ":guestfs_%s\",\n" name;
9066       pr "                         &py_g";
9067       List.iter (
9068         function
9069         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9070         | OptString n -> pr ", &%s" n
9071         | StringList n | DeviceList n -> pr ", &py_%s" n
9072         | Bool n -> pr ", &%s" n
9073         | Int n -> pr ", &%s" n
9074         | Int64 n -> pr ", &%s" n
9075       ) (snd style);
9076
9077       pr "))\n";
9078       pr "    return NULL;\n";
9079
9080       pr "  g = get_handle (py_g);\n";
9081       List.iter (
9082         function
9083         | Pathname _ | Device _ | Dev_or_Path _ | String _
9084         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9085         | StringList n | DeviceList n ->
9086             pr "  %s = get_string_list (py_%s);\n" n n;
9087             pr "  if (!%s) return NULL;\n" n
9088       ) (snd style);
9089
9090       pr "\n";
9091
9092       pr "  r = guestfs_%s " name;
9093       generate_c_call_args ~handle:"g" style;
9094       pr ";\n";
9095
9096       List.iter (
9097         function
9098         | Pathname _ | Device _ | Dev_or_Path _ | String _
9099         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9100         | StringList n | DeviceList n ->
9101             pr "  free (%s);\n" n
9102       ) (snd style);
9103
9104       pr "  if (r == %s) {\n" error_code;
9105       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9106       pr "    return NULL;\n";
9107       pr "  }\n";
9108       pr "\n";
9109
9110       (match fst style with
9111        | RErr ->
9112            pr "  Py_INCREF (Py_None);\n";
9113            pr "  py_r = Py_None;\n"
9114        | RInt _
9115        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9116        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9117        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9118        | RConstOptString _ ->
9119            pr "  if (r)\n";
9120            pr "    py_r = PyString_FromString (r);\n";
9121            pr "  else {\n";
9122            pr "    Py_INCREF (Py_None);\n";
9123            pr "    py_r = Py_None;\n";
9124            pr "  }\n"
9125        | RString _ ->
9126            pr "  py_r = PyString_FromString (r);\n";
9127            pr "  free (r);\n"
9128        | RStringList _ ->
9129            pr "  py_r = put_string_list (r);\n";
9130            pr "  free_strings (r);\n"
9131        | RStruct (_, typ) ->
9132            pr "  py_r = put_%s (r);\n" typ;
9133            pr "  guestfs_free_%s (r);\n" typ
9134        | RStructList (_, typ) ->
9135            pr "  py_r = put_%s_list (r);\n" typ;
9136            pr "  guestfs_free_%s_list (r);\n" typ
9137        | RHashtable n ->
9138            pr "  py_r = put_table (r);\n";
9139            pr "  free_strings (r);\n"
9140        | RBufferOut _ ->
9141            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9142            pr "  free (r);\n"
9143       );
9144
9145       pr "  return py_r;\n";
9146       pr "}\n";
9147       pr "\n"
9148   ) all_functions;
9149
9150   (* Table of functions. *)
9151   pr "static PyMethodDef methods[] = {\n";
9152   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9153   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9154   List.iter (
9155     fun (name, _, _, _, _, _, _) ->
9156       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9157         name name
9158   ) all_functions;
9159   pr "  { NULL, NULL, 0, NULL }\n";
9160   pr "};\n";
9161   pr "\n";
9162
9163   (* Init function. *)
9164   pr "\
9165 void
9166 initlibguestfsmod (void)
9167 {
9168   static int initialized = 0;
9169
9170   if (initialized) return;
9171   Py_InitModule ((char *) \"libguestfsmod\", methods);
9172   initialized = 1;
9173 }
9174 "
9175
9176 (* Generate Python module. *)
9177 and generate_python_py () =
9178   generate_header HashStyle LGPLv2plus;
9179
9180   pr "\
9181 u\"\"\"Python bindings for libguestfs
9182
9183 import guestfs
9184 g = guestfs.GuestFS ()
9185 g.add_drive (\"guest.img\")
9186 g.launch ()
9187 parts = g.list_partitions ()
9188
9189 The guestfs module provides a Python binding to the libguestfs API
9190 for examining and modifying virtual machine disk images.
9191
9192 Amongst the things this is good for: making batch configuration
9193 changes to guests, getting disk used/free statistics (see also:
9194 virt-df), migrating between virtualization systems (see also:
9195 virt-p2v), performing partial backups, performing partial guest
9196 clones, cloning guests and changing registry/UUID/hostname info, and
9197 much else besides.
9198
9199 Libguestfs uses Linux kernel and qemu code, and can access any type of
9200 guest filesystem that Linux and qemu can, including but not limited
9201 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9202 schemes, qcow, qcow2, vmdk.
9203
9204 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9205 LVs, what filesystem is in each LV, etc.).  It can also run commands
9206 in the context of the guest.  Also you can access filesystems over
9207 FUSE.
9208
9209 Errors which happen while using the API are turned into Python
9210 RuntimeError exceptions.
9211
9212 To create a guestfs handle you usually have to perform the following
9213 sequence of calls:
9214
9215 # Create the handle, call add_drive at least once, and possibly
9216 # several times if the guest has multiple block devices:
9217 g = guestfs.GuestFS ()
9218 g.add_drive (\"guest.img\")
9219
9220 # Launch the qemu subprocess and wait for it to become ready:
9221 g.launch ()
9222
9223 # Now you can issue commands, for example:
9224 logvols = g.lvs ()
9225
9226 \"\"\"
9227
9228 import libguestfsmod
9229
9230 class GuestFS:
9231     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9232
9233     def __init__ (self):
9234         \"\"\"Create a new libguestfs handle.\"\"\"
9235         self._o = libguestfsmod.create ()
9236
9237     def __del__ (self):
9238         libguestfsmod.close (self._o)
9239
9240 ";
9241
9242   List.iter (
9243     fun (name, style, _, flags, _, _, longdesc) ->
9244       pr "    def %s " name;
9245       generate_py_call_args ~handle:"self" (snd style);
9246       pr ":\n";
9247
9248       if not (List.mem NotInDocs flags) then (
9249         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9250         let doc =
9251           match fst style with
9252           | RErr | RInt _ | RInt64 _ | RBool _
9253           | RConstOptString _ | RConstString _
9254           | RString _ | RBufferOut _ -> doc
9255           | RStringList _ ->
9256               doc ^ "\n\nThis function returns a list of strings."
9257           | RStruct (_, typ) ->
9258               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9259           | RStructList (_, typ) ->
9260               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9261           | RHashtable _ ->
9262               doc ^ "\n\nThis function returns a dictionary." in
9263         let doc =
9264           if List.mem ProtocolLimitWarning flags then
9265             doc ^ "\n\n" ^ protocol_limit_warning
9266           else doc in
9267         let doc =
9268           if List.mem DangerWillRobinson flags then
9269             doc ^ "\n\n" ^ danger_will_robinson
9270           else doc in
9271         let doc =
9272           match deprecation_notice flags with
9273           | None -> doc
9274           | Some txt -> doc ^ "\n\n" ^ txt in
9275         let doc = pod2text ~width:60 name doc in
9276         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9277         let doc = String.concat "\n        " doc in
9278         pr "        u\"\"\"%s\"\"\"\n" doc;
9279       );
9280       pr "        return libguestfsmod.%s " name;
9281       generate_py_call_args ~handle:"self._o" (snd style);
9282       pr "\n";
9283       pr "\n";
9284   ) all_functions
9285
9286 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9287 and generate_py_call_args ~handle args =
9288   pr "(%s" handle;
9289   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9290   pr ")"
9291
9292 (* Useful if you need the longdesc POD text as plain text.  Returns a
9293  * list of lines.
9294  *
9295  * Because this is very slow (the slowest part of autogeneration),
9296  * we memoize the results.
9297  *)
9298 and pod2text ~width name longdesc =
9299   let key = width, name, longdesc in
9300   try Hashtbl.find pod2text_memo key
9301   with Not_found ->
9302     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9303     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9304     close_out chan;
9305     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9306     let chan = open_process_in cmd in
9307     let lines = ref [] in
9308     let rec loop i =
9309       let line = input_line chan in
9310       if i = 1 then             (* discard the first line of output *)
9311         loop (i+1)
9312       else (
9313         let line = triml line in
9314         lines := line :: !lines;
9315         loop (i+1)
9316       ) in
9317     let lines = try loop 1 with End_of_file -> List.rev !lines in
9318     unlink filename;
9319     (match close_process_in chan with
9320      | WEXITED 0 -> ()
9321      | WEXITED i ->
9322          failwithf "pod2text: process exited with non-zero status (%d)" i
9323      | WSIGNALED i | WSTOPPED i ->
9324          failwithf "pod2text: process signalled or stopped by signal %d" i
9325     );
9326     Hashtbl.add pod2text_memo key lines;
9327     pod2text_memo_updated ();
9328     lines
9329
9330 (* Generate ruby bindings. *)
9331 and generate_ruby_c () =
9332   generate_header CStyle LGPLv2plus;
9333
9334   pr "\
9335 #include <stdio.h>
9336 #include <stdlib.h>
9337
9338 #include <ruby.h>
9339
9340 #include \"guestfs.h\"
9341
9342 #include \"extconf.h\"
9343
9344 /* For Ruby < 1.9 */
9345 #ifndef RARRAY_LEN
9346 #define RARRAY_LEN(r) (RARRAY((r))->len)
9347 #endif
9348
9349 static VALUE m_guestfs;                 /* guestfs module */
9350 static VALUE c_guestfs;                 /* guestfs_h handle */
9351 static VALUE e_Error;                   /* used for all errors */
9352
9353 static void ruby_guestfs_free (void *p)
9354 {
9355   if (!p) return;
9356   guestfs_close ((guestfs_h *) p);
9357 }
9358
9359 static VALUE ruby_guestfs_create (VALUE m)
9360 {
9361   guestfs_h *g;
9362
9363   g = guestfs_create ();
9364   if (!g)
9365     rb_raise (e_Error, \"failed to create guestfs handle\");
9366
9367   /* Don't print error messages to stderr by default. */
9368   guestfs_set_error_handler (g, NULL, NULL);
9369
9370   /* Wrap it, and make sure the close function is called when the
9371    * handle goes away.
9372    */
9373   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9374 }
9375
9376 static VALUE ruby_guestfs_close (VALUE gv)
9377 {
9378   guestfs_h *g;
9379   Data_Get_Struct (gv, guestfs_h, g);
9380
9381   ruby_guestfs_free (g);
9382   DATA_PTR (gv) = NULL;
9383
9384   return Qnil;
9385 }
9386
9387 ";
9388
9389   List.iter (
9390     fun (name, style, _, _, _, _, _) ->
9391       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9392       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9393       pr ")\n";
9394       pr "{\n";
9395       pr "  guestfs_h *g;\n";
9396       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9397       pr "  if (!g)\n";
9398       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9399         name;
9400       pr "\n";
9401
9402       List.iter (
9403         function
9404         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9405             pr "  Check_Type (%sv, T_STRING);\n" n;
9406             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9407             pr "  if (!%s)\n" n;
9408             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9409             pr "              \"%s\", \"%s\");\n" n name
9410         | OptString n ->
9411             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9412         | StringList n | DeviceList n ->
9413             pr "  char **%s;\n" n;
9414             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9415             pr "  {\n";
9416             pr "    size_t i, len;\n";
9417             pr "    len = RARRAY_LEN (%sv);\n" n;
9418             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9419               n;
9420             pr "    for (i = 0; i < len; ++i) {\n";
9421             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9422             pr "      %s[i] = StringValueCStr (v);\n" n;
9423             pr "    }\n";
9424             pr "    %s[len] = NULL;\n" n;
9425             pr "  }\n";
9426         | Bool n ->
9427             pr "  int %s = RTEST (%sv);\n" n n
9428         | Int n ->
9429             pr "  int %s = NUM2INT (%sv);\n" n n
9430         | Int64 n ->
9431             pr "  long long %s = NUM2LL (%sv);\n" n n
9432       ) (snd style);
9433       pr "\n";
9434
9435       let error_code =
9436         match fst style with
9437         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9438         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9439         | RConstString _ | RConstOptString _ ->
9440             pr "  const char *r;\n"; "NULL"
9441         | RString _ -> pr "  char *r;\n"; "NULL"
9442         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9443         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9444         | RStructList (_, typ) ->
9445             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9446         | RBufferOut _ ->
9447             pr "  char *r;\n";
9448             pr "  size_t size;\n";
9449             "NULL" in
9450       pr "\n";
9451
9452       pr "  r = guestfs_%s " name;
9453       generate_c_call_args ~handle:"g" style;
9454       pr ";\n";
9455
9456       List.iter (
9457         function
9458         | Pathname _ | Device _ | Dev_or_Path _ | String _
9459         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9460         | StringList n | DeviceList n ->
9461             pr "  free (%s);\n" n
9462       ) (snd style);
9463
9464       pr "  if (r == %s)\n" error_code;
9465       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9466       pr "\n";
9467
9468       (match fst style with
9469        | RErr ->
9470            pr "  return Qnil;\n"
9471        | RInt _ | RBool _ ->
9472            pr "  return INT2NUM (r);\n"
9473        | RInt64 _ ->
9474            pr "  return ULL2NUM (r);\n"
9475        | RConstString _ ->
9476            pr "  return rb_str_new2 (r);\n";
9477        | RConstOptString _ ->
9478            pr "  if (r)\n";
9479            pr "    return rb_str_new2 (r);\n";
9480            pr "  else\n";
9481            pr "    return Qnil;\n";
9482        | RString _ ->
9483            pr "  VALUE rv = rb_str_new2 (r);\n";
9484            pr "  free (r);\n";
9485            pr "  return rv;\n";
9486        | RStringList _ ->
9487            pr "  size_t i, len = 0;\n";
9488            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9489            pr "  VALUE rv = rb_ary_new2 (len);\n";
9490            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9491            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9492            pr "    free (r[i]);\n";
9493            pr "  }\n";
9494            pr "  free (r);\n";
9495            pr "  return rv;\n"
9496        | RStruct (_, typ) ->
9497            let cols = cols_of_struct typ in
9498            generate_ruby_struct_code typ cols
9499        | RStructList (_, typ) ->
9500            let cols = cols_of_struct typ in
9501            generate_ruby_struct_list_code typ cols
9502        | RHashtable _ ->
9503            pr "  VALUE rv = rb_hash_new ();\n";
9504            pr "  size_t i;\n";
9505            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9506            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9507            pr "    free (r[i]);\n";
9508            pr "    free (r[i+1]);\n";
9509            pr "  }\n";
9510            pr "  free (r);\n";
9511            pr "  return rv;\n"
9512        | RBufferOut _ ->
9513            pr "  VALUE rv = rb_str_new (r, size);\n";
9514            pr "  free (r);\n";
9515            pr "  return rv;\n";
9516       );
9517
9518       pr "}\n";
9519       pr "\n"
9520   ) all_functions;
9521
9522   pr "\
9523 /* Initialize the module. */
9524 void Init__guestfs ()
9525 {
9526   m_guestfs = rb_define_module (\"Guestfs\");
9527   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9528   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9529
9530   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9531   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9532
9533 ";
9534   (* Define the rest of the methods. *)
9535   List.iter (
9536     fun (name, style, _, _, _, _, _) ->
9537       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9538       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9539   ) all_functions;
9540
9541   pr "}\n"
9542
9543 (* Ruby code to return a struct. *)
9544 and generate_ruby_struct_code typ cols =
9545   pr "  VALUE rv = rb_hash_new ();\n";
9546   List.iter (
9547     function
9548     | name, FString ->
9549         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9550     | name, FBuffer ->
9551         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9552     | name, FUUID ->
9553         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9554     | name, (FBytes|FUInt64) ->
9555         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9556     | name, FInt64 ->
9557         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9558     | name, FUInt32 ->
9559         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9560     | name, FInt32 ->
9561         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9562     | name, FOptPercent ->
9563         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9564     | name, FChar -> (* XXX wrong? *)
9565         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9566   ) cols;
9567   pr "  guestfs_free_%s (r);\n" typ;
9568   pr "  return rv;\n"
9569
9570 (* Ruby code to return a struct list. *)
9571 and generate_ruby_struct_list_code typ cols =
9572   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9573   pr "  size_t i;\n";
9574   pr "  for (i = 0; i < r->len; ++i) {\n";
9575   pr "    VALUE hv = rb_hash_new ();\n";
9576   List.iter (
9577     function
9578     | name, FString ->
9579         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9580     | name, FBuffer ->
9581         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
9582     | name, FUUID ->
9583         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9584     | name, (FBytes|FUInt64) ->
9585         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9586     | name, FInt64 ->
9587         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9588     | name, FUInt32 ->
9589         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9590     | name, FInt32 ->
9591         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9592     | name, FOptPercent ->
9593         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9594     | name, FChar -> (* XXX wrong? *)
9595         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9596   ) cols;
9597   pr "    rb_ary_push (rv, hv);\n";
9598   pr "  }\n";
9599   pr "  guestfs_free_%s_list (r);\n" typ;
9600   pr "  return rv;\n"
9601
9602 (* Generate Java bindings GuestFS.java file. *)
9603 and generate_java_java () =
9604   generate_header CStyle LGPLv2plus;
9605
9606   pr "\
9607 package com.redhat.et.libguestfs;
9608
9609 import java.util.HashMap;
9610 import com.redhat.et.libguestfs.LibGuestFSException;
9611 import com.redhat.et.libguestfs.PV;
9612 import com.redhat.et.libguestfs.VG;
9613 import com.redhat.et.libguestfs.LV;
9614 import com.redhat.et.libguestfs.Stat;
9615 import com.redhat.et.libguestfs.StatVFS;
9616 import com.redhat.et.libguestfs.IntBool;
9617 import com.redhat.et.libguestfs.Dirent;
9618
9619 /**
9620  * The GuestFS object is a libguestfs handle.
9621  *
9622  * @author rjones
9623  */
9624 public class GuestFS {
9625   // Load the native code.
9626   static {
9627     System.loadLibrary (\"guestfs_jni\");
9628   }
9629
9630   /**
9631    * The native guestfs_h pointer.
9632    */
9633   long g;
9634
9635   /**
9636    * Create a libguestfs handle.
9637    *
9638    * @throws LibGuestFSException
9639    */
9640   public GuestFS () throws LibGuestFSException
9641   {
9642     g = _create ();
9643   }
9644   private native long _create () throws LibGuestFSException;
9645
9646   /**
9647    * Close a libguestfs handle.
9648    *
9649    * You can also leave handles to be collected by the garbage
9650    * collector, but this method ensures that the resources used
9651    * by the handle are freed up immediately.  If you call any
9652    * other methods after closing the handle, you will get an
9653    * exception.
9654    *
9655    * @throws LibGuestFSException
9656    */
9657   public void close () throws LibGuestFSException
9658   {
9659     if (g != 0)
9660       _close (g);
9661     g = 0;
9662   }
9663   private native void _close (long g) throws LibGuestFSException;
9664
9665   public void finalize () throws LibGuestFSException
9666   {
9667     close ();
9668   }
9669
9670 ";
9671
9672   List.iter (
9673     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9674       if not (List.mem NotInDocs flags); then (
9675         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9676         let doc =
9677           if List.mem ProtocolLimitWarning flags then
9678             doc ^ "\n\n" ^ protocol_limit_warning
9679           else doc in
9680         let doc =
9681           if List.mem DangerWillRobinson flags then
9682             doc ^ "\n\n" ^ danger_will_robinson
9683           else doc in
9684         let doc =
9685           match deprecation_notice flags with
9686           | None -> doc
9687           | Some txt -> doc ^ "\n\n" ^ txt in
9688         let doc = pod2text ~width:60 name doc in
9689         let doc = List.map (            (* RHBZ#501883 *)
9690           function
9691           | "" -> "<p>"
9692           | nonempty -> nonempty
9693         ) doc in
9694         let doc = String.concat "\n   * " doc in
9695
9696         pr "  /**\n";
9697         pr "   * %s\n" shortdesc;
9698         pr "   * <p>\n";
9699         pr "   * %s\n" doc;
9700         pr "   * @throws LibGuestFSException\n";
9701         pr "   */\n";
9702         pr "  ";
9703       );
9704       generate_java_prototype ~public:true ~semicolon:false name style;
9705       pr "\n";
9706       pr "  {\n";
9707       pr "    if (g == 0)\n";
9708       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9709         name;
9710       pr "    ";
9711       if fst style <> RErr then pr "return ";
9712       pr "_%s " name;
9713       generate_java_call_args ~handle:"g" (snd style);
9714       pr ";\n";
9715       pr "  }\n";
9716       pr "  ";
9717       generate_java_prototype ~privat:true ~native:true name style;
9718       pr "\n";
9719       pr "\n";
9720   ) all_functions;
9721
9722   pr "}\n"
9723
9724 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9725 and generate_java_call_args ~handle args =
9726   pr "(%s" handle;
9727   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9728   pr ")"
9729
9730 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9731     ?(semicolon=true) name style =
9732   if privat then pr "private ";
9733   if public then pr "public ";
9734   if native then pr "native ";
9735
9736   (* return type *)
9737   (match fst style with
9738    | RErr -> pr "void ";
9739    | RInt _ -> pr "int ";
9740    | RInt64 _ -> pr "long ";
9741    | RBool _ -> pr "boolean ";
9742    | RConstString _ | RConstOptString _ | RString _
9743    | RBufferOut _ -> pr "String ";
9744    | RStringList _ -> pr "String[] ";
9745    | RStruct (_, typ) ->
9746        let name = java_name_of_struct typ in
9747        pr "%s " name;
9748    | RStructList (_, typ) ->
9749        let name = java_name_of_struct typ in
9750        pr "%s[] " name;
9751    | RHashtable _ -> pr "HashMap<String,String> ";
9752   );
9753
9754   if native then pr "_%s " name else pr "%s " name;
9755   pr "(";
9756   let needs_comma = ref false in
9757   if native then (
9758     pr "long g";
9759     needs_comma := true
9760   );
9761
9762   (* args *)
9763   List.iter (
9764     fun arg ->
9765       if !needs_comma then pr ", ";
9766       needs_comma := true;
9767
9768       match arg with
9769       | Pathname n
9770       | Device n | Dev_or_Path n
9771       | String n
9772       | OptString n
9773       | FileIn n
9774       | FileOut n ->
9775           pr "String %s" n
9776       | StringList n | DeviceList n ->
9777           pr "String[] %s" n
9778       | Bool n ->
9779           pr "boolean %s" n
9780       | Int n ->
9781           pr "int %s" n
9782       | Int64 n ->
9783           pr "long %s" n
9784   ) (snd style);
9785
9786   pr ")\n";
9787   pr "    throws LibGuestFSException";
9788   if semicolon then pr ";"
9789
9790 and generate_java_struct jtyp cols () =
9791   generate_header CStyle LGPLv2plus;
9792
9793   pr "\
9794 package com.redhat.et.libguestfs;
9795
9796 /**
9797  * Libguestfs %s structure.
9798  *
9799  * @author rjones
9800  * @see GuestFS
9801  */
9802 public class %s {
9803 " jtyp jtyp;
9804
9805   List.iter (
9806     function
9807     | name, FString
9808     | name, FUUID
9809     | name, FBuffer -> pr "  public String %s;\n" name
9810     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9811     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9812     | name, FChar -> pr "  public char %s;\n" name
9813     | name, FOptPercent ->
9814         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9815         pr "  public float %s;\n" name
9816   ) cols;
9817
9818   pr "}\n"
9819
9820 and generate_java_c () =
9821   generate_header CStyle LGPLv2plus;
9822
9823   pr "\
9824 #include <stdio.h>
9825 #include <stdlib.h>
9826 #include <string.h>
9827
9828 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9829 #include \"guestfs.h\"
9830
9831 /* Note that this function returns.  The exception is not thrown
9832  * until after the wrapper function returns.
9833  */
9834 static void
9835 throw_exception (JNIEnv *env, const char *msg)
9836 {
9837   jclass cl;
9838   cl = (*env)->FindClass (env,
9839                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9840   (*env)->ThrowNew (env, cl, msg);
9841 }
9842
9843 JNIEXPORT jlong JNICALL
9844 Java_com_redhat_et_libguestfs_GuestFS__1create
9845   (JNIEnv *env, jobject obj)
9846 {
9847   guestfs_h *g;
9848
9849   g = guestfs_create ();
9850   if (g == NULL) {
9851     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9852     return 0;
9853   }
9854   guestfs_set_error_handler (g, NULL, NULL);
9855   return (jlong) (long) g;
9856 }
9857
9858 JNIEXPORT void JNICALL
9859 Java_com_redhat_et_libguestfs_GuestFS__1close
9860   (JNIEnv *env, jobject obj, jlong jg)
9861 {
9862   guestfs_h *g = (guestfs_h *) (long) jg;
9863   guestfs_close (g);
9864 }
9865
9866 ";
9867
9868   List.iter (
9869     fun (name, style, _, _, _, _, _) ->
9870       pr "JNIEXPORT ";
9871       (match fst style with
9872        | RErr -> pr "void ";
9873        | RInt _ -> pr "jint ";
9874        | RInt64 _ -> pr "jlong ";
9875        | RBool _ -> pr "jboolean ";
9876        | RConstString _ | RConstOptString _ | RString _
9877        | RBufferOut _ -> pr "jstring ";
9878        | RStruct _ | RHashtable _ ->
9879            pr "jobject ";
9880        | RStringList _ | RStructList _ ->
9881            pr "jobjectArray ";
9882       );
9883       pr "JNICALL\n";
9884       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9885       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9886       pr "\n";
9887       pr "  (JNIEnv *env, jobject obj, jlong jg";
9888       List.iter (
9889         function
9890         | Pathname n
9891         | Device n | Dev_or_Path n
9892         | String n
9893         | OptString n
9894         | FileIn n
9895         | FileOut n ->
9896             pr ", jstring j%s" n
9897         | StringList n | DeviceList n ->
9898             pr ", jobjectArray j%s" n
9899         | Bool n ->
9900             pr ", jboolean j%s" n
9901         | Int n ->
9902             pr ", jint j%s" n
9903         | Int64 n ->
9904             pr ", jlong j%s" n
9905       ) (snd style);
9906       pr ")\n";
9907       pr "{\n";
9908       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9909       let error_code, no_ret =
9910         match fst style with
9911         | RErr -> pr "  int r;\n"; "-1", ""
9912         | RBool _
9913         | RInt _ -> pr "  int r;\n"; "-1", "0"
9914         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9915         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9916         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9917         | RString _ ->
9918             pr "  jstring jr;\n";
9919             pr "  char *r;\n"; "NULL", "NULL"
9920         | RStringList _ ->
9921             pr "  jobjectArray jr;\n";
9922             pr "  int r_len;\n";
9923             pr "  jclass cl;\n";
9924             pr "  jstring jstr;\n";
9925             pr "  char **r;\n"; "NULL", "NULL"
9926         | RStruct (_, typ) ->
9927             pr "  jobject jr;\n";
9928             pr "  jclass cl;\n";
9929             pr "  jfieldID fl;\n";
9930             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9931         | RStructList (_, typ) ->
9932             pr "  jobjectArray jr;\n";
9933             pr "  jclass cl;\n";
9934             pr "  jfieldID fl;\n";
9935             pr "  jobject jfl;\n";
9936             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9937         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9938         | RBufferOut _ ->
9939             pr "  jstring jr;\n";
9940             pr "  char *r;\n";
9941             pr "  size_t size;\n";
9942             "NULL", "NULL" in
9943       List.iter (
9944         function
9945         | Pathname n
9946         | Device n | Dev_or_Path n
9947         | String n
9948         | OptString n
9949         | FileIn n
9950         | FileOut n ->
9951             pr "  const char *%s;\n" n
9952         | StringList n | DeviceList n ->
9953             pr "  int %s_len;\n" n;
9954             pr "  const char **%s;\n" n
9955         | Bool n
9956         | Int n ->
9957             pr "  int %s;\n" n
9958         | Int64 n ->
9959             pr "  int64_t %s;\n" n
9960       ) (snd style);
9961
9962       let needs_i =
9963         (match fst style with
9964          | RStringList _ | RStructList _ -> true
9965          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9966          | RConstOptString _
9967          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9968           List.exists (function
9969                        | StringList _ -> true
9970                        | DeviceList _ -> true
9971                        | _ -> false) (snd style) in
9972       if needs_i then
9973         pr "  size_t i;\n";
9974
9975       pr "\n";
9976
9977       (* Get the parameters. *)
9978       List.iter (
9979         function
9980         | Pathname n
9981         | Device n | Dev_or_Path n
9982         | String n
9983         | FileIn n
9984         | FileOut n ->
9985             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9986         | OptString n ->
9987             (* This is completely undocumented, but Java null becomes
9988              * a NULL parameter.
9989              *)
9990             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9991         | StringList n | DeviceList n ->
9992             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9993             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9994             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9995             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9996               n;
9997             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9998             pr "  }\n";
9999             pr "  %s[%s_len] = NULL;\n" n n;
10000         | Bool n
10001         | Int n
10002         | Int64 n ->
10003             pr "  %s = j%s;\n" n n
10004       ) (snd style);
10005
10006       (* Make the call. *)
10007       pr "  r = guestfs_%s " name;
10008       generate_c_call_args ~handle:"g" style;
10009       pr ";\n";
10010
10011       (* Release the parameters. *)
10012       List.iter (
10013         function
10014         | Pathname n
10015         | Device n | Dev_or_Path n
10016         | String n
10017         | FileIn n
10018         | FileOut n ->
10019             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10020         | OptString n ->
10021             pr "  if (j%s)\n" n;
10022             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10023         | StringList n | DeviceList n ->
10024             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10025             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10026               n;
10027             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10028             pr "  }\n";
10029             pr "  free (%s);\n" n
10030         | Bool n
10031         | Int n
10032         | Int64 n -> ()
10033       ) (snd style);
10034
10035       (* Check for errors. *)
10036       pr "  if (r == %s) {\n" error_code;
10037       pr "    throw_exception (env, guestfs_last_error (g));\n";
10038       pr "    return %s;\n" no_ret;
10039       pr "  }\n";
10040
10041       (* Return value. *)
10042       (match fst style with
10043        | RErr -> ()
10044        | RInt _ -> pr "  return (jint) r;\n"
10045        | RBool _ -> pr "  return (jboolean) r;\n"
10046        | RInt64 _ -> pr "  return (jlong) r;\n"
10047        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10048        | RConstOptString _ ->
10049            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10050        | RString _ ->
10051            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10052            pr "  free (r);\n";
10053            pr "  return jr;\n"
10054        | RStringList _ ->
10055            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10056            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10057            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10058            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10059            pr "  for (i = 0; i < r_len; ++i) {\n";
10060            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10061            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10062            pr "    free (r[i]);\n";
10063            pr "  }\n";
10064            pr "  free (r);\n";
10065            pr "  return jr;\n"
10066        | RStruct (_, typ) ->
10067            let jtyp = java_name_of_struct typ in
10068            let cols = cols_of_struct typ in
10069            generate_java_struct_return typ jtyp cols
10070        | RStructList (_, typ) ->
10071            let jtyp = java_name_of_struct typ in
10072            let cols = cols_of_struct typ in
10073            generate_java_struct_list_return typ jtyp cols
10074        | RHashtable _ ->
10075            (* XXX *)
10076            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10077            pr "  return NULL;\n"
10078        | RBufferOut _ ->
10079            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10080            pr "  free (r);\n";
10081            pr "  return jr;\n"
10082       );
10083
10084       pr "}\n";
10085       pr "\n"
10086   ) all_functions
10087
10088 and generate_java_struct_return typ jtyp cols =
10089   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10090   pr "  jr = (*env)->AllocObject (env, cl);\n";
10091   List.iter (
10092     function
10093     | name, FString ->
10094         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10095         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10096     | name, FUUID ->
10097         pr "  {\n";
10098         pr "    char s[33];\n";
10099         pr "    memcpy (s, r->%s, 32);\n" name;
10100         pr "    s[32] = 0;\n";
10101         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10102         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10103         pr "  }\n";
10104     | name, FBuffer ->
10105         pr "  {\n";
10106         pr "    int len = r->%s_len;\n" name;
10107         pr "    char s[len+1];\n";
10108         pr "    memcpy (s, r->%s, len);\n" name;
10109         pr "    s[len] = 0;\n";
10110         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10111         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10112         pr "  }\n";
10113     | name, (FBytes|FUInt64|FInt64) ->
10114         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10115         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10116     | name, (FUInt32|FInt32) ->
10117         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10118         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10119     | name, FOptPercent ->
10120         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10121         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10122     | name, FChar ->
10123         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10124         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10125   ) cols;
10126   pr "  free (r);\n";
10127   pr "  return jr;\n"
10128
10129 and generate_java_struct_list_return typ jtyp cols =
10130   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10131   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10132   pr "  for (i = 0; i < r->len; ++i) {\n";
10133   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10134   List.iter (
10135     function
10136     | name, FString ->
10137         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10138         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10139     | name, FUUID ->
10140         pr "    {\n";
10141         pr "      char s[33];\n";
10142         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10143         pr "      s[32] = 0;\n";
10144         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10145         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10146         pr "    }\n";
10147     | name, FBuffer ->
10148         pr "    {\n";
10149         pr "      int len = r->val[i].%s_len;\n" name;
10150         pr "      char s[len+1];\n";
10151         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10152         pr "      s[len] = 0;\n";
10153         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10154         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10155         pr "    }\n";
10156     | name, (FBytes|FUInt64|FInt64) ->
10157         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10158         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10159     | name, (FUInt32|FInt32) ->
10160         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10161         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10162     | name, FOptPercent ->
10163         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10164         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10165     | name, FChar ->
10166         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10167         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10168   ) cols;
10169   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10170   pr "  }\n";
10171   pr "  guestfs_free_%s_list (r);\n" typ;
10172   pr "  return jr;\n"
10173
10174 and generate_java_makefile_inc () =
10175   generate_header HashStyle GPLv2plus;
10176
10177   pr "java_built_sources = \\\n";
10178   List.iter (
10179     fun (typ, jtyp) ->
10180         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10181   ) java_structs;
10182   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10183
10184 and generate_haskell_hs () =
10185   generate_header HaskellStyle LGPLv2plus;
10186
10187   (* XXX We only know how to generate partial FFI for Haskell
10188    * at the moment.  Please help out!
10189    *)
10190   let can_generate style =
10191     match style with
10192     | RErr, _
10193     | RInt _, _
10194     | RInt64 _, _ -> true
10195     | RBool _, _
10196     | RConstString _, _
10197     | RConstOptString _, _
10198     | RString _, _
10199     | RStringList _, _
10200     | RStruct _, _
10201     | RStructList _, _
10202     | RHashtable _, _
10203     | RBufferOut _, _ -> false in
10204
10205   pr "\
10206 {-# INCLUDE <guestfs.h> #-}
10207 {-# LANGUAGE ForeignFunctionInterface #-}
10208
10209 module Guestfs (
10210   create";
10211
10212   (* List out the names of the actions we want to export. *)
10213   List.iter (
10214     fun (name, style, _, _, _, _, _) ->
10215       if can_generate style then pr ",\n  %s" name
10216   ) all_functions;
10217
10218   pr "
10219   ) where
10220
10221 -- Unfortunately some symbols duplicate ones already present
10222 -- in Prelude.  We don't know which, so we hard-code a list
10223 -- here.
10224 import Prelude hiding (truncate)
10225
10226 import Foreign
10227 import Foreign.C
10228 import Foreign.C.Types
10229 import IO
10230 import Control.Exception
10231 import Data.Typeable
10232
10233 data GuestfsS = GuestfsS            -- represents the opaque C struct
10234 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10235 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10236
10237 -- XXX define properly later XXX
10238 data PV = PV
10239 data VG = VG
10240 data LV = LV
10241 data IntBool = IntBool
10242 data Stat = Stat
10243 data StatVFS = StatVFS
10244 data Hashtable = Hashtable
10245
10246 foreign import ccall unsafe \"guestfs_create\" c_create
10247   :: IO GuestfsP
10248 foreign import ccall unsafe \"&guestfs_close\" c_close
10249   :: FunPtr (GuestfsP -> IO ())
10250 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10251   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10252
10253 create :: IO GuestfsH
10254 create = do
10255   p <- c_create
10256   c_set_error_handler p nullPtr nullPtr
10257   h <- newForeignPtr c_close p
10258   return h
10259
10260 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10261   :: GuestfsP -> IO CString
10262
10263 -- last_error :: GuestfsH -> IO (Maybe String)
10264 -- last_error h = do
10265 --   str <- withForeignPtr h (\\p -> c_last_error p)
10266 --   maybePeek peekCString str
10267
10268 last_error :: GuestfsH -> IO (String)
10269 last_error h = do
10270   str <- withForeignPtr h (\\p -> c_last_error p)
10271   if (str == nullPtr)
10272     then return \"no error\"
10273     else peekCString str
10274
10275 ";
10276
10277   (* Generate wrappers for each foreign function. *)
10278   List.iter (
10279     fun (name, style, _, _, _, _, _) ->
10280       if can_generate style then (
10281         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10282         pr "  :: ";
10283         generate_haskell_prototype ~handle:"GuestfsP" style;
10284         pr "\n";
10285         pr "\n";
10286         pr "%s :: " name;
10287         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10288         pr "\n";
10289         pr "%s %s = do\n" name
10290           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10291         pr "  r <- ";
10292         (* Convert pointer arguments using with* functions. *)
10293         List.iter (
10294           function
10295           | FileIn n
10296           | FileOut n
10297           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10298           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10299           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10300           | Bool _ | Int _ | Int64 _ -> ()
10301         ) (snd style);
10302         (* Convert integer arguments. *)
10303         let args =
10304           List.map (
10305             function
10306             | Bool n -> sprintf "(fromBool %s)" n
10307             | Int n -> sprintf "(fromIntegral %s)" n
10308             | Int64 n -> sprintf "(fromIntegral %s)" n
10309             | FileIn n | FileOut n
10310             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10311           ) (snd style) in
10312         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10313           (String.concat " " ("p" :: args));
10314         (match fst style with
10315          | RErr | RInt _ | RInt64 _ | RBool _ ->
10316              pr "  if (r == -1)\n";
10317              pr "    then do\n";
10318              pr "      err <- last_error h\n";
10319              pr "      fail err\n";
10320          | RConstString _ | RConstOptString _ | RString _
10321          | RStringList _ | RStruct _
10322          | RStructList _ | RHashtable _ | RBufferOut _ ->
10323              pr "  if (r == nullPtr)\n";
10324              pr "    then do\n";
10325              pr "      err <- last_error h\n";
10326              pr "      fail err\n";
10327         );
10328         (match fst style with
10329          | RErr ->
10330              pr "    else return ()\n"
10331          | RInt _ ->
10332              pr "    else return (fromIntegral r)\n"
10333          | RInt64 _ ->
10334              pr "    else return (fromIntegral r)\n"
10335          | RBool _ ->
10336              pr "    else return (toBool r)\n"
10337          | RConstString _
10338          | RConstOptString _
10339          | RString _
10340          | RStringList _
10341          | RStruct _
10342          | RStructList _
10343          | RHashtable _
10344          | RBufferOut _ ->
10345              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10346         );
10347         pr "\n";
10348       )
10349   ) all_functions
10350
10351 and generate_haskell_prototype ~handle ?(hs = false) style =
10352   pr "%s -> " handle;
10353   let string = if hs then "String" else "CString" in
10354   let int = if hs then "Int" else "CInt" in
10355   let bool = if hs then "Bool" else "CInt" in
10356   let int64 = if hs then "Integer" else "Int64" in
10357   List.iter (
10358     fun arg ->
10359       (match arg with
10360        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10361        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10362        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10363        | Bool _ -> pr "%s" bool
10364        | Int _ -> pr "%s" int
10365        | Int64 _ -> pr "%s" int
10366        | FileIn _ -> pr "%s" string
10367        | FileOut _ -> pr "%s" string
10368       );
10369       pr " -> ";
10370   ) (snd style);
10371   pr "IO (";
10372   (match fst style with
10373    | RErr -> if not hs then pr "CInt"
10374    | RInt _ -> pr "%s" int
10375    | RInt64 _ -> pr "%s" int64
10376    | RBool _ -> pr "%s" bool
10377    | RConstString _ -> pr "%s" string
10378    | RConstOptString _ -> pr "Maybe %s" string
10379    | RString _ -> pr "%s" string
10380    | RStringList _ -> pr "[%s]" string
10381    | RStruct (_, typ) ->
10382        let name = java_name_of_struct typ in
10383        pr "%s" name
10384    | RStructList (_, typ) ->
10385        let name = java_name_of_struct typ in
10386        pr "[%s]" name
10387    | RHashtable _ -> pr "Hashtable"
10388    | RBufferOut _ -> pr "%s" string
10389   );
10390   pr ")"
10391
10392 and generate_csharp () =
10393   generate_header CPlusPlusStyle LGPLv2plus;
10394
10395   (* XXX Make this configurable by the C# assembly users. *)
10396   let library = "libguestfs.so.0" in
10397
10398   pr "\
10399 // These C# bindings are highly experimental at present.
10400 //
10401 // Firstly they only work on Linux (ie. Mono).  In order to get them
10402 // to work on Windows (ie. .Net) you would need to port the library
10403 // itself to Windows first.
10404 //
10405 // The second issue is that some calls are known to be incorrect and
10406 // can cause Mono to segfault.  Particularly: calls which pass or
10407 // return string[], or return any structure value.  This is because
10408 // we haven't worked out the correct way to do this from C#.
10409 //
10410 // The third issue is that when compiling you get a lot of warnings.
10411 // We are not sure whether the warnings are important or not.
10412 //
10413 // Fourthly we do not routinely build or test these bindings as part
10414 // of the make && make check cycle, which means that regressions might
10415 // go unnoticed.
10416 //
10417 // Suggestions and patches are welcome.
10418
10419 // To compile:
10420 //
10421 // gmcs Libguestfs.cs
10422 // mono Libguestfs.exe
10423 //
10424 // (You'll probably want to add a Test class / static main function
10425 // otherwise this won't do anything useful).
10426
10427 using System;
10428 using System.IO;
10429 using System.Runtime.InteropServices;
10430 using System.Runtime.Serialization;
10431 using System.Collections;
10432
10433 namespace Guestfs
10434 {
10435   class Error : System.ApplicationException
10436   {
10437     public Error (string message) : base (message) {}
10438     protected Error (SerializationInfo info, StreamingContext context) {}
10439   }
10440
10441   class Guestfs
10442   {
10443     IntPtr _handle;
10444
10445     [DllImport (\"%s\")]
10446     static extern IntPtr guestfs_create ();
10447
10448     public Guestfs ()
10449     {
10450       _handle = guestfs_create ();
10451       if (_handle == IntPtr.Zero)
10452         throw new Error (\"could not create guestfs handle\");
10453     }
10454
10455     [DllImport (\"%s\")]
10456     static extern void guestfs_close (IntPtr h);
10457
10458     ~Guestfs ()
10459     {
10460       guestfs_close (_handle);
10461     }
10462
10463     [DllImport (\"%s\")]
10464     static extern string guestfs_last_error (IntPtr h);
10465
10466 " library library library;
10467
10468   (* Generate C# structure bindings.  We prefix struct names with
10469    * underscore because C# cannot have conflicting struct names and
10470    * method names (eg. "class stat" and "stat").
10471    *)
10472   List.iter (
10473     fun (typ, cols) ->
10474       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10475       pr "    public class _%s {\n" typ;
10476       List.iter (
10477         function
10478         | name, FChar -> pr "      char %s;\n" name
10479         | name, FString -> pr "      string %s;\n" name
10480         | name, FBuffer ->
10481             pr "      uint %s_len;\n" name;
10482             pr "      string %s;\n" name
10483         | name, FUUID ->
10484             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10485             pr "      string %s;\n" name
10486         | name, FUInt32 -> pr "      uint %s;\n" name
10487         | name, FInt32 -> pr "      int %s;\n" name
10488         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10489         | name, FInt64 -> pr "      long %s;\n" name
10490         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10491       ) cols;
10492       pr "    }\n";
10493       pr "\n"
10494   ) structs;
10495
10496   (* Generate C# function bindings. *)
10497   List.iter (
10498     fun (name, style, _, _, _, shortdesc, _) ->
10499       let rec csharp_return_type () =
10500         match fst style with
10501         | RErr -> "void"
10502         | RBool n -> "bool"
10503         | RInt n -> "int"
10504         | RInt64 n -> "long"
10505         | RConstString n
10506         | RConstOptString n
10507         | RString n
10508         | RBufferOut n -> "string"
10509         | RStruct (_,n) -> "_" ^ n
10510         | RHashtable n -> "Hashtable"
10511         | RStringList n -> "string[]"
10512         | RStructList (_,n) -> sprintf "_%s[]" n
10513
10514       and c_return_type () =
10515         match fst style with
10516         | RErr
10517         | RBool _
10518         | RInt _ -> "int"
10519         | RInt64 _ -> "long"
10520         | RConstString _
10521         | RConstOptString _
10522         | RString _
10523         | RBufferOut _ -> "string"
10524         | RStruct (_,n) -> "_" ^ n
10525         | RHashtable _
10526         | RStringList _ -> "string[]"
10527         | RStructList (_,n) -> sprintf "_%s[]" n
10528
10529       and c_error_comparison () =
10530         match fst style with
10531         | RErr
10532         | RBool _
10533         | RInt _
10534         | RInt64 _ -> "== -1"
10535         | RConstString _
10536         | RConstOptString _
10537         | RString _
10538         | RBufferOut _
10539         | RStruct (_,_)
10540         | RHashtable _
10541         | RStringList _
10542         | RStructList (_,_) -> "== null"
10543
10544       and generate_extern_prototype () =
10545         pr "    static extern %s guestfs_%s (IntPtr h"
10546           (c_return_type ()) name;
10547         List.iter (
10548           function
10549           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10550           | FileIn n | FileOut n ->
10551               pr ", [In] string %s" n
10552           | StringList n | DeviceList n ->
10553               pr ", [In] string[] %s" n
10554           | Bool n ->
10555               pr ", bool %s" n
10556           | Int n ->
10557               pr ", int %s" n
10558           | Int64 n ->
10559               pr ", long %s" n
10560         ) (snd style);
10561         pr ");\n"
10562
10563       and generate_public_prototype () =
10564         pr "    public %s %s (" (csharp_return_type ()) name;
10565         let comma = ref false in
10566         let next () =
10567           if !comma then pr ", ";
10568           comma := true
10569         in
10570         List.iter (
10571           function
10572           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10573           | FileIn n | FileOut n ->
10574               next (); pr "string %s" n
10575           | StringList n | DeviceList n ->
10576               next (); pr "string[] %s" n
10577           | Bool n ->
10578               next (); pr "bool %s" n
10579           | Int n ->
10580               next (); pr "int %s" n
10581           | Int64 n ->
10582               next (); pr "long %s" n
10583         ) (snd style);
10584         pr ")\n"
10585
10586       and generate_call () =
10587         pr "guestfs_%s (_handle" name;
10588         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10589         pr ");\n";
10590       in
10591
10592       pr "    [DllImport (\"%s\")]\n" library;
10593       generate_extern_prototype ();
10594       pr "\n";
10595       pr "    /// <summary>\n";
10596       pr "    /// %s\n" shortdesc;
10597       pr "    /// </summary>\n";
10598       generate_public_prototype ();
10599       pr "    {\n";
10600       pr "      %s r;\n" (c_return_type ());
10601       pr "      r = ";
10602       generate_call ();
10603       pr "      if (r %s)\n" (c_error_comparison ());
10604       pr "        throw new Error (guestfs_last_error (_handle));\n";
10605       (match fst style with
10606        | RErr -> ()
10607        | RBool _ ->
10608            pr "      return r != 0 ? true : false;\n"
10609        | RHashtable _ ->
10610            pr "      Hashtable rr = new Hashtable ();\n";
10611            pr "      for (size_t i = 0; i < r.Length; i += 2)\n";
10612            pr "        rr.Add (r[i], r[i+1]);\n";
10613            pr "      return rr;\n"
10614        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10615        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10616        | RStructList _ ->
10617            pr "      return r;\n"
10618       );
10619       pr "    }\n";
10620       pr "\n";
10621   ) all_functions_sorted;
10622
10623   pr "  }
10624 }
10625 "
10626
10627 and generate_bindtests () =
10628   generate_header CStyle LGPLv2plus;
10629
10630   pr "\
10631 #include <stdio.h>
10632 #include <stdlib.h>
10633 #include <inttypes.h>
10634 #include <string.h>
10635
10636 #include \"guestfs.h\"
10637 #include \"guestfs-internal.h\"
10638 #include \"guestfs-internal-actions.h\"
10639 #include \"guestfs_protocol.h\"
10640
10641 #define error guestfs_error
10642 #define safe_calloc guestfs_safe_calloc
10643 #define safe_malloc guestfs_safe_malloc
10644
10645 static void
10646 print_strings (char *const *argv)
10647 {
10648   size_t argc;
10649
10650   printf (\"[\");
10651   for (argc = 0; argv[argc] != NULL; ++argc) {
10652     if (argc > 0) printf (\", \");
10653     printf (\"\\\"%%s\\\"\", argv[argc]);
10654   }
10655   printf (\"]\\n\");
10656 }
10657
10658 /* The test0 function prints its parameters to stdout. */
10659 ";
10660
10661   let test0, tests =
10662     match test_functions with
10663     | [] -> assert false
10664     | test0 :: tests -> test0, tests in
10665
10666   let () =
10667     let (name, style, _, _, _, _, _) = test0 in
10668     generate_prototype ~extern:false ~semicolon:false ~newline:true
10669       ~handle:"g" ~prefix:"guestfs__" name style;
10670     pr "{\n";
10671     List.iter (
10672       function
10673       | Pathname n
10674       | Device n | Dev_or_Path n
10675       | String n
10676       | FileIn n
10677       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10678       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10679       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10680       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10681       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10682       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10683     ) (snd style);
10684     pr "  /* Java changes stdout line buffering so we need this: */\n";
10685     pr "  fflush (stdout);\n";
10686     pr "  return 0;\n";
10687     pr "}\n";
10688     pr "\n" in
10689
10690   List.iter (
10691     fun (name, style, _, _, _, _, _) ->
10692       if String.sub name (String.length name - 3) 3 <> "err" then (
10693         pr "/* Test normal return. */\n";
10694         generate_prototype ~extern:false ~semicolon:false ~newline:true
10695           ~handle:"g" ~prefix:"guestfs__" name style;
10696         pr "{\n";
10697         (match fst style with
10698          | RErr ->
10699              pr "  return 0;\n"
10700          | RInt _ ->
10701              pr "  int r;\n";
10702              pr "  sscanf (val, \"%%d\", &r);\n";
10703              pr "  return r;\n"
10704          | RInt64 _ ->
10705              pr "  int64_t r;\n";
10706              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10707              pr "  return r;\n"
10708          | RBool _ ->
10709              pr "  return STREQ (val, \"true\");\n"
10710          | RConstString _
10711          | RConstOptString _ ->
10712              (* Can't return the input string here.  Return a static
10713               * string so we ensure we get a segfault if the caller
10714               * tries to free it.
10715               *)
10716              pr "  return \"static string\";\n"
10717          | RString _ ->
10718              pr "  return strdup (val);\n"
10719          | RStringList _ ->
10720              pr "  char **strs;\n";
10721              pr "  int n, i;\n";
10722              pr "  sscanf (val, \"%%d\", &n);\n";
10723              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10724              pr "  for (i = 0; i < n; ++i) {\n";
10725              pr "    strs[i] = safe_malloc (g, 16);\n";
10726              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10727              pr "  }\n";
10728              pr "  strs[n] = NULL;\n";
10729              pr "  return strs;\n"
10730          | RStruct (_, typ) ->
10731              pr "  struct guestfs_%s *r;\n" typ;
10732              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10733              pr "  return r;\n"
10734          | RStructList (_, typ) ->
10735              pr "  struct guestfs_%s_list *r;\n" typ;
10736              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10737              pr "  sscanf (val, \"%%d\", &r->len);\n";
10738              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10739              pr "  return r;\n"
10740          | RHashtable _ ->
10741              pr "  char **strs;\n";
10742              pr "  int n, i;\n";
10743              pr "  sscanf (val, \"%%d\", &n);\n";
10744              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10745              pr "  for (i = 0; i < n; ++i) {\n";
10746              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10747              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10748              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10749              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10750              pr "  }\n";
10751              pr "  strs[n*2] = NULL;\n";
10752              pr "  return strs;\n"
10753          | RBufferOut _ ->
10754              pr "  return strdup (val);\n"
10755         );
10756         pr "}\n";
10757         pr "\n"
10758       ) else (
10759         pr "/* Test error return. */\n";
10760         generate_prototype ~extern:false ~semicolon:false ~newline:true
10761           ~handle:"g" ~prefix:"guestfs__" name style;
10762         pr "{\n";
10763         pr "  error (g, \"error\");\n";
10764         (match fst style with
10765          | RErr | RInt _ | RInt64 _ | RBool _ ->
10766              pr "  return -1;\n"
10767          | RConstString _ | RConstOptString _
10768          | RString _ | RStringList _ | RStruct _
10769          | RStructList _
10770          | RHashtable _
10771          | RBufferOut _ ->
10772              pr "  return NULL;\n"
10773         );
10774         pr "}\n";
10775         pr "\n"
10776       )
10777   ) tests
10778
10779 and generate_ocaml_bindtests () =
10780   generate_header OCamlStyle GPLv2plus;
10781
10782   pr "\
10783 let () =
10784   let g = Guestfs.create () in
10785 ";
10786
10787   let mkargs args =
10788     String.concat " " (
10789       List.map (
10790         function
10791         | CallString s -> "\"" ^ s ^ "\""
10792         | CallOptString None -> "None"
10793         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10794         | CallStringList xs ->
10795             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10796         | CallInt i when i >= 0 -> string_of_int i
10797         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10798         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10799         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10800         | CallBool b -> string_of_bool b
10801       ) args
10802     )
10803   in
10804
10805   generate_lang_bindtests (
10806     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10807   );
10808
10809   pr "print_endline \"EOF\"\n"
10810
10811 and generate_perl_bindtests () =
10812   pr "#!/usr/bin/perl -w\n";
10813   generate_header HashStyle GPLv2plus;
10814
10815   pr "\
10816 use strict;
10817
10818 use Sys::Guestfs;
10819
10820 my $g = Sys::Guestfs->new ();
10821 ";
10822
10823   let mkargs args =
10824     String.concat ", " (
10825       List.map (
10826         function
10827         | CallString s -> "\"" ^ s ^ "\""
10828         | CallOptString None -> "undef"
10829         | CallOptString (Some s) -> sprintf "\"%s\"" s
10830         | CallStringList xs ->
10831             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10832         | CallInt i -> string_of_int i
10833         | CallInt64 i -> Int64.to_string i
10834         | CallBool b -> if b then "1" else "0"
10835       ) args
10836     )
10837   in
10838
10839   generate_lang_bindtests (
10840     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10841   );
10842
10843   pr "print \"EOF\\n\"\n"
10844
10845 and generate_python_bindtests () =
10846   generate_header HashStyle GPLv2plus;
10847
10848   pr "\
10849 import guestfs
10850
10851 g = guestfs.GuestFS ()
10852 ";
10853
10854   let mkargs args =
10855     String.concat ", " (
10856       List.map (
10857         function
10858         | CallString s -> "\"" ^ s ^ "\""
10859         | CallOptString None -> "None"
10860         | CallOptString (Some s) -> sprintf "\"%s\"" s
10861         | CallStringList xs ->
10862             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10863         | CallInt i -> string_of_int i
10864         | CallInt64 i -> Int64.to_string i
10865         | CallBool b -> if b then "1" else "0"
10866       ) args
10867     )
10868   in
10869
10870   generate_lang_bindtests (
10871     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10872   );
10873
10874   pr "print \"EOF\"\n"
10875
10876 and generate_ruby_bindtests () =
10877   generate_header HashStyle GPLv2plus;
10878
10879   pr "\
10880 require 'guestfs'
10881
10882 g = Guestfs::create()
10883 ";
10884
10885   let mkargs args =
10886     String.concat ", " (
10887       List.map (
10888         function
10889         | CallString s -> "\"" ^ s ^ "\""
10890         | CallOptString None -> "nil"
10891         | CallOptString (Some s) -> sprintf "\"%s\"" s
10892         | CallStringList xs ->
10893             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10894         | CallInt i -> string_of_int i
10895         | CallInt64 i -> Int64.to_string i
10896         | CallBool b -> string_of_bool b
10897       ) args
10898     )
10899   in
10900
10901   generate_lang_bindtests (
10902     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10903   );
10904
10905   pr "print \"EOF\\n\"\n"
10906
10907 and generate_java_bindtests () =
10908   generate_header CStyle GPLv2plus;
10909
10910   pr "\
10911 import com.redhat.et.libguestfs.*;
10912
10913 public class Bindtests {
10914     public static void main (String[] argv)
10915     {
10916         try {
10917             GuestFS g = new GuestFS ();
10918 ";
10919
10920   let mkargs args =
10921     String.concat ", " (
10922       List.map (
10923         function
10924         | CallString s -> "\"" ^ s ^ "\""
10925         | CallOptString None -> "null"
10926         | CallOptString (Some s) -> sprintf "\"%s\"" s
10927         | CallStringList xs ->
10928             "new String[]{" ^
10929               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10930         | CallInt i -> string_of_int i
10931         | CallInt64 i -> Int64.to_string i
10932         | CallBool b -> string_of_bool b
10933       ) args
10934     )
10935   in
10936
10937   generate_lang_bindtests (
10938     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10939   );
10940
10941   pr "
10942             System.out.println (\"EOF\");
10943         }
10944         catch (Exception exn) {
10945             System.err.println (exn);
10946             System.exit (1);
10947         }
10948     }
10949 }
10950 "
10951
10952 and generate_haskell_bindtests () =
10953   generate_header HaskellStyle GPLv2plus;
10954
10955   pr "\
10956 module Bindtests where
10957 import qualified Guestfs
10958
10959 main = do
10960   g <- Guestfs.create
10961 ";
10962
10963   let mkargs args =
10964     String.concat " " (
10965       List.map (
10966         function
10967         | CallString s -> "\"" ^ s ^ "\""
10968         | CallOptString None -> "Nothing"
10969         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10970         | CallStringList xs ->
10971             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10972         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10973         | CallInt i -> string_of_int i
10974         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10975         | CallInt64 i -> Int64.to_string i
10976         | CallBool true -> "True"
10977         | CallBool false -> "False"
10978       ) args
10979     )
10980   in
10981
10982   generate_lang_bindtests (
10983     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10984   );
10985
10986   pr "  putStrLn \"EOF\"\n"
10987
10988 (* Language-independent bindings tests - we do it this way to
10989  * ensure there is parity in testing bindings across all languages.
10990  *)
10991 and generate_lang_bindtests call =
10992   call "test0" [CallString "abc"; CallOptString (Some "def");
10993                 CallStringList []; CallBool false;
10994                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10995   call "test0" [CallString "abc"; CallOptString None;
10996                 CallStringList []; CallBool false;
10997                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10998   call "test0" [CallString ""; CallOptString (Some "def");
10999                 CallStringList []; CallBool false;
11000                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11001   call "test0" [CallString ""; CallOptString (Some "");
11002                 CallStringList []; CallBool false;
11003                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11004   call "test0" [CallString "abc"; CallOptString (Some "def");
11005                 CallStringList ["1"]; CallBool false;
11006                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11007   call "test0" [CallString "abc"; CallOptString (Some "def");
11008                 CallStringList ["1"; "2"]; CallBool false;
11009                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11010   call "test0" [CallString "abc"; CallOptString (Some "def");
11011                 CallStringList ["1"]; CallBool true;
11012                 CallInt 0; CallInt64 0L; 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 1; CallInt64 1L; CallString "123"; CallString "456"];
11022   call "test0" [CallString "abc"; CallOptString (Some "def");
11023                 CallStringList ["1"]; CallBool false;
11024                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11025   call "test0" [CallString "abc"; CallOptString (Some "def");
11026                 CallStringList ["1"]; CallBool false;
11027                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11028   call "test0" [CallString "abc"; CallOptString (Some "def");
11029                 CallStringList ["1"]; CallBool false;
11030                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11031
11032 (* XXX Add here tests of the return and error functions. *)
11033
11034 (* Code to generator bindings for virt-inspector.  Currently only
11035  * implemented for OCaml code (for virt-p2v 2.0).
11036  *)
11037 let rng_input = "inspector/virt-inspector.rng"
11038
11039 (* Read the input file and parse it into internal structures.  This is
11040  * by no means a complete RELAX NG parser, but is just enough to be
11041  * able to parse the specific input file.
11042  *)
11043 type rng =
11044   | Element of string * rng list        (* <element name=name/> *)
11045   | Attribute of string * rng list        (* <attribute name=name/> *)
11046   | Interleave of rng list                (* <interleave/> *)
11047   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11048   | OneOrMore of rng                        (* <oneOrMore/> *)
11049   | Optional of rng                        (* <optional/> *)
11050   | Choice of string list                (* <choice><value/>*</choice> *)
11051   | Value of string                        (* <value>str</value> *)
11052   | Text                                (* <text/> *)
11053
11054 let rec string_of_rng = function
11055   | Element (name, xs) ->
11056       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11057   | Attribute (name, xs) ->
11058       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11059   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11060   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11061   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11062   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11063   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11064   | Value value -> "Value \"" ^ value ^ "\""
11065   | Text -> "Text"
11066
11067 and string_of_rng_list xs =
11068   String.concat ", " (List.map string_of_rng xs)
11069
11070 let rec parse_rng ?defines context = function
11071   | [] -> []
11072   | Xml.Element ("element", ["name", name], children) :: rest ->
11073       Element (name, parse_rng ?defines context children)
11074       :: parse_rng ?defines context rest
11075   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11076       Attribute (name, parse_rng ?defines context children)
11077       :: parse_rng ?defines context rest
11078   | Xml.Element ("interleave", [], children) :: rest ->
11079       Interleave (parse_rng ?defines context children)
11080       :: parse_rng ?defines context rest
11081   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11082       let rng = parse_rng ?defines context [child] in
11083       (match rng with
11084        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11085        | _ ->
11086            failwithf "%s: <zeroOrMore> contains more than one child element"
11087              context
11088       )
11089   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11090       let rng = parse_rng ?defines context [child] in
11091       (match rng with
11092        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11093        | _ ->
11094            failwithf "%s: <oneOrMore> contains more than one child element"
11095              context
11096       )
11097   | Xml.Element ("optional", [], [child]) :: rest ->
11098       let rng = parse_rng ?defines context [child] in
11099       (match rng with
11100        | [child] -> Optional child :: parse_rng ?defines context rest
11101        | _ ->
11102            failwithf "%s: <optional> contains more than one child element"
11103              context
11104       )
11105   | Xml.Element ("choice", [], children) :: rest ->
11106       let values = List.map (
11107         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11108         | _ ->
11109             failwithf "%s: can't handle anything except <value> in <choice>"
11110               context
11111       ) children in
11112       Choice values
11113       :: parse_rng ?defines context rest
11114   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11115       Value value :: parse_rng ?defines context rest
11116   | Xml.Element ("text", [], []) :: rest ->
11117       Text :: parse_rng ?defines context rest
11118   | Xml.Element ("ref", ["name", name], []) :: rest ->
11119       (* Look up the reference.  Because of limitations in this parser,
11120        * we can't handle arbitrarily nested <ref> yet.  You can only
11121        * use <ref> from inside <start>.
11122        *)
11123       (match defines with
11124        | None ->
11125            failwithf "%s: contains <ref>, but no refs are defined yet" context
11126        | Some map ->
11127            let rng = StringMap.find name map in
11128            rng @ parse_rng ?defines context rest
11129       )
11130   | x :: _ ->
11131       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11132
11133 let grammar =
11134   let xml = Xml.parse_file rng_input in
11135   match xml with
11136   | Xml.Element ("grammar", _,
11137                  Xml.Element ("start", _, gram) :: defines) ->
11138       (* The <define/> elements are referenced in the <start> section,
11139        * so build a map of those first.
11140        *)
11141       let defines = List.fold_left (
11142         fun map ->
11143           function Xml.Element ("define", ["name", name], defn) ->
11144             StringMap.add name defn map
11145           | _ ->
11146               failwithf "%s: expected <define name=name/>" rng_input
11147       ) StringMap.empty defines in
11148       let defines = StringMap.mapi parse_rng defines in
11149
11150       (* Parse the <start> clause, passing the defines. *)
11151       parse_rng ~defines "<start>" gram
11152   | _ ->
11153       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11154         rng_input
11155
11156 let name_of_field = function
11157   | Element (name, _) | Attribute (name, _)
11158   | ZeroOrMore (Element (name, _))
11159   | OneOrMore (Element (name, _))
11160   | Optional (Element (name, _)) -> name
11161   | Optional (Attribute (name, _)) -> name
11162   | Text -> (* an unnamed field in an element *)
11163       "data"
11164   | rng ->
11165       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11166
11167 (* At the moment this function only generates OCaml types.  However we
11168  * should parameterize it later so it can generate types/structs in a
11169  * variety of languages.
11170  *)
11171 let generate_types xs =
11172   (* A simple type is one that can be printed out directly, eg.
11173    * "string option".  A complex type is one which has a name and has
11174    * to be defined via another toplevel definition, eg. a struct.
11175    *
11176    * generate_type generates code for either simple or complex types.
11177    * In the simple case, it returns the string ("string option").  In
11178    * the complex case, it returns the name ("mountpoint").  In the
11179    * complex case it has to print out the definition before returning,
11180    * so it should only be called when we are at the beginning of a
11181    * new line (BOL context).
11182    *)
11183   let rec generate_type = function
11184     | Text ->                                (* string *)
11185         "string", true
11186     | Choice values ->                        (* [`val1|`val2|...] *)
11187         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11188     | ZeroOrMore rng ->                        (* <rng> list *)
11189         let t, is_simple = generate_type rng in
11190         t ^ " list (* 0 or more *)", is_simple
11191     | OneOrMore rng ->                        (* <rng> list *)
11192         let t, is_simple = generate_type rng in
11193         t ^ " list (* 1 or more *)", is_simple
11194                                         (* virt-inspector hack: bool *)
11195     | Optional (Attribute (name, [Value "1"])) ->
11196         "bool", true
11197     | Optional rng ->                        (* <rng> list *)
11198         let t, is_simple = generate_type rng in
11199         t ^ " option", is_simple
11200                                         (* type name = { fields ... } *)
11201     | Element (name, fields) when is_attrs_interleave fields ->
11202         generate_type_struct name (get_attrs_interleave fields)
11203     | Element (name, [field])                (* type name = field *)
11204     | Attribute (name, [field]) ->
11205         let t, is_simple = generate_type field in
11206         if is_simple then (t, true)
11207         else (
11208           pr "type %s = %s\n" name t;
11209           name, false
11210         )
11211     | Element (name, fields) ->              (* type name = { fields ... } *)
11212         generate_type_struct name fields
11213     | rng ->
11214         failwithf "generate_type failed at: %s" (string_of_rng rng)
11215
11216   and is_attrs_interleave = function
11217     | [Interleave _] -> true
11218     | Attribute _ :: fields -> is_attrs_interleave fields
11219     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11220     | _ -> false
11221
11222   and get_attrs_interleave = function
11223     | [Interleave fields] -> fields
11224     | ((Attribute _) as field) :: fields
11225     | ((Optional (Attribute _)) as field) :: fields ->
11226         field :: get_attrs_interleave fields
11227     | _ -> assert false
11228
11229   and generate_types xs =
11230     List.iter (fun x -> ignore (generate_type x)) xs
11231
11232   and generate_type_struct name fields =
11233     (* Calculate the types of the fields first.  We have to do this
11234      * before printing anything so we are still in BOL context.
11235      *)
11236     let types = List.map fst (List.map generate_type fields) in
11237
11238     (* Special case of a struct containing just a string and another
11239      * field.  Turn it into an assoc list.
11240      *)
11241     match types with
11242     | ["string"; other] ->
11243         let fname1, fname2 =
11244           match fields with
11245           | [f1; f2] -> name_of_field f1, name_of_field f2
11246           | _ -> assert false in
11247         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11248         name, false
11249
11250     | types ->
11251         pr "type %s = {\n" name;
11252         List.iter (
11253           fun (field, ftype) ->
11254             let fname = name_of_field field in
11255             pr "  %s_%s : %s;\n" name fname ftype
11256         ) (List.combine fields types);
11257         pr "}\n";
11258         (* Return the name of this type, and
11259          * false because it's not a simple type.
11260          *)
11261         name, false
11262   in
11263
11264   generate_types xs
11265
11266 let generate_parsers xs =
11267   (* As for generate_type above, generate_parser makes a parser for
11268    * some type, and returns the name of the parser it has generated.
11269    * Because it (may) need to print something, it should always be
11270    * called in BOL context.
11271    *)
11272   let rec generate_parser = function
11273     | Text ->                                (* string *)
11274         "string_child_or_empty"
11275     | Choice values ->                        (* [`val1|`val2|...] *)
11276         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11277           (String.concat "|"
11278              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11279     | ZeroOrMore rng ->                        (* <rng> list *)
11280         let pa = generate_parser rng in
11281         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11282     | OneOrMore rng ->                        (* <rng> list *)
11283         let pa = generate_parser rng in
11284         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11285                                         (* virt-inspector hack: bool *)
11286     | Optional (Attribute (name, [Value "1"])) ->
11287         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11288     | Optional rng ->                        (* <rng> list *)
11289         let pa = generate_parser rng in
11290         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11291                                         (* type name = { fields ... } *)
11292     | Element (name, fields) when is_attrs_interleave fields ->
11293         generate_parser_struct name (get_attrs_interleave fields)
11294     | Element (name, [field]) ->        (* type name = field *)
11295         let pa = generate_parser field in
11296         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11297         pr "let %s =\n" parser_name;
11298         pr "  %s\n" pa;
11299         pr "let parse_%s = %s\n" name parser_name;
11300         parser_name
11301     | Attribute (name, [field]) ->
11302         let pa = generate_parser field in
11303         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11304         pr "let %s =\n" parser_name;
11305         pr "  %s\n" pa;
11306         pr "let parse_%s = %s\n" name parser_name;
11307         parser_name
11308     | Element (name, fields) ->              (* type name = { fields ... } *)
11309         generate_parser_struct name ([], fields)
11310     | rng ->
11311         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11312
11313   and is_attrs_interleave = function
11314     | [Interleave _] -> true
11315     | Attribute _ :: fields -> is_attrs_interleave fields
11316     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11317     | _ -> false
11318
11319   and get_attrs_interleave = function
11320     | [Interleave fields] -> [], fields
11321     | ((Attribute _) as field) :: fields
11322     | ((Optional (Attribute _)) as field) :: fields ->
11323         let attrs, interleaves = get_attrs_interleave fields in
11324         (field :: attrs), interleaves
11325     | _ -> assert false
11326
11327   and generate_parsers xs =
11328     List.iter (fun x -> ignore (generate_parser x)) xs
11329
11330   and generate_parser_struct name (attrs, interleaves) =
11331     (* Generate parsers for the fields first.  We have to do this
11332      * before printing anything so we are still in BOL context.
11333      *)
11334     let fields = attrs @ interleaves in
11335     let pas = List.map generate_parser fields in
11336
11337     (* Generate an intermediate tuple from all the fields first.
11338      * If the type is just a string + another field, then we will
11339      * return this directly, otherwise it is turned into a record.
11340      *
11341      * RELAX NG note: This code treats <interleave> and plain lists of
11342      * fields the same.  In other words, it doesn't bother enforcing
11343      * any ordering of fields in the XML.
11344      *)
11345     pr "let parse_%s x =\n" name;
11346     pr "  let t = (\n    ";
11347     let comma = ref false in
11348     List.iter (
11349       fun x ->
11350         if !comma then pr ",\n    ";
11351         comma := true;
11352         match x with
11353         | Optional (Attribute (fname, [field])), pa ->
11354             pr "%s x" pa
11355         | Optional (Element (fname, [field])), pa ->
11356             pr "%s (optional_child %S x)" pa fname
11357         | Attribute (fname, [Text]), _ ->
11358             pr "attribute %S x" fname
11359         | (ZeroOrMore _ | OneOrMore _), pa ->
11360             pr "%s x" pa
11361         | Text, pa ->
11362             pr "%s x" pa
11363         | (field, pa) ->
11364             let fname = name_of_field field in
11365             pr "%s (child %S x)" pa fname
11366     ) (List.combine fields pas);
11367     pr "\n  ) in\n";
11368
11369     (match fields with
11370      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11371          pr "  t\n"
11372
11373      | _ ->
11374          pr "  (Obj.magic t : %s)\n" name
11375 (*
11376          List.iter (
11377            function
11378            | (Optional (Attribute (fname, [field])), pa) ->
11379                pr "  %s_%s =\n" name fname;
11380                pr "    %s x;\n" pa
11381            | (Optional (Element (fname, [field])), pa) ->
11382                pr "  %s_%s =\n" name fname;
11383                pr "    (let x = optional_child %S x in\n" fname;
11384                pr "     %s x);\n" pa
11385            | (field, pa) ->
11386                let fname = name_of_field field in
11387                pr "  %s_%s =\n" name fname;
11388                pr "    (let x = child %S x in\n" fname;
11389                pr "     %s x);\n" pa
11390          ) (List.combine fields pas);
11391          pr "}\n"
11392 *)
11393     );
11394     sprintf "parse_%s" name
11395   in
11396
11397   generate_parsers xs
11398
11399 (* Generate ocaml/guestfs_inspector.mli. *)
11400 let generate_ocaml_inspector_mli () =
11401   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11402
11403   pr "\
11404 (** This is an OCaml language binding to the external [virt-inspector]
11405     program.
11406
11407     For more information, please read the man page [virt-inspector(1)].
11408 *)
11409
11410 ";
11411
11412   generate_types grammar;
11413   pr "(** The nested information returned from the {!inspect} function. *)\n";
11414   pr "\n";
11415
11416   pr "\
11417 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11418 (** To inspect a libvirt domain called [name], pass a singleton
11419     list: [inspect [name]].  When using libvirt only, you may
11420     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11421
11422     To inspect a disk image or images, pass a list of the filenames
11423     of the disk images: [inspect filenames]
11424
11425     This function inspects the given guest or disk images and
11426     returns a list of operating system(s) found and a large amount
11427     of information about them.  In the vast majority of cases,
11428     a virtual machine only contains a single operating system.
11429
11430     If the optional [~xml] parameter is given, then this function
11431     skips running the external virt-inspector program and just
11432     parses the given XML directly (which is expected to be XML
11433     produced from a previous run of virt-inspector).  The list of
11434     names and connect URI are ignored in this case.
11435
11436     This function can throw a wide variety of exceptions, for example
11437     if the external virt-inspector program cannot be found, or if
11438     it doesn't generate valid XML.
11439 *)
11440 "
11441
11442 (* Generate ocaml/guestfs_inspector.ml. *)
11443 let generate_ocaml_inspector_ml () =
11444   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11445
11446   pr "open Unix\n";
11447   pr "\n";
11448
11449   generate_types grammar;
11450   pr "\n";
11451
11452   pr "\
11453 (* Misc functions which are used by the parser code below. *)
11454 let first_child = function
11455   | Xml.Element (_, _, c::_) -> c
11456   | Xml.Element (name, _, []) ->
11457       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11458   | Xml.PCData str ->
11459       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11460
11461 let string_child_or_empty = function
11462   | Xml.Element (_, _, [Xml.PCData s]) -> s
11463   | Xml.Element (_, _, []) -> \"\"
11464   | Xml.Element (x, _, _) ->
11465       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11466                 x ^ \" instead\")
11467   | Xml.PCData str ->
11468       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11469
11470 let optional_child name xml =
11471   let children = Xml.children xml in
11472   try
11473     Some (List.find (function
11474                      | Xml.Element (n, _, _) when n = name -> true
11475                      | _ -> false) children)
11476   with
11477     Not_found -> None
11478
11479 let child name xml =
11480   match optional_child name xml with
11481   | Some c -> c
11482   | None ->
11483       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11484
11485 let attribute name xml =
11486   try Xml.attrib xml name
11487   with Xml.No_attribute _ ->
11488     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11489
11490 ";
11491
11492   generate_parsers grammar;
11493   pr "\n";
11494
11495   pr "\
11496 (* Run external virt-inspector, then use parser to parse the XML. *)
11497 let inspect ?connect ?xml names =
11498   let xml =
11499     match xml with
11500     | None ->
11501         if names = [] then invalid_arg \"inspect: no names given\";
11502         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11503           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11504           names in
11505         let cmd = List.map Filename.quote cmd in
11506         let cmd = String.concat \" \" cmd in
11507         let chan = open_process_in cmd in
11508         let xml = Xml.parse_in chan in
11509         (match close_process_in chan with
11510          | WEXITED 0 -> ()
11511          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11512          | WSIGNALED i | WSTOPPED i ->
11513              failwith (\"external virt-inspector command died or stopped on sig \" ^
11514                        string_of_int i)
11515         );
11516         xml
11517     | Some doc ->
11518         Xml.parse_string doc in
11519   parse_operatingsystems xml
11520 "
11521
11522 (* This is used to generate the src/MAX_PROC_NR file which
11523  * contains the maximum procedure number, a surrogate for the
11524  * ABI version number.  See src/Makefile.am for the details.
11525  *)
11526 and generate_max_proc_nr () =
11527   let proc_nrs = List.map (
11528     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11529   ) daemon_functions in
11530
11531   let max_proc_nr = List.fold_left max 0 proc_nrs in
11532
11533   pr "%d\n" max_proc_nr
11534
11535 let output_to filename k =
11536   let filename_new = filename ^ ".new" in
11537   chan := open_out filename_new;
11538   k ();
11539   close_out !chan;
11540   chan := Pervasives.stdout;
11541
11542   (* Is the new file different from the current file? *)
11543   if Sys.file_exists filename && files_equal filename filename_new then
11544     unlink filename_new                 (* same, so skip it *)
11545   else (
11546     (* different, overwrite old one *)
11547     (try chmod filename 0o644 with Unix_error _ -> ());
11548     rename filename_new filename;
11549     chmod filename 0o444;
11550     printf "written %s\n%!" filename;
11551   )
11552
11553 let perror msg = function
11554   | Unix_error (err, _, _) ->
11555       eprintf "%s: %s\n" msg (error_message err)
11556   | exn ->
11557       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11558
11559 (* Main program. *)
11560 let () =
11561   let lock_fd =
11562     try openfile "HACKING" [O_RDWR] 0
11563     with
11564     | Unix_error (ENOENT, _, _) ->
11565         eprintf "\
11566 You are probably running this from the wrong directory.
11567 Run it from the top source directory using the command
11568   src/generator.ml
11569 ";
11570         exit 1
11571     | exn ->
11572         perror "open: HACKING" exn;
11573         exit 1 in
11574
11575   (* Acquire a lock so parallel builds won't try to run the generator
11576    * twice at the same time.  Subsequent builds will wait for the first
11577    * one to finish.  Note the lock is released implicitly when the
11578    * program exits.
11579    *)
11580   (try lockf lock_fd F_LOCK 1
11581    with exn ->
11582      perror "lock: HACKING" exn;
11583      exit 1);
11584
11585   check_functions ();
11586
11587   output_to "src/guestfs_protocol.x" generate_xdr;
11588   output_to "src/guestfs-structs.h" generate_structs_h;
11589   output_to "src/guestfs-actions.h" generate_actions_h;
11590   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11591   output_to "src/guestfs-actions.c" generate_client_actions;
11592   output_to "src/guestfs-bindtests.c" generate_bindtests;
11593   output_to "src/guestfs-structs.pod" generate_structs_pod;
11594   output_to "src/guestfs-actions.pod" generate_actions_pod;
11595   output_to "src/guestfs-availability.pod" generate_availability_pod;
11596   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11597   output_to "src/libguestfs.syms" generate_linker_script;
11598   output_to "daemon/actions.h" generate_daemon_actions_h;
11599   output_to "daemon/stubs.c" generate_daemon_actions;
11600   output_to "daemon/names.c" generate_daemon_names;
11601   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11602   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11603   output_to "capitests/tests.c" generate_tests;
11604   output_to "fish/cmds.c" generate_fish_cmds;
11605   output_to "fish/completion.c" generate_fish_completion;
11606   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11607   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11608   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11609   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11610   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11611   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11612   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11613   output_to "perl/Guestfs.xs" generate_perl_xs;
11614   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11615   output_to "perl/bindtests.pl" generate_perl_bindtests;
11616   output_to "python/guestfs-py.c" generate_python_c;
11617   output_to "python/guestfs.py" generate_python_py;
11618   output_to "python/bindtests.py" generate_python_bindtests;
11619   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11620   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11621   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11622
11623   List.iter (
11624     fun (typ, jtyp) ->
11625       let cols = cols_of_struct typ in
11626       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11627       output_to filename (generate_java_struct jtyp cols);
11628   ) java_structs;
11629
11630   output_to "java/Makefile.inc" generate_java_makefile_inc;
11631   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11632   output_to "java/Bindtests.java" generate_java_bindtests;
11633   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11634   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11635   output_to "csharp/Libguestfs.cs" generate_csharp;
11636
11637   (* Always generate this file last, and unconditionally.  It's used
11638    * by the Makefile to know when we must re-run the generator.
11639    *)
11640   let chan = open_out "src/stamp-generator" in
11641   fprintf chan "1\n";
11642   close_out chan;
11643
11644   printf "generated %d lines of code\n" !lines