generator: Allow individual tests to depend on daemon features.
[libguestfs.git] / src / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009-2010 Red Hat Inc.
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18  *)
19
20 (* This script generates a large amount of code and documentation for
21  * all the daemon actions.
22  *
23  * To add a new action there are only two files you need to change,
24  * this one to describe the interface (see the big table of
25  * 'daemon_functions' below), and daemon/<somefile>.c to write the
26  * implementation.
27  *
28  * After editing this file, run it (./src/generator.ml) to regenerate
29  * all the output files.  'make' will rerun this automatically when
30  * necessary.  Note that if you are using a separate build directory
31  * you must run generator.ml from the _source_ directory.
32  *
33  * IMPORTANT: This script should NOT print any warnings.  If it prints
34  * warnings, you should treat them as errors.
35  *
36  * OCaml tips:
37  * (1) In emacs, install tuareg-mode to display and format OCaml code
38  * correctly.  'vim' comes with a good OCaml editing mode by default.
39  * (2) Read the resources at http://ocaml-tutorial.org/
40  *)
41
42 #load "unix.cma";;
43 #load "str.cma";;
44 #directory "+xml-light";;
45 #directory "+../pkg-lib/xml-light";; (* for GODI users *)
46 #load "xml-light.cma";;
47
48 open Unix
49 open Printf
50
51 type style = ret * args
52 and ret =
53     (* "RErr" as a return value means an int used as a simple error
54      * indication, ie. 0 or -1.
55      *)
56   | RErr
57
58     (* "RInt" as a return value means an int which is -1 for error
59      * or any value >= 0 on success.  Only use this for smallish
60      * positive ints (0 <= i < 2^30).
61      *)
62   | RInt of string
63
64     (* "RInt64" is the same as RInt, but is guaranteed to be able
65      * to return a full 64 bit value, _except_ that -1 means error
66      * (so -1 cannot be a valid, non-error return value).
67      *)
68   | RInt64 of string
69
70     (* "RBool" is a bool return value which can be true/false or
71      * -1 for error.
72      *)
73   | RBool of string
74
75     (* "RConstString" is a string that refers to a constant value.
76      * The return value must NOT be NULL (since NULL indicates
77      * an error).
78      *
79      * Try to avoid using this.  In particular you cannot use this
80      * for values returned from the daemon, because there is no
81      * thread-safe way to return them in the C API.
82      *)
83   | RConstString of string
84
85     (* "RConstOptString" is an even more broken version of
86      * "RConstString".  The returned string may be NULL and there
87      * is no way to return an error indication.  Avoid using this!
88      *)
89   | RConstOptString of string
90
91     (* "RString" is a returned string.  It must NOT be NULL, since
92      * a NULL return indicates an error.  The caller frees this.
93      *)
94   | RString of string
95
96     (* "RStringList" is a list of strings.  No string in the list
97      * can be NULL.  The caller frees the strings and the array.
98      *)
99   | RStringList of string
100
101     (* "RStruct" is a function which returns a single named structure
102      * or an error indication (in C, a struct, and in other languages
103      * with varying representations, but usually very efficient).  See
104      * after the function list below for the structures.
105      *)
106   | RStruct of string * string          (* name of retval, name of struct *)
107
108     (* "RStructList" is a function which returns either a list/array
109      * of structures (could be zero-length), or an error indication.
110      *)
111   | RStructList of string * string      (* name of retval, name of struct *)
112
113     (* Key-value pairs of untyped strings.  Turns into a hashtable or
114      * dictionary in languages which support it.  DON'T use this as a
115      * general "bucket" for results.  Prefer a stronger typed return
116      * value if one is available, or write a custom struct.  Don't use
117      * this if the list could potentially be very long, since it is
118      * inefficient.  Keys should be unique.  NULLs are not permitted.
119      *)
120   | RHashtable of string
121
122     (* "RBufferOut" is handled almost exactly like RString, but
123      * it allows the string to contain arbitrary 8 bit data including
124      * ASCII NUL.  In the C API this causes an implicit extra parameter
125      * to be added of type <size_t *size_r>.  The extra parameter
126      * returns the actual size of the return buffer in bytes.
127      *
128      * Other programming languages support strings with arbitrary 8 bit
129      * data.
130      *
131      * At the RPC layer we have to use the opaque<> type instead of
132      * string<>.  Returned data is still limited to the max message
133      * size (ie. ~ 2 MB).
134      *)
135   | RBufferOut of string
136
137 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
138
139     (* Note in future we should allow a "variable args" parameter as
140      * the final parameter, to allow commands like
141      *   chmod mode file [file(s)...]
142      * This is not implemented yet, but many commands (such as chmod)
143      * are currently defined with the argument order keeping this future
144      * possibility in mind.
145      *)
146 and argt =
147   | String of string    (* const char *name, cannot be NULL *)
148   | Device of string    (* /dev device name, cannot be NULL *)
149   | Pathname of string  (* file name, cannot be NULL *)
150   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
151   | OptString of string (* const char *name, may be NULL *)
152   | StringList of string(* list of strings (each string cannot be NULL) *)
153   | DeviceList of string(* list of Device names (each cannot be NULL) *)
154   | Bool of string      (* boolean *)
155   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
156   | Int64 of string     (* any 64 bit int *)
157     (* These are treated as filenames (simple string parameters) in
158      * the C API and bindings.  But in the RPC protocol, we transfer
159      * the actual file content up to or down from the daemon.
160      * FileIn: local machine -> daemon (in request)
161      * FileOut: daemon -> local machine (in reply)
162      * In guestfish (only), the special name "-" means read from
163      * stdin or write to stdout.
164      *)
165   | FileIn of string
166   | FileOut of string
167 (* Not implemented:
168     (* Opaque buffer which can contain arbitrary 8 bit data.
169      * In the C API, this is expressed as <char *, int> pair.
170      * Most other languages have a string type which can contain
171      * ASCII NUL.  We use whatever type is appropriate for each
172      * language.
173      * Buffers are limited by the total message size.  To transfer
174      * large blocks of data, use FileIn/FileOut parameters instead.
175      * To return an arbitrary buffer, use RBufferOut.
176      *)
177   | BufferIn of string
178 *)
179
180 type flags =
181   | ProtocolLimitWarning  (* display warning about protocol size limits *)
182   | DangerWillRobinson    (* flags particularly dangerous commands *)
183   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
184   | FishAction of string  (* call this function in guestfish *)
185   | NotInFish             (* do not export via guestfish *)
186   | NotInDocs             (* do not add this function to documentation *)
187   | DeprecatedBy of string (* function is deprecated, use .. instead *)
188   | Optional of string    (* function is part of an optional group *)
189
190 (* You can supply zero or as many tests as you want per API call.
191  *
192  * Note that the test environment has 3 block devices, of size 500MB,
193  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
194  * a fourth ISO block device with some known files on it (/dev/sdd).
195  *
196  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
197  * Number of cylinders was 63 for IDE emulated disks with precisely
198  * the same size.  How exactly this is calculated is a mystery.
199  *
200  * The ISO block device (/dev/sdd) comes from images/test.iso.
201  *
202  * To be able to run the tests in a reasonable amount of time,
203  * the virtual machine and block devices are reused between tests.
204  * So don't try testing kill_subprocess :-x
205  *
206  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
207  *
208  * Don't assume anything about the previous contents of the block
209  * devices.  Use 'Init*' to create some initial scenarios.
210  *
211  * You can add a prerequisite clause to any individual test.  This
212  * is a run-time check, which, if it fails, causes the test to be
213  * skipped.  Useful if testing a command which might not work on
214  * all variations of libguestfs builds.  A test that has prerequisite
215  * of 'Always' is run unconditionally.
216  *
217  * In addition, packagers can skip individual tests by setting the
218  * environment variables:     eg:
219  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
220  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
221  *)
222 type tests = (test_init * test_prereq * test) list
223 and test =
224     (* Run the command sequence and just expect nothing to fail. *)
225   | TestRun of seq
226
227     (* Run the command sequence and expect the output of the final
228      * command to be the string.
229      *)
230   | TestOutput of seq * string
231
232     (* Run the command sequence and expect the output of the final
233      * command to be the list of strings.
234      *)
235   | TestOutputList of seq * string list
236
237     (* Run the command sequence and expect the output of the final
238      * command to be the list of block devices (could be either
239      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
240      * character of each string).
241      *)
242   | TestOutputListOfDevices of seq * string list
243
244     (* Run the command sequence and expect the output of the final
245      * command to be the integer.
246      *)
247   | TestOutputInt of seq * int
248
249     (* Run the command sequence and expect the output of the final
250      * command to be <op> <int>, eg. ">=", "1".
251      *)
252   | TestOutputIntOp of seq * string * int
253
254     (* Run the command sequence and expect the output of the final
255      * command to be a true value (!= 0 or != NULL).
256      *)
257   | TestOutputTrue of seq
258
259     (* Run the command sequence and expect the output of the final
260      * command to be a false value (== 0 or == NULL, but not an error).
261      *)
262   | TestOutputFalse of seq
263
264     (* Run the command sequence and expect the output of the final
265      * command to be a list of the given length (but don't care about
266      * content).
267      *)
268   | TestOutputLength of seq * int
269
270     (* Run the command sequence and expect the output of the final
271      * command to be a buffer (RBufferOut), ie. string + size.
272      *)
273   | TestOutputBuffer of seq * string
274
275     (* Run the command sequence and expect the output of the final
276      * command to be a structure.
277      *)
278   | TestOutputStruct of seq * test_field_compare list
279
280     (* Run the command sequence and expect the final command (only)
281      * to fail.
282      *)
283   | TestLastFail of seq
284
285 and test_field_compare =
286   | CompareWithInt of string * int
287   | CompareWithIntOp of string * string * int
288   | CompareWithString of string * string
289   | CompareFieldsIntEq of string * string
290   | CompareFieldsStrEq of string * string
291
292 (* Test prerequisites. *)
293 and test_prereq =
294     (* Test always runs. *)
295   | Always
296
297     (* Test is currently disabled - eg. it fails, or it tests some
298      * unimplemented feature.
299      *)
300   | Disabled
301
302     (* 'string' is some C code (a function body) that should return
303      * true or false.  The test will run if the code returns true.
304      *)
305   | If of string
306
307     (* As for 'If' but the test runs _unless_ the code returns true. *)
308   | Unless of string
309
310     (* Run the test only if 'string' is available in the daemon. *)
311   | IfAvailable of string
312
313 (* Some initial scenarios for testing. *)
314 and test_init =
315     (* Do nothing, block devices could contain random stuff including
316      * LVM PVs, and some filesystems might be mounted.  This is usually
317      * a bad idea.
318      *)
319   | InitNone
320
321     (* Block devices are empty and no filesystems are mounted. *)
322   | InitEmpty
323
324     (* /dev/sda contains a single partition /dev/sda1, with random
325      * content.  /dev/sdb and /dev/sdc may have random content.
326      * No LVM.
327      *)
328   | InitPartition
329
330     (* /dev/sda contains a single partition /dev/sda1, which is formatted
331      * as ext2, empty [except for lost+found] and mounted on /.
332      * /dev/sdb and /dev/sdc may have random content.
333      * No LVM.
334      *)
335   | InitBasicFS
336
337     (* /dev/sda:
338      *   /dev/sda1 (is a PV):
339      *     /dev/VG/LV (size 8MB):
340      *       formatted as ext2, empty [except for lost+found], mounted on /
341      * /dev/sdb and /dev/sdc may have random content.
342      *)
343   | InitBasicFSonLVM
344
345     (* /dev/sdd (the ISO, see images/ directory in source)
346      * is mounted on /
347      *)
348   | InitISOFS
349
350 (* Sequence of commands for testing. *)
351 and seq = cmd list
352 and cmd = string list
353
354 (* Note about long descriptions: When referring to another
355  * action, use the format C<guestfs_other> (ie. the full name of
356  * the C function).  This will be replaced as appropriate in other
357  * language bindings.
358  *
359  * Apart from that, long descriptions are just perldoc paragraphs.
360  *)
361
362 (* Generate a random UUID (used in tests). *)
363 let uuidgen () =
364   let chan = open_process_in "uuidgen" in
365   let uuid = input_line chan in
366   (match close_process_in chan with
367    | WEXITED 0 -> ()
368    | WEXITED _ ->
369        failwith "uuidgen: process exited with non-zero status"
370    | WSIGNALED _ | WSTOPPED _ ->
371        failwith "uuidgen: process signalled or stopped by signal"
372   );
373   uuid
374
375 (* These test functions are used in the language binding tests. *)
376
377 let test_all_args = [
378   String "str";
379   OptString "optstr";
380   StringList "strlist";
381   Bool "b";
382   Int "integer";
383   Int64 "integer64";
384   FileIn "filein";
385   FileOut "fileout";
386 ]
387
388 let test_all_rets = [
389   (* except for RErr, which is tested thoroughly elsewhere *)
390   "test0rint",         RInt "valout";
391   "test0rint64",       RInt64 "valout";
392   "test0rbool",        RBool "valout";
393   "test0rconststring", RConstString "valout";
394   "test0rconstoptstring", RConstOptString "valout";
395   "test0rstring",      RString "valout";
396   "test0rstringlist",  RStringList "valout";
397   "test0rstruct",      RStruct ("valout", "lvm_pv");
398   "test0rstructlist",  RStructList ("valout", "lvm_pv");
399   "test0rhashtable",   RHashtable "valout";
400 ]
401
402 let test_functions = [
403   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
404    [],
405    "internal test function - do not use",
406    "\
407 This is an internal test function which is used to test whether
408 the automatically generated bindings can handle every possible
409 parameter type correctly.
410
411 It echos the contents of each parameter to stdout.
412
413 You probably don't want to call this function.");
414 ] @ List.flatten (
415   List.map (
416     fun (name, ret) ->
417       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
418         [],
419         "internal test function - do not use",
420         "\
421 This is an internal test function which is used to test whether
422 the automatically generated bindings can handle every possible
423 return type correctly.
424
425 It converts string C<val> to the return type.
426
427 You probably don't want to call this function.");
428        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
429         [],
430         "internal test function - do not use",
431         "\
432 This is an internal test function which is used to test whether
433 the automatically generated bindings can handle every possible
434 return type correctly.
435
436 This function always returns an error.
437
438 You probably don't want to call this function.")]
439   ) test_all_rets
440 )
441
442 (* non_daemon_functions are any functions which don't get processed
443  * in the daemon, eg. functions for setting and getting local
444  * configuration values.
445  *)
446
447 let non_daemon_functions = test_functions @ [
448   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
449    [],
450    "launch the qemu subprocess",
451    "\
452 Internally libguestfs is implemented by running a virtual machine
453 using L<qemu(1)>.
454
455 You should call this after configuring the handle
456 (eg. adding drives) but before performing any actions.");
457
458   ("wait_ready", (RErr, []), -1, [NotInFish],
459    [],
460    "wait until the qemu subprocess launches (no op)",
461    "\
462 This function is a no op.
463
464 In versions of the API E<lt> 1.0.71 you had to call this function
465 just after calling C<guestfs_launch> to wait for the launch
466 to complete.  However this is no longer necessary because
467 C<guestfs_launch> now does the waiting.
468
469 If you see any calls to this function in code then you can just
470 remove them, unless you want to retain compatibility with older
471 versions of the API.");
472
473   ("kill_subprocess", (RErr, []), -1, [],
474    [],
475    "kill the qemu subprocess",
476    "\
477 This kills the qemu subprocess.  You should never need to call this.");
478
479   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
480    [],
481    "add an image to examine or modify",
482    "\
483 This function adds a virtual machine disk image C<filename> to the
484 guest.  The first time you call this function, the disk appears as IDE
485 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
486 so on.
487
488 You don't necessarily need to be root when using libguestfs.  However
489 you obviously do need sufficient permissions to access the filename
490 for whatever operations you want to perform (ie. read access if you
491 just want to read the image or write access if you want to modify the
492 image).
493
494 This is equivalent to the qemu parameter
495 C<-drive file=filename,cache=off,if=...>.
496
497 C<cache=off> is omitted in cases where it is not supported by
498 the underlying filesystem.
499
500 C<if=...> is set at compile time by the configuration option
501 C<./configure --with-drive-if=...>.  In the rare case where you
502 might need to change this at run time, use C<guestfs_add_drive_with_if>
503 or C<guestfs_add_drive_ro_with_if>.
504
505 Note that this call checks for the existence of C<filename>.  This
506 stops you from specifying other types of drive which are supported
507 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
508 the general C<guestfs_config> call instead.");
509
510   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
511    [],
512    "add a CD-ROM disk image to examine",
513    "\
514 This function adds a virtual CD-ROM disk image to the guest.
515
516 This is equivalent to the qemu parameter C<-cdrom filename>.
517
518 Notes:
519
520 =over 4
521
522 =item *
523
524 This call checks for the existence of C<filename>.  This
525 stops you from specifying other types of drive which are supported
526 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
527 the general C<guestfs_config> call instead.
528
529 =item *
530
531 If you just want to add an ISO file (often you use this as an
532 efficient way to transfer large files into the guest), then you
533 should probably use C<guestfs_add_drive_ro> instead.
534
535 =back");
536
537   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
538    [],
539    "add a drive in snapshot mode (read-only)",
540    "\
541 This adds a drive in snapshot mode, making it effectively
542 read-only.
543
544 Note that writes to the device are allowed, and will be seen for
545 the duration of the guestfs handle, but they are written
546 to a temporary file which is discarded as soon as the guestfs
547 handle is closed.  We don't currently have any method to enable
548 changes to be committed, although qemu can support this.
549
550 This is equivalent to the qemu parameter
551 C<-drive file=filename,snapshot=on,readonly=on,if=...>.
552
553 C<if=...> is set at compile time by the configuration option
554 C<./configure --with-drive-if=...>.  In the rare case where you
555 might need to change this at run time, use C<guestfs_add_drive_with_if>
556 or C<guestfs_add_drive_ro_with_if>.
557
558 C<readonly=on> is only added where qemu supports this option.
559
560 Note that this call checks for the existence of C<filename>.  This
561 stops you from specifying other types of drive which are supported
562 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
563 the general C<guestfs_config> call instead.");
564
565   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
566    [],
567    "add qemu parameters",
568    "\
569 This can be used to add arbitrary qemu command line parameters
570 of the form C<-param value>.  Actually it's not quite arbitrary - we
571 prevent you from setting some parameters which would interfere with
572 parameters that we use.
573
574 The first character of C<param> string must be a C<-> (dash).
575
576 C<value> can be NULL.");
577
578   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
579    [],
580    "set the qemu binary",
581    "\
582 Set the qemu binary that we will use.
583
584 The default is chosen when the library was compiled by the
585 configure script.
586
587 You can also override this by setting the C<LIBGUESTFS_QEMU>
588 environment variable.
589
590 Setting C<qemu> to C<NULL> restores the default qemu binary.
591
592 Note that you should call this function as early as possible
593 after creating the handle.  This is because some pre-launch
594 operations depend on testing qemu features (by running C<qemu -help>).
595 If the qemu binary changes, we don't retest features, and
596 so you might see inconsistent results.  Using the environment
597 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
598 the qemu binary at the same time as the handle is created.");
599
600   ("get_qemu", (RConstString "qemu", []), -1, [],
601    [InitNone, Always, TestRun (
602       [["get_qemu"]])],
603    "get the qemu binary",
604    "\
605 Return the current qemu binary.
606
607 This is always non-NULL.  If it wasn't set already, then this will
608 return the default qemu binary name.");
609
610   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
611    [],
612    "set the search path",
613    "\
614 Set the path that libguestfs searches for kernel and initrd.img.
615
616 The default is C<$libdir/guestfs> unless overridden by setting
617 C<LIBGUESTFS_PATH> environment variable.
618
619 Setting C<path> to C<NULL> restores the default path.");
620
621   ("get_path", (RConstString "path", []), -1, [],
622    [InitNone, Always, TestRun (
623       [["get_path"]])],
624    "get the search path",
625    "\
626 Return the current search path.
627
628 This is always non-NULL.  If it wasn't set already, then this will
629 return the default path.");
630
631   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
632    [],
633    "add options to kernel command line",
634    "\
635 This function is used to add additional options to the
636 guest kernel command line.
637
638 The default is C<NULL> unless overridden by setting
639 C<LIBGUESTFS_APPEND> environment variable.
640
641 Setting C<append> to C<NULL> means I<no> additional options
642 are passed (libguestfs always adds a few of its own).");
643
644   ("get_append", (RConstOptString "append", []), -1, [],
645    (* This cannot be tested with the current framework.  The
646     * function can return NULL in normal operations, which the
647     * test framework interprets as an error.
648     *)
649    [],
650    "get the additional kernel options",
651    "\
652 Return the additional kernel options which are added to the
653 guest kernel command line.
654
655 If C<NULL> then no options are added.");
656
657   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
658    [],
659    "set autosync mode",
660    "\
661 If C<autosync> is true, this enables autosync.  Libguestfs will make a
662 best effort attempt to run C<guestfs_umount_all> followed by
663 C<guestfs_sync> when the handle is closed
664 (also if the program exits without closing handles).
665
666 This is disabled by default (except in guestfish where it is
667 enabled by default).");
668
669   ("get_autosync", (RBool "autosync", []), -1, [],
670    [InitNone, Always, TestRun (
671       [["get_autosync"]])],
672    "get autosync mode",
673    "\
674 Get the autosync flag.");
675
676   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
677    [],
678    "set verbose mode",
679    "\
680 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
681
682 Verbose messages are disabled unless the environment variable
683 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
684
685   ("get_verbose", (RBool "verbose", []), -1, [],
686    [],
687    "get verbose mode",
688    "\
689 This returns the verbose messages flag.");
690
691   ("is_ready", (RBool "ready", []), -1, [],
692    [InitNone, Always, TestOutputTrue (
693       [["is_ready"]])],
694    "is ready to accept commands",
695    "\
696 This returns true iff this handle is ready to accept commands
697 (in the C<READY> state).
698
699 For more information on states, see L<guestfs(3)>.");
700
701   ("is_config", (RBool "config", []), -1, [],
702    [InitNone, Always, TestOutputFalse (
703       [["is_config"]])],
704    "is in configuration state",
705    "\
706 This returns true iff this handle is being configured
707 (in the C<CONFIG> state).
708
709 For more information on states, see L<guestfs(3)>.");
710
711   ("is_launching", (RBool "launching", []), -1, [],
712    [InitNone, Always, TestOutputFalse (
713       [["is_launching"]])],
714    "is launching subprocess",
715    "\
716 This returns true iff this handle is launching the subprocess
717 (in the C<LAUNCHING> state).
718
719 For more information on states, see L<guestfs(3)>.");
720
721   ("is_busy", (RBool "busy", []), -1, [],
722    [InitNone, Always, TestOutputFalse (
723       [["is_busy"]])],
724    "is busy processing a command",
725    "\
726 This returns true iff this handle is busy processing a command
727 (in the C<BUSY> state).
728
729 For more information on states, see L<guestfs(3)>.");
730
731   ("get_state", (RInt "state", []), -1, [],
732    [],
733    "get the current state",
734    "\
735 This returns the current state as an opaque integer.  This is
736 only useful for printing debug and internal error messages.
737
738 For more information on states, see L<guestfs(3)>.");
739
740   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
741    [InitNone, Always, TestOutputInt (
742       [["set_memsize"; "500"];
743        ["get_memsize"]], 500)],
744    "set memory allocated to the qemu subprocess",
745    "\
746 This sets the memory size in megabytes allocated to the
747 qemu subprocess.  This only has any effect if called before
748 C<guestfs_launch>.
749
750 You can also change this by setting the environment
751 variable C<LIBGUESTFS_MEMSIZE> before the handle is
752 created.
753
754 For more information on the architecture of libguestfs,
755 see L<guestfs(3)>.");
756
757   ("get_memsize", (RInt "memsize", []), -1, [],
758    [InitNone, Always, TestOutputIntOp (
759       [["get_memsize"]], ">=", 256)],
760    "get memory allocated to the qemu subprocess",
761    "\
762 This gets the memory size in megabytes allocated to the
763 qemu subprocess.
764
765 If C<guestfs_set_memsize> was not called
766 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
767 then this returns the compiled-in default value for memsize.
768
769 For more information on the architecture of libguestfs,
770 see L<guestfs(3)>.");
771
772   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
773    [InitNone, Always, TestOutputIntOp (
774       [["get_pid"]], ">=", 1)],
775    "get PID of qemu subprocess",
776    "\
777 Return the process ID of the qemu subprocess.  If there is no
778 qemu subprocess, then this will return an error.
779
780 This is an internal call used for debugging and testing.");
781
782   ("version", (RStruct ("version", "version"), []), -1, [],
783    [InitNone, Always, TestOutputStruct (
784       [["version"]], [CompareWithInt ("major", 1)])],
785    "get the library version number",
786    "\
787 Return the libguestfs version number that the program is linked
788 against.
789
790 Note that because of dynamic linking this is not necessarily
791 the version of libguestfs that you compiled against.  You can
792 compile the program, and then at runtime dynamically link
793 against a completely different C<libguestfs.so> library.
794
795 This call was added in version C<1.0.58>.  In previous
796 versions of libguestfs there was no way to get the version
797 number.  From C code you can use dynamic linker functions
798 to find out if this symbol exists (if it doesn't, then
799 it's an earlier version).
800
801 The call returns a structure with four elements.  The first
802 three (C<major>, C<minor> and C<release>) are numbers and
803 correspond to the usual version triplet.  The fourth element
804 (C<extra>) is a string and is normally empty, but may be
805 used for distro-specific information.
806
807 To construct the original version string:
808 C<$major.$minor.$release$extra>
809
810 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
811
812 I<Note:> Don't use this call to test for availability
813 of features.  In enterprise distributions we backport
814 features from later versions into earlier versions,
815 making this an unreliable way to test for features.
816 Use C<guestfs_available> instead.");
817
818   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
819    [InitNone, Always, TestOutputTrue (
820       [["set_selinux"; "true"];
821        ["get_selinux"]])],
822    "set SELinux enabled or disabled at appliance boot",
823    "\
824 This sets the selinux flag that is passed to the appliance
825 at boot time.  The default is C<selinux=0> (disabled).
826
827 Note that if SELinux is enabled, it is always in
828 Permissive mode (C<enforcing=0>).
829
830 For more information on the architecture of libguestfs,
831 see L<guestfs(3)>.");
832
833   ("get_selinux", (RBool "selinux", []), -1, [],
834    [],
835    "get SELinux enabled flag",
836    "\
837 This returns the current setting of the selinux flag which
838 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
839
840 For more information on the architecture of libguestfs,
841 see L<guestfs(3)>.");
842
843   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
844    [InitNone, Always, TestOutputFalse (
845       [["set_trace"; "false"];
846        ["get_trace"]])],
847    "enable or disable command traces",
848    "\
849 If the command trace flag is set to 1, then commands are
850 printed on stdout before they are executed in a format
851 which is very similar to the one used by guestfish.  In
852 other words, you can run a program with this enabled, and
853 you will get out a script which you can feed to guestfish
854 to perform the same set of actions.
855
856 If you want to trace C API calls into libguestfs (and
857 other libraries) then possibly a better way is to use
858 the external ltrace(1) command.
859
860 Command traces are disabled unless the environment variable
861 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
862
863   ("get_trace", (RBool "trace", []), -1, [],
864    [],
865    "get command trace enabled flag",
866    "\
867 Return the command trace flag.");
868
869   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
870    [InitNone, Always, TestOutputFalse (
871       [["set_direct"; "false"];
872        ["get_direct"]])],
873    "enable or disable direct appliance mode",
874    "\
875 If the direct appliance mode flag is enabled, then stdin and
876 stdout are passed directly through to the appliance once it
877 is launched.
878
879 One consequence of this is that log messages aren't caught
880 by the library and handled by C<guestfs_set_log_message_callback>,
881 but go straight to stdout.
882
883 You probably don't want to use this unless you know what you
884 are doing.
885
886 The default is disabled.");
887
888   ("get_direct", (RBool "direct", []), -1, [],
889    [],
890    "get direct appliance mode flag",
891    "\
892 Return the direct appliance mode flag.");
893
894   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
895    [InitNone, Always, TestOutputTrue (
896       [["set_recovery_proc"; "true"];
897        ["get_recovery_proc"]])],
898    "enable or disable the recovery process",
899    "\
900 If this is called with the parameter C<false> then
901 C<guestfs_launch> does not create a recovery process.  The
902 purpose of the recovery process is to stop runaway qemu
903 processes in the case where the main program aborts abruptly.
904
905 This only has any effect if called before C<guestfs_launch>,
906 and the default is true.
907
908 About the only time when you would want to disable this is
909 if the main process will fork itself into the background
910 (\"daemonize\" itself).  In this case the recovery process
911 thinks that the main program has disappeared and so kills
912 qemu, which is not very helpful.");
913
914   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
915    [],
916    "get recovery process enabled flag",
917    "\
918 Return the recovery process enabled flag.");
919
920   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
921    [],
922    "add a drive specifying the QEMU block emulation to use",
923    "\
924 This is the same as C<guestfs_add_drive> but it allows you
925 to specify the QEMU interface emulation to use at run time.");
926
927   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
928    [],
929    "add a drive read-only specifying the QEMU block emulation to use",
930    "\
931 This is the same as C<guestfs_add_drive_ro> but it allows you
932 to specify the QEMU interface emulation to use at run time.");
933
934 ]
935
936 (* daemon_functions are any functions which cause some action
937  * to take place in the daemon.
938  *)
939
940 let daemon_functions = [
941   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
942    [InitEmpty, Always, TestOutput (
943       [["part_disk"; "/dev/sda"; "mbr"];
944        ["mkfs"; "ext2"; "/dev/sda1"];
945        ["mount"; "/dev/sda1"; "/"];
946        ["write_file"; "/new"; "new file contents"; "0"];
947        ["cat"; "/new"]], "new file contents")],
948    "mount a guest disk at a position in the filesystem",
949    "\
950 Mount a guest disk at a position in the filesystem.  Block devices
951 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
952 the guest.  If those block devices contain partitions, they will have
953 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
954 names can be used.
955
956 The rules are the same as for L<mount(2)>:  A filesystem must
957 first be mounted on C</> before others can be mounted.  Other
958 filesystems can only be mounted on directories which already
959 exist.
960
961 The mounted filesystem is writable, if we have sufficient permissions
962 on the underlying device.
963
964 B<Important note:>
965 When you use this call, the filesystem options C<sync> and C<noatime>
966 are set implicitly.  This was originally done because we thought it
967 would improve reliability, but it turns out that I<-o sync> has a
968 very large negative performance impact and negligible effect on
969 reliability.  Therefore we recommend that you avoid using
970 C<guestfs_mount> in any code that needs performance, and instead
971 use C<guestfs_mount_options> (use an empty string for the first
972 parameter if you don't want any options).");
973
974   ("sync", (RErr, []), 2, [],
975    [ InitEmpty, Always, TestRun [["sync"]]],
976    "sync disks, writes are flushed through to the disk image",
977    "\
978 This syncs the disk, so that any writes are flushed through to the
979 underlying disk image.
980
981 You should always call this if you have modified a disk image, before
982 closing the handle.");
983
984   ("touch", (RErr, [Pathname "path"]), 3, [],
985    [InitBasicFS, Always, TestOutputTrue (
986       [["touch"; "/new"];
987        ["exists"; "/new"]])],
988    "update file timestamps or create a new file",
989    "\
990 Touch acts like the L<touch(1)> command.  It can be used to
991 update the timestamps on a file, or, if the file does not exist,
992 to create a new zero-length file.");
993
994   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
995    [InitISOFS, Always, TestOutput (
996       [["cat"; "/known-2"]], "abcdef\n")],
997    "list the contents of a file",
998    "\
999 Return the contents of the file named C<path>.
1000
1001 Note that this function cannot correctly handle binary files
1002 (specifically, files containing C<\\0> character which is treated
1003 as end of string).  For those you need to use the C<guestfs_read_file>
1004 or C<guestfs_download> functions which have a more complex interface.");
1005
1006   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1007    [], (* XXX Tricky to test because it depends on the exact format
1008         * of the 'ls -l' command, which changes between F10 and F11.
1009         *)
1010    "list the files in a directory (long format)",
1011    "\
1012 List the files in C<directory> (relative to the root directory,
1013 there is no cwd) in the format of 'ls -la'.
1014
1015 This command is mostly useful for interactive sessions.  It
1016 is I<not> intended that you try to parse the output string.");
1017
1018   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1019    [InitBasicFS, Always, TestOutputList (
1020       [["touch"; "/new"];
1021        ["touch"; "/newer"];
1022        ["touch"; "/newest"];
1023        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1024    "list the files in a directory",
1025    "\
1026 List the files in C<directory> (relative to the root directory,
1027 there is no cwd).  The '.' and '..' entries are not returned, but
1028 hidden files are shown.
1029
1030 This command is mostly useful for interactive sessions.  Programs
1031 should probably use C<guestfs_readdir> instead.");
1032
1033   ("list_devices", (RStringList "devices", []), 7, [],
1034    [InitEmpty, Always, TestOutputListOfDevices (
1035       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1036    "list the block devices",
1037    "\
1038 List all the block devices.
1039
1040 The full block device names are returned, eg. C</dev/sda>");
1041
1042   ("list_partitions", (RStringList "partitions", []), 8, [],
1043    [InitBasicFS, Always, TestOutputListOfDevices (
1044       [["list_partitions"]], ["/dev/sda1"]);
1045     InitEmpty, Always, TestOutputListOfDevices (
1046       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1047        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1048    "list the partitions",
1049    "\
1050 List all the partitions detected on all block devices.
1051
1052 The full partition device names are returned, eg. C</dev/sda1>
1053
1054 This does not return logical volumes.  For that you will need to
1055 call C<guestfs_lvs>.");
1056
1057   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1058    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1059       [["pvs"]], ["/dev/sda1"]);
1060     InitEmpty, Always, TestOutputListOfDevices (
1061       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1062        ["pvcreate"; "/dev/sda1"];
1063        ["pvcreate"; "/dev/sda2"];
1064        ["pvcreate"; "/dev/sda3"];
1065        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1066    "list the LVM physical volumes (PVs)",
1067    "\
1068 List all the physical volumes detected.  This is the equivalent
1069 of the L<pvs(8)> command.
1070
1071 This returns a list of just the device names that contain
1072 PVs (eg. C</dev/sda2>).
1073
1074 See also C<guestfs_pvs_full>.");
1075
1076   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1077    [InitBasicFSonLVM, Always, TestOutputList (
1078       [["vgs"]], ["VG"]);
1079     InitEmpty, Always, TestOutputList (
1080       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1081        ["pvcreate"; "/dev/sda1"];
1082        ["pvcreate"; "/dev/sda2"];
1083        ["pvcreate"; "/dev/sda3"];
1084        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1085        ["vgcreate"; "VG2"; "/dev/sda3"];
1086        ["vgs"]], ["VG1"; "VG2"])],
1087    "list the LVM volume groups (VGs)",
1088    "\
1089 List all the volumes groups detected.  This is the equivalent
1090 of the L<vgs(8)> command.
1091
1092 This returns a list of just the volume group names that were
1093 detected (eg. C<VolGroup00>).
1094
1095 See also C<guestfs_vgs_full>.");
1096
1097   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1098    [InitBasicFSonLVM, Always, TestOutputList (
1099       [["lvs"]], ["/dev/VG/LV"]);
1100     InitEmpty, Always, TestOutputList (
1101       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1102        ["pvcreate"; "/dev/sda1"];
1103        ["pvcreate"; "/dev/sda2"];
1104        ["pvcreate"; "/dev/sda3"];
1105        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1106        ["vgcreate"; "VG2"; "/dev/sda3"];
1107        ["lvcreate"; "LV1"; "VG1"; "50"];
1108        ["lvcreate"; "LV2"; "VG1"; "50"];
1109        ["lvcreate"; "LV3"; "VG2"; "50"];
1110        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1111    "list the LVM logical volumes (LVs)",
1112    "\
1113 List all the logical volumes detected.  This is the equivalent
1114 of the L<lvs(8)> command.
1115
1116 This returns a list of the logical volume device names
1117 (eg. C</dev/VolGroup00/LogVol00>).
1118
1119 See also C<guestfs_lvs_full>.");
1120
1121   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1122    [], (* XXX how to test? *)
1123    "list the LVM physical volumes (PVs)",
1124    "\
1125 List all the physical volumes detected.  This is the equivalent
1126 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1127
1128   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1129    [], (* XXX how to test? *)
1130    "list the LVM volume groups (VGs)",
1131    "\
1132 List all the volumes groups detected.  This is the equivalent
1133 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1134
1135   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1136    [], (* XXX how to test? *)
1137    "list the LVM logical volumes (LVs)",
1138    "\
1139 List all the logical volumes detected.  This is the equivalent
1140 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1141
1142   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1143    [InitISOFS, Always, TestOutputList (
1144       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1145     InitISOFS, Always, TestOutputList (
1146       [["read_lines"; "/empty"]], [])],
1147    "read file as lines",
1148    "\
1149 Return the contents of the file named C<path>.
1150
1151 The file contents are returned as a list of lines.  Trailing
1152 C<LF> and C<CRLF> character sequences are I<not> returned.
1153
1154 Note that this function cannot correctly handle binary files
1155 (specifically, files containing C<\\0> character which is treated
1156 as end of line).  For those you need to use the C<guestfs_read_file>
1157 function which has a more complex interface.");
1158
1159   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1160    [], (* XXX Augeas code needs tests. *)
1161    "create a new Augeas handle",
1162    "\
1163 Create a new Augeas handle for editing configuration files.
1164 If there was any previous Augeas handle associated with this
1165 guestfs session, then it is closed.
1166
1167 You must call this before using any other C<guestfs_aug_*>
1168 commands.
1169
1170 C<root> is the filesystem root.  C<root> must not be NULL,
1171 use C</> instead.
1172
1173 The flags are the same as the flags defined in
1174 E<lt>augeas.hE<gt>, the logical I<or> of the following
1175 integers:
1176
1177 =over 4
1178
1179 =item C<AUG_SAVE_BACKUP> = 1
1180
1181 Keep the original file with a C<.augsave> extension.
1182
1183 =item C<AUG_SAVE_NEWFILE> = 2
1184
1185 Save changes into a file with extension C<.augnew>, and
1186 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1187
1188 =item C<AUG_TYPE_CHECK> = 4
1189
1190 Typecheck lenses (can be expensive).
1191
1192 =item C<AUG_NO_STDINC> = 8
1193
1194 Do not use standard load path for modules.
1195
1196 =item C<AUG_SAVE_NOOP> = 16
1197
1198 Make save a no-op, just record what would have been changed.
1199
1200 =item C<AUG_NO_LOAD> = 32
1201
1202 Do not load the tree in C<guestfs_aug_init>.
1203
1204 =back
1205
1206 To close the handle, you can call C<guestfs_aug_close>.
1207
1208 To find out more about Augeas, see L<http://augeas.net/>.");
1209
1210   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1211    [], (* XXX Augeas code needs tests. *)
1212    "close the current Augeas handle",
1213    "\
1214 Close the current Augeas handle and free up any resources
1215 used by it.  After calling this, you have to call
1216 C<guestfs_aug_init> again before you can use any other
1217 Augeas functions.");
1218
1219   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1220    [], (* XXX Augeas code needs tests. *)
1221    "define an Augeas variable",
1222    "\
1223 Defines an Augeas variable C<name> whose value is the result
1224 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1225 undefined.
1226
1227 On success this returns the number of nodes in C<expr>, or
1228 C<0> if C<expr> evaluates to something which is not a nodeset.");
1229
1230   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1231    [], (* XXX Augeas code needs tests. *)
1232    "define an Augeas node",
1233    "\
1234 Defines a variable C<name> whose value is the result of
1235 evaluating C<expr>.
1236
1237 If C<expr> evaluates to an empty nodeset, a node is created,
1238 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1239 C<name> will be the nodeset containing that single node.
1240
1241 On success this returns a pair containing the
1242 number of nodes in the nodeset, and a boolean flag
1243 if a node was created.");
1244
1245   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1246    [], (* XXX Augeas code needs tests. *)
1247    "look up the value of an Augeas path",
1248    "\
1249 Look up the value associated with C<path>.  If C<path>
1250 matches exactly one node, the C<value> is returned.");
1251
1252   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1253    [], (* XXX Augeas code needs tests. *)
1254    "set Augeas path to value",
1255    "\
1256 Set the value associated with C<path> to C<value>.");
1257
1258   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1259    [], (* XXX Augeas code needs tests. *)
1260    "insert a sibling Augeas node",
1261    "\
1262 Create a new sibling C<label> for C<path>, inserting it into
1263 the tree before or after C<path> (depending on the boolean
1264 flag C<before>).
1265
1266 C<path> must match exactly one existing node in the tree, and
1267 C<label> must be a label, ie. not contain C</>, C<*> or end
1268 with a bracketed index C<[N]>.");
1269
1270   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1271    [], (* XXX Augeas code needs tests. *)
1272    "remove an Augeas path",
1273    "\
1274 Remove C<path> and all of its children.
1275
1276 On success this returns the number of entries which were removed.");
1277
1278   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1279    [], (* XXX Augeas code needs tests. *)
1280    "move Augeas node",
1281    "\
1282 Move the node C<src> to C<dest>.  C<src> must match exactly
1283 one node.  C<dest> is overwritten if it exists.");
1284
1285   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1286    [], (* XXX Augeas code needs tests. *)
1287    "return Augeas nodes which match augpath",
1288    "\
1289 Returns a list of paths which match the path expression C<path>.
1290 The returned paths are sufficiently qualified so that they match
1291 exactly one node in the current tree.");
1292
1293   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1294    [], (* XXX Augeas code needs tests. *)
1295    "write all pending Augeas changes to disk",
1296    "\
1297 This writes all pending changes to disk.
1298
1299 The flags which were passed to C<guestfs_aug_init> affect exactly
1300 how files are saved.");
1301
1302   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1303    [], (* XXX Augeas code needs tests. *)
1304    "load files into the tree",
1305    "\
1306 Load files into the tree.
1307
1308 See C<aug_load> in the Augeas documentation for the full gory
1309 details.");
1310
1311   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1312    [], (* XXX Augeas code needs tests. *)
1313    "list Augeas nodes under augpath",
1314    "\
1315 This is just a shortcut for listing C<guestfs_aug_match>
1316 C<path/*> and sorting the resulting nodes into alphabetical order.");
1317
1318   ("rm", (RErr, [Pathname "path"]), 29, [],
1319    [InitBasicFS, Always, TestRun
1320       [["touch"; "/new"];
1321        ["rm"; "/new"]];
1322     InitBasicFS, Always, TestLastFail
1323       [["rm"; "/new"]];
1324     InitBasicFS, Always, TestLastFail
1325       [["mkdir"; "/new"];
1326        ["rm"; "/new"]]],
1327    "remove a file",
1328    "\
1329 Remove the single file C<path>.");
1330
1331   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1332    [InitBasicFS, Always, TestRun
1333       [["mkdir"; "/new"];
1334        ["rmdir"; "/new"]];
1335     InitBasicFS, Always, TestLastFail
1336       [["rmdir"; "/new"]];
1337     InitBasicFS, Always, TestLastFail
1338       [["touch"; "/new"];
1339        ["rmdir"; "/new"]]],
1340    "remove a directory",
1341    "\
1342 Remove the single directory C<path>.");
1343
1344   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1345    [InitBasicFS, Always, TestOutputFalse
1346       [["mkdir"; "/new"];
1347        ["mkdir"; "/new/foo"];
1348        ["touch"; "/new/foo/bar"];
1349        ["rm_rf"; "/new"];
1350        ["exists"; "/new"]]],
1351    "remove a file or directory recursively",
1352    "\
1353 Remove the file or directory C<path>, recursively removing the
1354 contents if its a directory.  This is like the C<rm -rf> shell
1355 command.");
1356
1357   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1358    [InitBasicFS, Always, TestOutputTrue
1359       [["mkdir"; "/new"];
1360        ["is_dir"; "/new"]];
1361     InitBasicFS, Always, TestLastFail
1362       [["mkdir"; "/new/foo/bar"]]],
1363    "create a directory",
1364    "\
1365 Create a directory named C<path>.");
1366
1367   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1368    [InitBasicFS, Always, TestOutputTrue
1369       [["mkdir_p"; "/new/foo/bar"];
1370        ["is_dir"; "/new/foo/bar"]];
1371     InitBasicFS, Always, TestOutputTrue
1372       [["mkdir_p"; "/new/foo/bar"];
1373        ["is_dir"; "/new/foo"]];
1374     InitBasicFS, Always, TestOutputTrue
1375       [["mkdir_p"; "/new/foo/bar"];
1376        ["is_dir"; "/new"]];
1377     (* Regression tests for RHBZ#503133: *)
1378     InitBasicFS, Always, TestRun
1379       [["mkdir"; "/new"];
1380        ["mkdir_p"; "/new"]];
1381     InitBasicFS, Always, TestLastFail
1382       [["touch"; "/new"];
1383        ["mkdir_p"; "/new"]]],
1384    "create a directory and parents",
1385    "\
1386 Create a directory named C<path>, creating any parent directories
1387 as necessary.  This is like the C<mkdir -p> shell command.");
1388
1389   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1390    [], (* XXX Need stat command to test *)
1391    "change file mode",
1392    "\
1393 Change the mode (permissions) of C<path> to C<mode>.  Only
1394 numeric modes are supported.
1395
1396 I<Note>: When using this command from guestfish, C<mode>
1397 by default would be decimal, unless you prefix it with
1398 C<0> to get octal, ie. use C<0700> not C<700>.
1399
1400 The mode actually set is affected by the umask.");
1401
1402   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1403    [], (* XXX Need stat command to test *)
1404    "change file owner and group",
1405    "\
1406 Change the file owner to C<owner> and group to C<group>.
1407
1408 Only numeric uid and gid are supported.  If you want to use
1409 names, you will need to locate and parse the password file
1410 yourself (Augeas support makes this relatively easy).");
1411
1412   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1413    [InitISOFS, Always, TestOutputTrue (
1414       [["exists"; "/empty"]]);
1415     InitISOFS, Always, TestOutputTrue (
1416       [["exists"; "/directory"]])],
1417    "test if file or directory exists",
1418    "\
1419 This returns C<true> if and only if there is a file, directory
1420 (or anything) with the given C<path> name.
1421
1422 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1423
1424   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1425    [InitISOFS, Always, TestOutputTrue (
1426       [["is_file"; "/known-1"]]);
1427     InitISOFS, Always, TestOutputFalse (
1428       [["is_file"; "/directory"]])],
1429    "test if file exists",
1430    "\
1431 This returns C<true> if and only if there is a file
1432 with the given C<path> name.  Note that it returns false for
1433 other objects like directories.
1434
1435 See also C<guestfs_stat>.");
1436
1437   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1438    [InitISOFS, Always, TestOutputFalse (
1439       [["is_dir"; "/known-3"]]);
1440     InitISOFS, Always, TestOutputTrue (
1441       [["is_dir"; "/directory"]])],
1442    "test if file exists",
1443    "\
1444 This returns C<true> if and only if there is a directory
1445 with the given C<path> name.  Note that it returns false for
1446 other objects like files.
1447
1448 See also C<guestfs_stat>.");
1449
1450   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1451    [InitEmpty, Always, TestOutputListOfDevices (
1452       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1453        ["pvcreate"; "/dev/sda1"];
1454        ["pvcreate"; "/dev/sda2"];
1455        ["pvcreate"; "/dev/sda3"];
1456        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1457    "create an LVM physical volume",
1458    "\
1459 This creates an LVM physical volume on the named C<device>,
1460 where C<device> should usually be a partition name such
1461 as C</dev/sda1>.");
1462
1463   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1464    [InitEmpty, Always, TestOutputList (
1465       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1466        ["pvcreate"; "/dev/sda1"];
1467        ["pvcreate"; "/dev/sda2"];
1468        ["pvcreate"; "/dev/sda3"];
1469        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1470        ["vgcreate"; "VG2"; "/dev/sda3"];
1471        ["vgs"]], ["VG1"; "VG2"])],
1472    "create an LVM volume group",
1473    "\
1474 This creates an LVM volume group called C<volgroup>
1475 from the non-empty list of physical volumes C<physvols>.");
1476
1477   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1478    [InitEmpty, Always, TestOutputList (
1479       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1480        ["pvcreate"; "/dev/sda1"];
1481        ["pvcreate"; "/dev/sda2"];
1482        ["pvcreate"; "/dev/sda3"];
1483        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1484        ["vgcreate"; "VG2"; "/dev/sda3"];
1485        ["lvcreate"; "LV1"; "VG1"; "50"];
1486        ["lvcreate"; "LV2"; "VG1"; "50"];
1487        ["lvcreate"; "LV3"; "VG2"; "50"];
1488        ["lvcreate"; "LV4"; "VG2"; "50"];
1489        ["lvcreate"; "LV5"; "VG2"; "50"];
1490        ["lvs"]],
1491       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1492        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1493    "create an LVM logical volume",
1494    "\
1495 This creates an LVM logical volume called C<logvol>
1496 on the volume group C<volgroup>, with C<size> megabytes.");
1497
1498   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1499    [InitEmpty, Always, TestOutput (
1500       [["part_disk"; "/dev/sda"; "mbr"];
1501        ["mkfs"; "ext2"; "/dev/sda1"];
1502        ["mount_options"; ""; "/dev/sda1"; "/"];
1503        ["write_file"; "/new"; "new file contents"; "0"];
1504        ["cat"; "/new"]], "new file contents")],
1505    "make a filesystem",
1506    "\
1507 This creates a filesystem on C<device> (usually a partition
1508 or LVM logical volume).  The filesystem type is C<fstype>, for
1509 example C<ext3>.");
1510
1511   ("sfdisk", (RErr, [Device "device";
1512                      Int "cyls"; Int "heads"; Int "sectors";
1513                      StringList "lines"]), 43, [DangerWillRobinson],
1514    [],
1515    "create partitions on a block device",
1516    "\
1517 This is a direct interface to the L<sfdisk(8)> program for creating
1518 partitions on block devices.
1519
1520 C<device> should be a block device, for example C</dev/sda>.
1521
1522 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1523 and sectors on the device, which are passed directly to sfdisk as
1524 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1525 of these, then the corresponding parameter is omitted.  Usually for
1526 'large' disks, you can just pass C<0> for these, but for small
1527 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1528 out the right geometry and you will need to tell it.
1529
1530 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1531 information refer to the L<sfdisk(8)> manpage.
1532
1533 To create a single partition occupying the whole disk, you would
1534 pass C<lines> as a single element list, when the single element being
1535 the string C<,> (comma).
1536
1537 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1538 C<guestfs_part_init>");
1539
1540   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1541    [InitBasicFS, Always, TestOutput (
1542       [["write_file"; "/new"; "new file contents"; "0"];
1543        ["cat"; "/new"]], "new file contents");
1544     InitBasicFS, Always, TestOutput (
1545       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1546        ["cat"; "/new"]], "\nnew file contents\n");
1547     InitBasicFS, Always, TestOutput (
1548       [["write_file"; "/new"; "\n\n"; "0"];
1549        ["cat"; "/new"]], "\n\n");
1550     InitBasicFS, Always, TestOutput (
1551       [["write_file"; "/new"; ""; "0"];
1552        ["cat"; "/new"]], "");
1553     InitBasicFS, Always, TestOutput (
1554       [["write_file"; "/new"; "\n\n\n"; "0"];
1555        ["cat"; "/new"]], "\n\n\n");
1556     InitBasicFS, Always, TestOutput (
1557       [["write_file"; "/new"; "\n"; "0"];
1558        ["cat"; "/new"]], "\n");
1559     (* Regression test for RHBZ#597135. *)
1560     InitBasicFS, Always, TestLastFail
1561       [["write_file"; "/new"; "abc"; "10000"]]],
1562    "create a file",
1563    "\
1564 This call creates a file called C<path>.  The contents of the
1565 file is the string C<content> (which can contain any 8 bit data),
1566 with length C<size>.
1567
1568 As a special case, if C<size> is C<0>
1569 then the length is calculated using C<strlen> (so in this case
1570 the content cannot contain embedded ASCII NULs).
1571
1572 I<NB.> Owing to a bug, writing content containing ASCII NUL
1573 characters does I<not> work, even if the length is specified.
1574 We hope to resolve this bug in a future version.  In the meantime
1575 use C<guestfs_upload>.");
1576
1577   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1578    [InitEmpty, Always, TestOutputListOfDevices (
1579       [["part_disk"; "/dev/sda"; "mbr"];
1580        ["mkfs"; "ext2"; "/dev/sda1"];
1581        ["mount_options"; ""; "/dev/sda1"; "/"];
1582        ["mounts"]], ["/dev/sda1"]);
1583     InitEmpty, Always, TestOutputList (
1584       [["part_disk"; "/dev/sda"; "mbr"];
1585        ["mkfs"; "ext2"; "/dev/sda1"];
1586        ["mount_options"; ""; "/dev/sda1"; "/"];
1587        ["umount"; "/"];
1588        ["mounts"]], [])],
1589    "unmount a filesystem",
1590    "\
1591 This unmounts the given filesystem.  The filesystem may be
1592 specified either by its mountpoint (path) or the device which
1593 contains the filesystem.");
1594
1595   ("mounts", (RStringList "devices", []), 46, [],
1596    [InitBasicFS, Always, TestOutputListOfDevices (
1597       [["mounts"]], ["/dev/sda1"])],
1598    "show mounted filesystems",
1599    "\
1600 This returns the list of currently mounted filesystems.  It returns
1601 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1602
1603 Some internal mounts are not shown.
1604
1605 See also: C<guestfs_mountpoints>");
1606
1607   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1608    [InitBasicFS, Always, TestOutputList (
1609       [["umount_all"];
1610        ["mounts"]], []);
1611     (* check that umount_all can unmount nested mounts correctly: *)
1612     InitEmpty, Always, TestOutputList (
1613       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1614        ["mkfs"; "ext2"; "/dev/sda1"];
1615        ["mkfs"; "ext2"; "/dev/sda2"];
1616        ["mkfs"; "ext2"; "/dev/sda3"];
1617        ["mount_options"; ""; "/dev/sda1"; "/"];
1618        ["mkdir"; "/mp1"];
1619        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1620        ["mkdir"; "/mp1/mp2"];
1621        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1622        ["mkdir"; "/mp1/mp2/mp3"];
1623        ["umount_all"];
1624        ["mounts"]], [])],
1625    "unmount all filesystems",
1626    "\
1627 This unmounts all mounted filesystems.
1628
1629 Some internal mounts are not unmounted by this call.");
1630
1631   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1632    [],
1633    "remove all LVM LVs, VGs and PVs",
1634    "\
1635 This command removes all LVM logical volumes, volume groups
1636 and physical volumes.");
1637
1638   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1639    [InitISOFS, Always, TestOutput (
1640       [["file"; "/empty"]], "empty");
1641     InitISOFS, Always, TestOutput (
1642       [["file"; "/known-1"]], "ASCII text");
1643     InitISOFS, Always, TestLastFail (
1644       [["file"; "/notexists"]])],
1645    "determine file type",
1646    "\
1647 This call uses the standard L<file(1)> command to determine
1648 the type or contents of the file.  This also works on devices,
1649 for example to find out whether a partition contains a filesystem.
1650
1651 This call will also transparently look inside various types
1652 of compressed file.
1653
1654 The exact command which runs is C<file -zbsL path>.  Note in
1655 particular that the filename is not prepended to the output
1656 (the C<-b> option).");
1657
1658   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1659    [InitBasicFS, Always, TestOutput (
1660       [["upload"; "test-command"; "/test-command"];
1661        ["chmod"; "0o755"; "/test-command"];
1662        ["command"; "/test-command 1"]], "Result1");
1663     InitBasicFS, Always, TestOutput (
1664       [["upload"; "test-command"; "/test-command"];
1665        ["chmod"; "0o755"; "/test-command"];
1666        ["command"; "/test-command 2"]], "Result2\n");
1667     InitBasicFS, Always, TestOutput (
1668       [["upload"; "test-command"; "/test-command"];
1669        ["chmod"; "0o755"; "/test-command"];
1670        ["command"; "/test-command 3"]], "\nResult3");
1671     InitBasicFS, Always, TestOutput (
1672       [["upload"; "test-command"; "/test-command"];
1673        ["chmod"; "0o755"; "/test-command"];
1674        ["command"; "/test-command 4"]], "\nResult4\n");
1675     InitBasicFS, Always, TestOutput (
1676       [["upload"; "test-command"; "/test-command"];
1677        ["chmod"; "0o755"; "/test-command"];
1678        ["command"; "/test-command 5"]], "\nResult5\n\n");
1679     InitBasicFS, Always, TestOutput (
1680       [["upload"; "test-command"; "/test-command"];
1681        ["chmod"; "0o755"; "/test-command"];
1682        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1683     InitBasicFS, Always, TestOutput (
1684       [["upload"; "test-command"; "/test-command"];
1685        ["chmod"; "0o755"; "/test-command"];
1686        ["command"; "/test-command 7"]], "");
1687     InitBasicFS, Always, TestOutput (
1688       [["upload"; "test-command"; "/test-command"];
1689        ["chmod"; "0o755"; "/test-command"];
1690        ["command"; "/test-command 8"]], "\n");
1691     InitBasicFS, Always, TestOutput (
1692       [["upload"; "test-command"; "/test-command"];
1693        ["chmod"; "0o755"; "/test-command"];
1694        ["command"; "/test-command 9"]], "\n\n");
1695     InitBasicFS, Always, TestOutput (
1696       [["upload"; "test-command"; "/test-command"];
1697        ["chmod"; "0o755"; "/test-command"];
1698        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1699     InitBasicFS, Always, TestOutput (
1700       [["upload"; "test-command"; "/test-command"];
1701        ["chmod"; "0o755"; "/test-command"];
1702        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1703     InitBasicFS, Always, TestLastFail (
1704       [["upload"; "test-command"; "/test-command"];
1705        ["chmod"; "0o755"; "/test-command"];
1706        ["command"; "/test-command"]])],
1707    "run a command from the guest filesystem",
1708    "\
1709 This call runs a command from the guest filesystem.  The
1710 filesystem must be mounted, and must contain a compatible
1711 operating system (ie. something Linux, with the same
1712 or compatible processor architecture).
1713
1714 The single parameter is an argv-style list of arguments.
1715 The first element is the name of the program to run.
1716 Subsequent elements are parameters.  The list must be
1717 non-empty (ie. must contain a program name).  Note that
1718 the command runs directly, and is I<not> invoked via
1719 the shell (see C<guestfs_sh>).
1720
1721 The return value is anything printed to I<stdout> by
1722 the command.
1723
1724 If the command returns a non-zero exit status, then
1725 this function returns an error message.  The error message
1726 string is the content of I<stderr> from the command.
1727
1728 The C<$PATH> environment variable will contain at least
1729 C</usr/bin> and C</bin>.  If you require a program from
1730 another location, you should provide the full path in the
1731 first parameter.
1732
1733 Shared libraries and data files required by the program
1734 must be available on filesystems which are mounted in the
1735 correct places.  It is the caller's responsibility to ensure
1736 all filesystems that are needed are mounted at the right
1737 locations.");
1738
1739   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1740    [InitBasicFS, Always, TestOutputList (
1741       [["upload"; "test-command"; "/test-command"];
1742        ["chmod"; "0o755"; "/test-command"];
1743        ["command_lines"; "/test-command 1"]], ["Result1"]);
1744     InitBasicFS, Always, TestOutputList (
1745       [["upload"; "test-command"; "/test-command"];
1746        ["chmod"; "0o755"; "/test-command"];
1747        ["command_lines"; "/test-command 2"]], ["Result2"]);
1748     InitBasicFS, Always, TestOutputList (
1749       [["upload"; "test-command"; "/test-command"];
1750        ["chmod"; "0o755"; "/test-command"];
1751        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1752     InitBasicFS, Always, TestOutputList (
1753       [["upload"; "test-command"; "/test-command"];
1754        ["chmod"; "0o755"; "/test-command"];
1755        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1756     InitBasicFS, Always, TestOutputList (
1757       [["upload"; "test-command"; "/test-command"];
1758        ["chmod"; "0o755"; "/test-command"];
1759        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1760     InitBasicFS, Always, TestOutputList (
1761       [["upload"; "test-command"; "/test-command"];
1762        ["chmod"; "0o755"; "/test-command"];
1763        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1764     InitBasicFS, Always, TestOutputList (
1765       [["upload"; "test-command"; "/test-command"];
1766        ["chmod"; "0o755"; "/test-command"];
1767        ["command_lines"; "/test-command 7"]], []);
1768     InitBasicFS, Always, TestOutputList (
1769       [["upload"; "test-command"; "/test-command"];
1770        ["chmod"; "0o755"; "/test-command"];
1771        ["command_lines"; "/test-command 8"]], [""]);
1772     InitBasicFS, Always, TestOutputList (
1773       [["upload"; "test-command"; "/test-command"];
1774        ["chmod"; "0o755"; "/test-command"];
1775        ["command_lines"; "/test-command 9"]], ["";""]);
1776     InitBasicFS, Always, TestOutputList (
1777       [["upload"; "test-command"; "/test-command"];
1778        ["chmod"; "0o755"; "/test-command"];
1779        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1780     InitBasicFS, Always, TestOutputList (
1781       [["upload"; "test-command"; "/test-command"];
1782        ["chmod"; "0o755"; "/test-command"];
1783        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1784    "run a command, returning lines",
1785    "\
1786 This is the same as C<guestfs_command>, but splits the
1787 result into a list of lines.
1788
1789 See also: C<guestfs_sh_lines>");
1790
1791   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1792    [InitISOFS, Always, TestOutputStruct (
1793       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1794    "get file information",
1795    "\
1796 Returns file information for the given C<path>.
1797
1798 This is the same as the C<stat(2)> system call.");
1799
1800   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1801    [InitISOFS, Always, TestOutputStruct (
1802       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1803    "get file information for a symbolic link",
1804    "\
1805 Returns file information for the given C<path>.
1806
1807 This is the same as C<guestfs_stat> except that if C<path>
1808 is a symbolic link, then the link is stat-ed, not the file it
1809 refers to.
1810
1811 This is the same as the C<lstat(2)> system call.");
1812
1813   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1814    [InitISOFS, Always, TestOutputStruct (
1815       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1816    "get file system statistics",
1817    "\
1818 Returns file system statistics for any mounted file system.
1819 C<path> should be a file or directory in the mounted file system
1820 (typically it is the mount point itself, but it doesn't need to be).
1821
1822 This is the same as the C<statvfs(2)> system call.");
1823
1824   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1825    [], (* XXX test *)
1826    "get ext2/ext3/ext4 superblock details",
1827    "\
1828 This returns the contents of the ext2, ext3 or ext4 filesystem
1829 superblock on C<device>.
1830
1831 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1832 manpage for more details.  The list of fields returned isn't
1833 clearly defined, and depends on both the version of C<tune2fs>
1834 that libguestfs was built against, and the filesystem itself.");
1835
1836   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1837    [InitEmpty, Always, TestOutputTrue (
1838       [["blockdev_setro"; "/dev/sda"];
1839        ["blockdev_getro"; "/dev/sda"]])],
1840    "set block device to read-only",
1841    "\
1842 Sets the block device named C<device> to read-only.
1843
1844 This uses the L<blockdev(8)> command.");
1845
1846   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1847    [InitEmpty, Always, TestOutputFalse (
1848       [["blockdev_setrw"; "/dev/sda"];
1849        ["blockdev_getro"; "/dev/sda"]])],
1850    "set block device to read-write",
1851    "\
1852 Sets the block device named C<device> to read-write.
1853
1854 This uses the L<blockdev(8)> command.");
1855
1856   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1857    [InitEmpty, Always, TestOutputTrue (
1858       [["blockdev_setro"; "/dev/sda"];
1859        ["blockdev_getro"; "/dev/sda"]])],
1860    "is block device set to read-only",
1861    "\
1862 Returns a boolean indicating if the block device is read-only
1863 (true if read-only, false if not).
1864
1865 This uses the L<blockdev(8)> command.");
1866
1867   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1868    [InitEmpty, Always, TestOutputInt (
1869       [["blockdev_getss"; "/dev/sda"]], 512)],
1870    "get sectorsize of block device",
1871    "\
1872 This returns the size of sectors on a block device.
1873 Usually 512, but can be larger for modern devices.
1874
1875 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1876 for that).
1877
1878 This uses the L<blockdev(8)> command.");
1879
1880   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1881    [InitEmpty, Always, TestOutputInt (
1882       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1883    "get blocksize of block device",
1884    "\
1885 This returns the block size of a device.
1886
1887 (Note this is different from both I<size in blocks> and
1888 I<filesystem block size>).
1889
1890 This uses the L<blockdev(8)> command.");
1891
1892   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1893    [], (* XXX test *)
1894    "set blocksize of block device",
1895    "\
1896 This sets the block size of a device.
1897
1898 (Note this is different from both I<size in blocks> and
1899 I<filesystem block size>).
1900
1901 This uses the L<blockdev(8)> command.");
1902
1903   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1904    [InitEmpty, Always, TestOutputInt (
1905       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1906    "get total size of device in 512-byte sectors",
1907    "\
1908 This returns the size of the device in units of 512-byte sectors
1909 (even if the sectorsize isn't 512 bytes ... weird).
1910
1911 See also C<guestfs_blockdev_getss> for the real sector size of
1912 the device, and C<guestfs_blockdev_getsize64> for the more
1913 useful I<size in bytes>.
1914
1915 This uses the L<blockdev(8)> command.");
1916
1917   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1918    [InitEmpty, Always, TestOutputInt (
1919       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1920    "get total size of device in bytes",
1921    "\
1922 This returns the size of the device in bytes.
1923
1924 See also C<guestfs_blockdev_getsz>.
1925
1926 This uses the L<blockdev(8)> command.");
1927
1928   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1929    [InitEmpty, Always, TestRun
1930       [["blockdev_flushbufs"; "/dev/sda"]]],
1931    "flush device buffers",
1932    "\
1933 This tells the kernel to flush internal buffers associated
1934 with C<device>.
1935
1936 This uses the L<blockdev(8)> command.");
1937
1938   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1939    [InitEmpty, Always, TestRun
1940       [["blockdev_rereadpt"; "/dev/sda"]]],
1941    "reread partition table",
1942    "\
1943 Reread the partition table on C<device>.
1944
1945 This uses the L<blockdev(8)> command.");
1946
1947   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1948    [InitBasicFS, Always, TestOutput (
1949       (* Pick a file from cwd which isn't likely to change. *)
1950       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1951        ["checksum"; "md5"; "/COPYING.LIB"]],
1952       Digest.to_hex (Digest.file "COPYING.LIB"))],
1953    "upload a file from the local machine",
1954    "\
1955 Upload local file C<filename> to C<remotefilename> on the
1956 filesystem.
1957
1958 C<filename> can also be a named pipe.
1959
1960 See also C<guestfs_download>.");
1961
1962   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1963    [InitBasicFS, Always, TestOutput (
1964       (* Pick a file from cwd which isn't likely to change. *)
1965       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1966        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1967        ["upload"; "testdownload.tmp"; "/upload"];
1968        ["checksum"; "md5"; "/upload"]],
1969       Digest.to_hex (Digest.file "COPYING.LIB"))],
1970    "download a file to the local machine",
1971    "\
1972 Download file C<remotefilename> and save it as C<filename>
1973 on the local machine.
1974
1975 C<filename> can also be a named pipe.
1976
1977 See also C<guestfs_upload>, C<guestfs_cat>.");
1978
1979   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1980    [InitISOFS, Always, TestOutput (
1981       [["checksum"; "crc"; "/known-3"]], "2891671662");
1982     InitISOFS, Always, TestLastFail (
1983       [["checksum"; "crc"; "/notexists"]]);
1984     InitISOFS, Always, TestOutput (
1985       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1986     InitISOFS, Always, TestOutput (
1987       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1988     InitISOFS, Always, TestOutput (
1989       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1990     InitISOFS, Always, TestOutput (
1991       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1992     InitISOFS, Always, TestOutput (
1993       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1994     InitISOFS, Always, TestOutput (
1995       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1996    "compute MD5, SHAx or CRC checksum of file",
1997    "\
1998 This call computes the MD5, SHAx or CRC checksum of the
1999 file named C<path>.
2000
2001 The type of checksum to compute is given by the C<csumtype>
2002 parameter which must have one of the following values:
2003
2004 =over 4
2005
2006 =item C<crc>
2007
2008 Compute the cyclic redundancy check (CRC) specified by POSIX
2009 for the C<cksum> command.
2010
2011 =item C<md5>
2012
2013 Compute the MD5 hash (using the C<md5sum> program).
2014
2015 =item C<sha1>
2016
2017 Compute the SHA1 hash (using the C<sha1sum> program).
2018
2019 =item C<sha224>
2020
2021 Compute the SHA224 hash (using the C<sha224sum> program).
2022
2023 =item C<sha256>
2024
2025 Compute the SHA256 hash (using the C<sha256sum> program).
2026
2027 =item C<sha384>
2028
2029 Compute the SHA384 hash (using the C<sha384sum> program).
2030
2031 =item C<sha512>
2032
2033 Compute the SHA512 hash (using the C<sha512sum> program).
2034
2035 =back
2036
2037 The checksum is returned as a printable string.");
2038
2039   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2040    [InitBasicFS, Always, TestOutput (
2041       [["tar_in"; "../images/helloworld.tar"; "/"];
2042        ["cat"; "/hello"]], "hello\n")],
2043    "unpack tarfile to directory",
2044    "\
2045 This command uploads and unpacks local file C<tarfile> (an
2046 I<uncompressed> tar file) into C<directory>.
2047
2048 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2049
2050   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2051    [],
2052    "pack directory into tarfile",
2053    "\
2054 This command packs the contents of C<directory> and downloads
2055 it to local file C<tarfile>.
2056
2057 To download a compressed tarball, use C<guestfs_tgz_out>.");
2058
2059   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2060    [InitBasicFS, Always, TestOutput (
2061       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2062        ["cat"; "/hello"]], "hello\n")],
2063    "unpack compressed tarball to directory",
2064    "\
2065 This command uploads and unpacks local file C<tarball> (a
2066 I<gzip compressed> tar file) into C<directory>.
2067
2068 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2069
2070   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2071    [],
2072    "pack directory into compressed tarball",
2073    "\
2074 This command packs the contents of C<directory> and downloads
2075 it to local file C<tarball>.
2076
2077 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2078
2079   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2080    [InitBasicFS, Always, TestLastFail (
2081       [["umount"; "/"];
2082        ["mount_ro"; "/dev/sda1"; "/"];
2083        ["touch"; "/new"]]);
2084     InitBasicFS, Always, TestOutput (
2085       [["write_file"; "/new"; "data"; "0"];
2086        ["umount"; "/"];
2087        ["mount_ro"; "/dev/sda1"; "/"];
2088        ["cat"; "/new"]], "data")],
2089    "mount a guest disk, read-only",
2090    "\
2091 This is the same as the C<guestfs_mount> command, but it
2092 mounts the filesystem with the read-only (I<-o ro>) flag.");
2093
2094   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2095    [],
2096    "mount a guest disk with mount options",
2097    "\
2098 This is the same as the C<guestfs_mount> command, but it
2099 allows you to set the mount options as for the
2100 L<mount(8)> I<-o> flag.
2101
2102 If the C<options> parameter is an empty string, then
2103 no options are passed (all options default to whatever
2104 the filesystem uses).");
2105
2106   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2107    [],
2108    "mount a guest disk with mount options and vfstype",
2109    "\
2110 This is the same as the C<guestfs_mount> command, but it
2111 allows you to set both the mount options and the vfstype
2112 as for the L<mount(8)> I<-o> and I<-t> flags.");
2113
2114   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2115    [],
2116    "debugging and internals",
2117    "\
2118 The C<guestfs_debug> command exposes some internals of
2119 C<guestfsd> (the guestfs daemon) that runs inside the
2120 qemu subprocess.
2121
2122 There is no comprehensive help for this command.  You have
2123 to look at the file C<daemon/debug.c> in the libguestfs source
2124 to find out what you can do.");
2125
2126   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2127    [InitEmpty, Always, TestOutputList (
2128       [["part_disk"; "/dev/sda"; "mbr"];
2129        ["pvcreate"; "/dev/sda1"];
2130        ["vgcreate"; "VG"; "/dev/sda1"];
2131        ["lvcreate"; "LV1"; "VG"; "50"];
2132        ["lvcreate"; "LV2"; "VG"; "50"];
2133        ["lvremove"; "/dev/VG/LV1"];
2134        ["lvs"]], ["/dev/VG/LV2"]);
2135     InitEmpty, Always, TestOutputList (
2136       [["part_disk"; "/dev/sda"; "mbr"];
2137        ["pvcreate"; "/dev/sda1"];
2138        ["vgcreate"; "VG"; "/dev/sda1"];
2139        ["lvcreate"; "LV1"; "VG"; "50"];
2140        ["lvcreate"; "LV2"; "VG"; "50"];
2141        ["lvremove"; "/dev/VG"];
2142        ["lvs"]], []);
2143     InitEmpty, Always, TestOutputList (
2144       [["part_disk"; "/dev/sda"; "mbr"];
2145        ["pvcreate"; "/dev/sda1"];
2146        ["vgcreate"; "VG"; "/dev/sda1"];
2147        ["lvcreate"; "LV1"; "VG"; "50"];
2148        ["lvcreate"; "LV2"; "VG"; "50"];
2149        ["lvremove"; "/dev/VG"];
2150        ["vgs"]], ["VG"])],
2151    "remove an LVM logical volume",
2152    "\
2153 Remove an LVM logical volume C<device>, where C<device> is
2154 the path to the LV, such as C</dev/VG/LV>.
2155
2156 You can also remove all LVs in a volume group by specifying
2157 the VG name, C</dev/VG>.");
2158
2159   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2160    [InitEmpty, Always, TestOutputList (
2161       [["part_disk"; "/dev/sda"; "mbr"];
2162        ["pvcreate"; "/dev/sda1"];
2163        ["vgcreate"; "VG"; "/dev/sda1"];
2164        ["lvcreate"; "LV1"; "VG"; "50"];
2165        ["lvcreate"; "LV2"; "VG"; "50"];
2166        ["vgremove"; "VG"];
2167        ["lvs"]], []);
2168     InitEmpty, Always, TestOutputList (
2169       [["part_disk"; "/dev/sda"; "mbr"];
2170        ["pvcreate"; "/dev/sda1"];
2171        ["vgcreate"; "VG"; "/dev/sda1"];
2172        ["lvcreate"; "LV1"; "VG"; "50"];
2173        ["lvcreate"; "LV2"; "VG"; "50"];
2174        ["vgremove"; "VG"];
2175        ["vgs"]], [])],
2176    "remove an LVM volume group",
2177    "\
2178 Remove an LVM volume group C<vgname>, (for example C<VG>).
2179
2180 This also forcibly removes all logical volumes in the volume
2181 group (if any).");
2182
2183   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2184    [InitEmpty, Always, TestOutputListOfDevices (
2185       [["part_disk"; "/dev/sda"; "mbr"];
2186        ["pvcreate"; "/dev/sda1"];
2187        ["vgcreate"; "VG"; "/dev/sda1"];
2188        ["lvcreate"; "LV1"; "VG"; "50"];
2189        ["lvcreate"; "LV2"; "VG"; "50"];
2190        ["vgremove"; "VG"];
2191        ["pvremove"; "/dev/sda1"];
2192        ["lvs"]], []);
2193     InitEmpty, Always, TestOutputListOfDevices (
2194       [["part_disk"; "/dev/sda"; "mbr"];
2195        ["pvcreate"; "/dev/sda1"];
2196        ["vgcreate"; "VG"; "/dev/sda1"];
2197        ["lvcreate"; "LV1"; "VG"; "50"];
2198        ["lvcreate"; "LV2"; "VG"; "50"];
2199        ["vgremove"; "VG"];
2200        ["pvremove"; "/dev/sda1"];
2201        ["vgs"]], []);
2202     InitEmpty, Always, TestOutputListOfDevices (
2203       [["part_disk"; "/dev/sda"; "mbr"];
2204        ["pvcreate"; "/dev/sda1"];
2205        ["vgcreate"; "VG"; "/dev/sda1"];
2206        ["lvcreate"; "LV1"; "VG"; "50"];
2207        ["lvcreate"; "LV2"; "VG"; "50"];
2208        ["vgremove"; "VG"];
2209        ["pvremove"; "/dev/sda1"];
2210        ["pvs"]], [])],
2211    "remove an LVM physical volume",
2212    "\
2213 This wipes a physical volume C<device> so that LVM will no longer
2214 recognise it.
2215
2216 The implementation uses the C<pvremove> command which refuses to
2217 wipe physical volumes that contain any volume groups, so you have
2218 to remove those first.");
2219
2220   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2221    [InitBasicFS, Always, TestOutput (
2222       [["set_e2label"; "/dev/sda1"; "testlabel"];
2223        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2224    "set the ext2/3/4 filesystem label",
2225    "\
2226 This sets the ext2/3/4 filesystem label of the filesystem on
2227 C<device> to C<label>.  Filesystem labels are limited to
2228 16 characters.
2229
2230 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2231 to return the existing label on a filesystem.");
2232
2233   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2234    [],
2235    "get the ext2/3/4 filesystem label",
2236    "\
2237 This returns the ext2/3/4 filesystem label of the filesystem on
2238 C<device>.");
2239
2240   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2241    (let uuid = uuidgen () in
2242     [InitBasicFS, Always, TestOutput (
2243        [["set_e2uuid"; "/dev/sda1"; uuid];
2244         ["get_e2uuid"; "/dev/sda1"]], uuid);
2245      InitBasicFS, Always, TestOutput (
2246        [["set_e2uuid"; "/dev/sda1"; "clear"];
2247         ["get_e2uuid"; "/dev/sda1"]], "");
2248      (* We can't predict what UUIDs will be, so just check the commands run. *)
2249      InitBasicFS, Always, TestRun (
2250        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2251      InitBasicFS, Always, TestRun (
2252        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2253    "set the ext2/3/4 filesystem UUID",
2254    "\
2255 This sets the ext2/3/4 filesystem UUID of the filesystem on
2256 C<device> to C<uuid>.  The format of the UUID and alternatives
2257 such as C<clear>, C<random> and C<time> are described in the
2258 L<tune2fs(8)> manpage.
2259
2260 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2261 to return the existing UUID of a filesystem.");
2262
2263   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2264    [],
2265    "get the ext2/3/4 filesystem UUID",
2266    "\
2267 This returns the ext2/3/4 filesystem UUID of the filesystem on
2268 C<device>.");
2269
2270   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2271    [InitBasicFS, Always, TestOutputInt (
2272       [["umount"; "/dev/sda1"];
2273        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2274     InitBasicFS, Always, TestOutputInt (
2275       [["umount"; "/dev/sda1"];
2276        ["zero"; "/dev/sda1"];
2277        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2278    "run the filesystem checker",
2279    "\
2280 This runs the filesystem checker (fsck) on C<device> which
2281 should have filesystem type C<fstype>.
2282
2283 The returned integer is the status.  See L<fsck(8)> for the
2284 list of status codes from C<fsck>.
2285
2286 Notes:
2287
2288 =over 4
2289
2290 =item *
2291
2292 Multiple status codes can be summed together.
2293
2294 =item *
2295
2296 A non-zero return code can mean \"success\", for example if
2297 errors have been corrected on the filesystem.
2298
2299 =item *
2300
2301 Checking or repairing NTFS volumes is not supported
2302 (by linux-ntfs).
2303
2304 =back
2305
2306 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2307
2308   ("zero", (RErr, [Device "device"]), 85, [],
2309    [InitBasicFS, Always, TestOutput (
2310       [["umount"; "/dev/sda1"];
2311        ["zero"; "/dev/sda1"];
2312        ["file"; "/dev/sda1"]], "data")],
2313    "write zeroes to the device",
2314    "\
2315 This command writes zeroes over the first few blocks of C<device>.
2316
2317 How many blocks are zeroed isn't specified (but it's I<not> enough
2318 to securely wipe the device).  It should be sufficient to remove
2319 any partition tables, filesystem superblocks and so on.
2320
2321 See also: C<guestfs_scrub_device>.");
2322
2323   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2324    (* Test disabled because grub-install incompatible with virtio-blk driver.
2325     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2326     *)
2327    [InitBasicFS, Disabled, TestOutputTrue (
2328       [["grub_install"; "/"; "/dev/sda1"];
2329        ["is_dir"; "/boot"]])],
2330    "install GRUB",
2331    "\
2332 This command installs GRUB (the Grand Unified Bootloader) on
2333 C<device>, with the root directory being C<root>.
2334
2335 Note: If grub-install reports the error
2336 \"No suitable drive was found in the generated device map.\"
2337 it may be that you need to create a C</boot/grub/device.map>
2338 file first that contains the mapping between grub device names
2339 and Linux device names.  It is usually sufficient to create
2340 a file containing:
2341
2342  (hd0) /dev/vda
2343
2344 replacing C</dev/vda> with the name of the installation device.");
2345
2346   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2347    [InitBasicFS, Always, TestOutput (
2348       [["write_file"; "/old"; "file content"; "0"];
2349        ["cp"; "/old"; "/new"];
2350        ["cat"; "/new"]], "file content");
2351     InitBasicFS, Always, TestOutputTrue (
2352       [["write_file"; "/old"; "file content"; "0"];
2353        ["cp"; "/old"; "/new"];
2354        ["is_file"; "/old"]]);
2355     InitBasicFS, Always, TestOutput (
2356       [["write_file"; "/old"; "file content"; "0"];
2357        ["mkdir"; "/dir"];
2358        ["cp"; "/old"; "/dir/new"];
2359        ["cat"; "/dir/new"]], "file content")],
2360    "copy a file",
2361    "\
2362 This copies a file from C<src> to C<dest> where C<dest> is
2363 either a destination filename or destination directory.");
2364
2365   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2366    [InitBasicFS, Always, TestOutput (
2367       [["mkdir"; "/olddir"];
2368        ["mkdir"; "/newdir"];
2369        ["write_file"; "/olddir/file"; "file content"; "0"];
2370        ["cp_a"; "/olddir"; "/newdir"];
2371        ["cat"; "/newdir/olddir/file"]], "file content")],
2372    "copy a file or directory recursively",
2373    "\
2374 This copies a file or directory from C<src> to C<dest>
2375 recursively using the C<cp -a> command.");
2376
2377   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2378    [InitBasicFS, Always, TestOutput (
2379       [["write_file"; "/old"; "file content"; "0"];
2380        ["mv"; "/old"; "/new"];
2381        ["cat"; "/new"]], "file content");
2382     InitBasicFS, Always, TestOutputFalse (
2383       [["write_file"; "/old"; "file content"; "0"];
2384        ["mv"; "/old"; "/new"];
2385        ["is_file"; "/old"]])],
2386    "move a file",
2387    "\
2388 This moves a file from C<src> to C<dest> where C<dest> is
2389 either a destination filename or destination directory.");
2390
2391   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2392    [InitEmpty, Always, TestRun (
2393       [["drop_caches"; "3"]])],
2394    "drop kernel page cache, dentries and inodes",
2395    "\
2396 This instructs the guest kernel to drop its page cache,
2397 and/or dentries and inode caches.  The parameter C<whattodrop>
2398 tells the kernel what precisely to drop, see
2399 L<http://linux-mm.org/Drop_Caches>
2400
2401 Setting C<whattodrop> to 3 should drop everything.
2402
2403 This automatically calls L<sync(2)> before the operation,
2404 so that the maximum guest memory is freed.");
2405
2406   ("dmesg", (RString "kmsgs", []), 91, [],
2407    [InitEmpty, Always, TestRun (
2408       [["dmesg"]])],
2409    "return kernel messages",
2410    "\
2411 This returns the kernel messages (C<dmesg> output) from
2412 the guest kernel.  This is sometimes useful for extended
2413 debugging of problems.
2414
2415 Another way to get the same information is to enable
2416 verbose messages with C<guestfs_set_verbose> or by setting
2417 the environment variable C<LIBGUESTFS_DEBUG=1> before
2418 running the program.");
2419
2420   ("ping_daemon", (RErr, []), 92, [],
2421    [InitEmpty, Always, TestRun (
2422       [["ping_daemon"]])],
2423    "ping the guest daemon",
2424    "\
2425 This is a test probe into the guestfs daemon running inside
2426 the qemu subprocess.  Calling this function checks that the
2427 daemon responds to the ping message, without affecting the daemon
2428 or attached block device(s) in any other way.");
2429
2430   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2431    [InitBasicFS, Always, TestOutputTrue (
2432       [["write_file"; "/file1"; "contents of a file"; "0"];
2433        ["cp"; "/file1"; "/file2"];
2434        ["equal"; "/file1"; "/file2"]]);
2435     InitBasicFS, Always, TestOutputFalse (
2436       [["write_file"; "/file1"; "contents of a file"; "0"];
2437        ["write_file"; "/file2"; "contents of another file"; "0"];
2438        ["equal"; "/file1"; "/file2"]]);
2439     InitBasicFS, Always, TestLastFail (
2440       [["equal"; "/file1"; "/file2"]])],
2441    "test if two files have equal contents",
2442    "\
2443 This compares the two files C<file1> and C<file2> and returns
2444 true if their content is exactly equal, or false otherwise.
2445
2446 The external L<cmp(1)> program is used for the comparison.");
2447
2448   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2449    [InitISOFS, Always, TestOutputList (
2450       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2451     InitISOFS, Always, TestOutputList (
2452       [["strings"; "/empty"]], [])],
2453    "print the printable strings in a file",
2454    "\
2455 This runs the L<strings(1)> command on a file and returns
2456 the list of printable strings found.");
2457
2458   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2459    [InitISOFS, Always, TestOutputList (
2460       [["strings_e"; "b"; "/known-5"]], []);
2461     InitBasicFS, Disabled, TestOutputList (
2462       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2463        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2464    "print the printable strings in a file",
2465    "\
2466 This is like the C<guestfs_strings> command, but allows you to
2467 specify the encoding of strings that are looked for in
2468 the source file C<path>.
2469
2470 Allowed encodings are:
2471
2472 =over 4
2473
2474 =item s
2475
2476 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2477 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2478
2479 =item S
2480
2481 Single 8-bit-byte characters.
2482
2483 =item b
2484
2485 16-bit big endian strings such as those encoded in
2486 UTF-16BE or UCS-2BE.
2487
2488 =item l (lower case letter L)
2489
2490 16-bit little endian such as UTF-16LE and UCS-2LE.
2491 This is useful for examining binaries in Windows guests.
2492
2493 =item B
2494
2495 32-bit big endian such as UCS-4BE.
2496
2497 =item L
2498
2499 32-bit little endian such as UCS-4LE.
2500
2501 =back
2502
2503 The returned strings are transcoded to UTF-8.");
2504
2505   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2506    [InitISOFS, Always, TestOutput (
2507       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2508     (* Test for RHBZ#501888c2 regression which caused large hexdump
2509      * commands to segfault.
2510      *)
2511     InitISOFS, Always, TestRun (
2512       [["hexdump"; "/100krandom"]])],
2513    "dump a file in hexadecimal",
2514    "\
2515 This runs C<hexdump -C> on the given C<path>.  The result is
2516 the human-readable, canonical hex dump of the file.");
2517
2518   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2519    [InitNone, Always, TestOutput (
2520       [["part_disk"; "/dev/sda"; "mbr"];
2521        ["mkfs"; "ext3"; "/dev/sda1"];
2522        ["mount_options"; ""; "/dev/sda1"; "/"];
2523        ["write_file"; "/new"; "test file"; "0"];
2524        ["umount"; "/dev/sda1"];
2525        ["zerofree"; "/dev/sda1"];
2526        ["mount_options"; ""; "/dev/sda1"; "/"];
2527        ["cat"; "/new"]], "test file")],
2528    "zero unused inodes and disk blocks on ext2/3 filesystem",
2529    "\
2530 This runs the I<zerofree> program on C<device>.  This program
2531 claims to zero unused inodes and disk blocks on an ext2/3
2532 filesystem, thus making it possible to compress the filesystem
2533 more effectively.
2534
2535 You should B<not> run this program if the filesystem is
2536 mounted.
2537
2538 It is possible that using this program can damage the filesystem
2539 or data on the filesystem.");
2540
2541   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2542    [],
2543    "resize an LVM physical volume",
2544    "\
2545 This resizes (expands or shrinks) an existing LVM physical
2546 volume to match the new size of the underlying device.");
2547
2548   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2549                        Int "cyls"; Int "heads"; Int "sectors";
2550                        String "line"]), 99, [DangerWillRobinson],
2551    [],
2552    "modify a single partition on a block device",
2553    "\
2554 This runs L<sfdisk(8)> option to modify just the single
2555 partition C<n> (note: C<n> counts from 1).
2556
2557 For other parameters, see C<guestfs_sfdisk>.  You should usually
2558 pass C<0> for the cyls/heads/sectors parameters.
2559
2560 See also: C<guestfs_part_add>");
2561
2562   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2563    [],
2564    "display the partition table",
2565    "\
2566 This displays the partition table on C<device>, in the
2567 human-readable output of the L<sfdisk(8)> command.  It is
2568 not intended to be parsed.
2569
2570 See also: C<guestfs_part_list>");
2571
2572   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2573    [],
2574    "display the kernel geometry",
2575    "\
2576 This displays the kernel's idea of the geometry of C<device>.
2577
2578 The result is in human-readable format, and not designed to
2579 be parsed.");
2580
2581   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2582    [],
2583    "display the disk geometry from the partition table",
2584    "\
2585 This displays the disk geometry of C<device> read from the
2586 partition table.  Especially in the case where the underlying
2587 block device has been resized, this can be different from the
2588 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2589
2590 The result is in human-readable format, and not designed to
2591 be parsed.");
2592
2593   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2594    [],
2595    "activate or deactivate all volume groups",
2596    "\
2597 This command activates or (if C<activate> is false) deactivates
2598 all logical volumes in all volume groups.
2599 If activated, then they are made known to the
2600 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2601 then those devices disappear.
2602
2603 This command is the same as running C<vgchange -a y|n>");
2604
2605   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2606    [],
2607    "activate or deactivate some volume groups",
2608    "\
2609 This command activates or (if C<activate> is false) deactivates
2610 all logical volumes in the listed volume groups C<volgroups>.
2611 If activated, then they are made known to the
2612 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2613 then those devices disappear.
2614
2615 This command is the same as running C<vgchange -a y|n volgroups...>
2616
2617 Note that if C<volgroups> is an empty list then B<all> volume groups
2618 are activated or deactivated.");
2619
2620   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2621    [InitNone, Always, TestOutput (
2622       [["part_disk"; "/dev/sda"; "mbr"];
2623        ["pvcreate"; "/dev/sda1"];
2624        ["vgcreate"; "VG"; "/dev/sda1"];
2625        ["lvcreate"; "LV"; "VG"; "10"];
2626        ["mkfs"; "ext2"; "/dev/VG/LV"];
2627        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2628        ["write_file"; "/new"; "test content"; "0"];
2629        ["umount"; "/"];
2630        ["lvresize"; "/dev/VG/LV"; "20"];
2631        ["e2fsck_f"; "/dev/VG/LV"];
2632        ["resize2fs"; "/dev/VG/LV"];
2633        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2634        ["cat"; "/new"]], "test content");
2635     InitNone, Always, TestRun (
2636       (* Make an LV smaller to test RHBZ#587484. *)
2637       [["part_disk"; "/dev/sda"; "mbr"];
2638        ["pvcreate"; "/dev/sda1"];
2639        ["vgcreate"; "VG"; "/dev/sda1"];
2640        ["lvcreate"; "LV"; "VG"; "20"];
2641        ["lvresize"; "/dev/VG/LV"; "10"]])],
2642    "resize an LVM logical volume",
2643    "\
2644 This resizes (expands or shrinks) an existing LVM logical
2645 volume to C<mbytes>.  When reducing, data in the reduced part
2646 is lost.");
2647
2648   ("resize2fs", (RErr, [Device "device"]), 106, [],
2649    [], (* lvresize tests this *)
2650    "resize an ext2, ext3 or ext4 filesystem",
2651    "\
2652 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2653 the underlying device.
2654
2655 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2656 on the C<device> before calling this command.  For unknown reasons
2657 C<resize2fs> sometimes gives an error about this and sometimes not.
2658 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2659 calling this function.");
2660
2661   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2662    [InitBasicFS, Always, TestOutputList (
2663       [["find"; "/"]], ["lost+found"]);
2664     InitBasicFS, Always, TestOutputList (
2665       [["touch"; "/a"];
2666        ["mkdir"; "/b"];
2667        ["touch"; "/b/c"];
2668        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2669     InitBasicFS, Always, TestOutputList (
2670       [["mkdir_p"; "/a/b/c"];
2671        ["touch"; "/a/b/c/d"];
2672        ["find"; "/a/b/"]], ["c"; "c/d"])],
2673    "find all files and directories",
2674    "\
2675 This command lists out all files and directories, recursively,
2676 starting at C<directory>.  It is essentially equivalent to
2677 running the shell command C<find directory -print> but some
2678 post-processing happens on the output, described below.
2679
2680 This returns a list of strings I<without any prefix>.  Thus
2681 if the directory structure was:
2682
2683  /tmp/a
2684  /tmp/b
2685  /tmp/c/d
2686
2687 then the returned list from C<guestfs_find> C</tmp> would be
2688 4 elements:
2689
2690  a
2691  b
2692  c
2693  c/d
2694
2695 If C<directory> is not a directory, then this command returns
2696 an error.
2697
2698 The returned list is sorted.
2699
2700 See also C<guestfs_find0>.");
2701
2702   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2703    [], (* lvresize tests this *)
2704    "check an ext2/ext3 filesystem",
2705    "\
2706 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2707 filesystem checker on C<device>, noninteractively (C<-p>),
2708 even if the filesystem appears to be clean (C<-f>).
2709
2710 This command is only needed because of C<guestfs_resize2fs>
2711 (q.v.).  Normally you should use C<guestfs_fsck>.");
2712
2713   ("sleep", (RErr, [Int "secs"]), 109, [],
2714    [InitNone, Always, TestRun (
2715       [["sleep"; "1"]])],
2716    "sleep for some seconds",
2717    "\
2718 Sleep for C<secs> seconds.");
2719
2720   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2721    [InitNone, Always, TestOutputInt (
2722       [["part_disk"; "/dev/sda"; "mbr"];
2723        ["mkfs"; "ntfs"; "/dev/sda1"];
2724        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2725     InitNone, Always, TestOutputInt (
2726       [["part_disk"; "/dev/sda"; "mbr"];
2727        ["mkfs"; "ext2"; "/dev/sda1"];
2728        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2729    "probe NTFS volume",
2730    "\
2731 This command runs the L<ntfs-3g.probe(8)> command which probes
2732 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2733 be mounted read-write, and some cannot be mounted at all).
2734
2735 C<rw> is a boolean flag.  Set it to true if you want to test
2736 if the volume can be mounted read-write.  Set it to false if
2737 you want to test if the volume can be mounted read-only.
2738
2739 The return value is an integer which C<0> if the operation
2740 would succeed, or some non-zero value documented in the
2741 L<ntfs-3g.probe(8)> manual page.");
2742
2743   ("sh", (RString "output", [String "command"]), 111, [],
2744    [], (* XXX needs tests *)
2745    "run a command via the shell",
2746    "\
2747 This call runs a command from the guest filesystem via the
2748 guest's C</bin/sh>.
2749
2750 This is like C<guestfs_command>, but passes the command to:
2751
2752  /bin/sh -c \"command\"
2753
2754 Depending on the guest's shell, this usually results in
2755 wildcards being expanded, shell expressions being interpolated
2756 and so on.
2757
2758 All the provisos about C<guestfs_command> apply to this call.");
2759
2760   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2761    [], (* XXX needs tests *)
2762    "run a command via the shell returning lines",
2763    "\
2764 This is the same as C<guestfs_sh>, but splits the result
2765 into a list of lines.
2766
2767 See also: C<guestfs_command_lines>");
2768
2769   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2770    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2771     * code in stubs.c, since all valid glob patterns must start with "/".
2772     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2773     *)
2774    [InitBasicFS, Always, TestOutputList (
2775       [["mkdir_p"; "/a/b/c"];
2776        ["touch"; "/a/b/c/d"];
2777        ["touch"; "/a/b/c/e"];
2778        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2779     InitBasicFS, Always, TestOutputList (
2780       [["mkdir_p"; "/a/b/c"];
2781        ["touch"; "/a/b/c/d"];
2782        ["touch"; "/a/b/c/e"];
2783        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2784     InitBasicFS, Always, TestOutputList (
2785       [["mkdir_p"; "/a/b/c"];
2786        ["touch"; "/a/b/c/d"];
2787        ["touch"; "/a/b/c/e"];
2788        ["glob_expand"; "/a/*/x/*"]], [])],
2789    "expand a wildcard path",
2790    "\
2791 This command searches for all the pathnames matching
2792 C<pattern> according to the wildcard expansion rules
2793 used by the shell.
2794
2795 If no paths match, then this returns an empty list
2796 (note: not an error).
2797
2798 It is just a wrapper around the C L<glob(3)> function
2799 with flags C<GLOB_MARK|GLOB_BRACE>.
2800 See that manual page for more details.");
2801
2802   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2803    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2804       [["scrub_device"; "/dev/sdc"]])],
2805    "scrub (securely wipe) a device",
2806    "\
2807 This command writes patterns over C<device> to make data retrieval
2808 more difficult.
2809
2810 It is an interface to the L<scrub(1)> program.  See that
2811 manual page for more details.");
2812
2813   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2814    [InitBasicFS, Always, TestRun (
2815       [["write_file"; "/file"; "content"; "0"];
2816        ["scrub_file"; "/file"]])],
2817    "scrub (securely wipe) a file",
2818    "\
2819 This command writes patterns over a file to make data retrieval
2820 more difficult.
2821
2822 The file is I<removed> after scrubbing.
2823
2824 It is an interface to the L<scrub(1)> program.  See that
2825 manual page for more details.");
2826
2827   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2828    [], (* XXX needs testing *)
2829    "scrub (securely wipe) free space",
2830    "\
2831 This command creates the directory C<dir> and then fills it
2832 with files until the filesystem is full, and scrubs the files
2833 as for C<guestfs_scrub_file>, and deletes them.
2834 The intention is to scrub any free space on the partition
2835 containing C<dir>.
2836
2837 It is an interface to the L<scrub(1)> program.  See that
2838 manual page for more details.");
2839
2840   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2841    [InitBasicFS, Always, TestRun (
2842       [["mkdir"; "/tmp"];
2843        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2844    "create a temporary directory",
2845    "\
2846 This command creates a temporary directory.  The
2847 C<template> parameter should be a full pathname for the
2848 temporary directory name with the final six characters being
2849 \"XXXXXX\".
2850
2851 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2852 the second one being suitable for Windows filesystems.
2853
2854 The name of the temporary directory that was created
2855 is returned.
2856
2857 The temporary directory is created with mode 0700
2858 and is owned by root.
2859
2860 The caller is responsible for deleting the temporary
2861 directory and its contents after use.
2862
2863 See also: L<mkdtemp(3)>");
2864
2865   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2866    [InitISOFS, Always, TestOutputInt (
2867       [["wc_l"; "/10klines"]], 10000)],
2868    "count lines in a file",
2869    "\
2870 This command counts the lines in a file, using the
2871 C<wc -l> external command.");
2872
2873   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2874    [InitISOFS, Always, TestOutputInt (
2875       [["wc_w"; "/10klines"]], 10000)],
2876    "count words in a file",
2877    "\
2878 This command counts the words in a file, using the
2879 C<wc -w> external command.");
2880
2881   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2882    [InitISOFS, Always, TestOutputInt (
2883       [["wc_c"; "/100kallspaces"]], 102400)],
2884    "count characters in a file",
2885    "\
2886 This command counts the characters in a file, using the
2887 C<wc -c> external command.");
2888
2889   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2890    [InitISOFS, Always, TestOutputList (
2891       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2892    "return first 10 lines of a file",
2893    "\
2894 This command returns up to the first 10 lines of a file as
2895 a list of strings.");
2896
2897   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2898    [InitISOFS, Always, TestOutputList (
2899       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2900     InitISOFS, Always, TestOutputList (
2901       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2902     InitISOFS, Always, TestOutputList (
2903       [["head_n"; "0"; "/10klines"]], [])],
2904    "return first N lines of a file",
2905    "\
2906 If the parameter C<nrlines> is a positive number, this returns the first
2907 C<nrlines> lines of the file C<path>.
2908
2909 If the parameter C<nrlines> is a negative number, this returns lines
2910 from the file C<path>, excluding the last C<nrlines> lines.
2911
2912 If the parameter C<nrlines> is zero, this returns an empty list.");
2913
2914   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2915    [InitISOFS, Always, TestOutputList (
2916       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2917    "return last 10 lines of a file",
2918    "\
2919 This command returns up to the last 10 lines of a file as
2920 a list of strings.");
2921
2922   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2923    [InitISOFS, Always, TestOutputList (
2924       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2925     InitISOFS, Always, TestOutputList (
2926       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2927     InitISOFS, Always, TestOutputList (
2928       [["tail_n"; "0"; "/10klines"]], [])],
2929    "return last N lines of a file",
2930    "\
2931 If the parameter C<nrlines> is a positive number, this returns the last
2932 C<nrlines> lines of the file C<path>.
2933
2934 If the parameter C<nrlines> is a negative number, this returns lines
2935 from the file C<path>, starting with the C<-nrlines>th line.
2936
2937 If the parameter C<nrlines> is zero, this returns an empty list.");
2938
2939   ("df", (RString "output", []), 125, [],
2940    [], (* XXX Tricky to test because it depends on the exact format
2941         * of the 'df' command and other imponderables.
2942         *)
2943    "report file system disk space usage",
2944    "\
2945 This command runs the C<df> command to report disk space used.
2946
2947 This command is mostly useful for interactive sessions.  It
2948 is I<not> intended that you try to parse the output string.
2949 Use C<statvfs> from programs.");
2950
2951   ("df_h", (RString "output", []), 126, [],
2952    [], (* XXX Tricky to test because it depends on the exact format
2953         * of the 'df' command and other imponderables.
2954         *)
2955    "report file system disk space usage (human readable)",
2956    "\
2957 This command runs the C<df -h> command to report disk space used
2958 in human-readable format.
2959
2960 This command is mostly useful for interactive sessions.  It
2961 is I<not> intended that you try to parse the output string.
2962 Use C<statvfs> from programs.");
2963
2964   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2965    [InitISOFS, Always, TestOutputInt (
2966       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2967    "estimate file space usage",
2968    "\
2969 This command runs the C<du -s> command to estimate file space
2970 usage for C<path>.
2971
2972 C<path> can be a file or a directory.  If C<path> is a directory
2973 then the estimate includes the contents of the directory and all
2974 subdirectories (recursively).
2975
2976 The result is the estimated size in I<kilobytes>
2977 (ie. units of 1024 bytes).");
2978
2979   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2980    [InitISOFS, Always, TestOutputList (
2981       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2982    "list files in an initrd",
2983    "\
2984 This command lists out files contained in an initrd.
2985
2986 The files are listed without any initial C</> character.  The
2987 files are listed in the order they appear (not necessarily
2988 alphabetical).  Directory names are listed as separate items.
2989
2990 Old Linux kernels (2.4 and earlier) used a compressed ext2
2991 filesystem as initrd.  We I<only> support the newer initramfs
2992 format (compressed cpio files).");
2993
2994   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2995    [],
2996    "mount a file using the loop device",
2997    "\
2998 This command lets you mount C<file> (a filesystem image
2999 in a file) on a mount point.  It is entirely equivalent to
3000 the command C<mount -o loop file mountpoint>.");
3001
3002   ("mkswap", (RErr, [Device "device"]), 130, [],
3003    [InitEmpty, Always, TestRun (
3004       [["part_disk"; "/dev/sda"; "mbr"];
3005        ["mkswap"; "/dev/sda1"]])],
3006    "create a swap partition",
3007    "\
3008 Create a swap partition on C<device>.");
3009
3010   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3011    [InitEmpty, Always, TestRun (
3012       [["part_disk"; "/dev/sda"; "mbr"];
3013        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3014    "create a swap partition with a label",
3015    "\
3016 Create a swap partition on C<device> with label C<label>.
3017
3018 Note that you cannot attach a swap label to a block device
3019 (eg. C</dev/sda>), just to a partition.  This appears to be
3020 a limitation of the kernel or swap tools.");
3021
3022   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3023    (let uuid = uuidgen () in
3024     [InitEmpty, Always, TestRun (
3025        [["part_disk"; "/dev/sda"; "mbr"];
3026         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3027    "create a swap partition with an explicit UUID",
3028    "\
3029 Create a swap partition on C<device> with UUID C<uuid>.");
3030
3031   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3032    [InitBasicFS, Always, TestOutputStruct (
3033       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3034        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3035        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3036     InitBasicFS, Always, TestOutputStruct (
3037       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3038        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3039    "make block, character or FIFO devices",
3040    "\
3041 This call creates block or character special devices, or
3042 named pipes (FIFOs).
3043
3044 The C<mode> parameter should be the mode, using the standard
3045 constants.  C<devmajor> and C<devminor> are the
3046 device major and minor numbers, only used when creating block
3047 and character special devices.
3048
3049 Note that, just like L<mknod(2)>, the mode must be bitwise
3050 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3051 just creates a regular file).  These constants are
3052 available in the standard Linux header files, or you can use
3053 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3054 which are wrappers around this command which bitwise OR
3055 in the appropriate constant for you.
3056
3057 The mode actually set is affected by the umask.");
3058
3059   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3060    [InitBasicFS, Always, TestOutputStruct (
3061       [["mkfifo"; "0o777"; "/node"];
3062        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3063    "make FIFO (named pipe)",
3064    "\
3065 This call creates a FIFO (named pipe) called C<path> with
3066 mode C<mode>.  It is just a convenient wrapper around
3067 C<guestfs_mknod>.
3068
3069 The mode actually set is affected by the umask.");
3070
3071   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3072    [InitBasicFS, Always, TestOutputStruct (
3073       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3074        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3075    "make block device node",
3076    "\
3077 This call creates a block device node called C<path> with
3078 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3079 It is just a convenient wrapper around C<guestfs_mknod>.
3080
3081 The mode actually set is affected by the umask.");
3082
3083   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3084    [InitBasicFS, Always, TestOutputStruct (
3085       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3086        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3087    "make char device node",
3088    "\
3089 This call creates a char device node called C<path> with
3090 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3091 It is just a convenient wrapper around C<guestfs_mknod>.
3092
3093 The mode actually set is affected by the umask.");
3094
3095   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3096    [InitEmpty, Always, TestOutputInt (
3097       [["umask"; "0o22"]], 0o22)],
3098    "set file mode creation mask (umask)",
3099    "\
3100 This function sets the mask used for creating new files and
3101 device nodes to C<mask & 0777>.
3102
3103 Typical umask values would be C<022> which creates new files
3104 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3105 C<002> which creates new files with permissions like
3106 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3107
3108 The default umask is C<022>.  This is important because it
3109 means that directories and device nodes will be created with
3110 C<0644> or C<0755> mode even if you specify C<0777>.
3111
3112 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3113
3114 This call returns the previous umask.");
3115
3116   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3117    [],
3118    "read directories entries",
3119    "\
3120 This returns the list of directory entries in directory C<dir>.
3121
3122 All entries in the directory are returned, including C<.> and
3123 C<..>.  The entries are I<not> sorted, but returned in the same
3124 order as the underlying filesystem.
3125
3126 Also this call returns basic file type information about each
3127 file.  The C<ftyp> field will contain one of the following characters:
3128
3129 =over 4
3130
3131 =item 'b'
3132
3133 Block special
3134
3135 =item 'c'
3136
3137 Char special
3138
3139 =item 'd'
3140
3141 Directory
3142
3143 =item 'f'
3144
3145 FIFO (named pipe)
3146
3147 =item 'l'
3148
3149 Symbolic link
3150
3151 =item 'r'
3152
3153 Regular file
3154
3155 =item 's'
3156
3157 Socket
3158
3159 =item 'u'
3160
3161 Unknown file type
3162
3163 =item '?'
3164
3165 The L<readdir(3)> call returned a C<d_type> field with an
3166 unexpected value
3167
3168 =back
3169
3170 This function is primarily intended for use by programs.  To
3171 get a simple list of names, use C<guestfs_ls>.  To get a printable
3172 directory for human consumption, use C<guestfs_ll>.");
3173
3174   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3175    [],
3176    "create partitions on a block device",
3177    "\
3178 This is a simplified interface to the C<guestfs_sfdisk>
3179 command, where partition sizes are specified in megabytes
3180 only (rounded to the nearest cylinder) and you don't need
3181 to specify the cyls, heads and sectors parameters which
3182 were rarely if ever used anyway.
3183
3184 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3185 and C<guestfs_part_disk>");
3186
3187   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3188    [],
3189    "determine file type inside a compressed file",
3190    "\
3191 This command runs C<file> after first decompressing C<path>
3192 using C<method>.
3193
3194 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3195
3196 Since 1.0.63, use C<guestfs_file> instead which can now
3197 process compressed files.");
3198
3199   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3200    [],
3201    "list extended attributes of a file or directory",
3202    "\
3203 This call lists the extended attributes of the file or directory
3204 C<path>.
3205
3206 At the system call level, this is a combination of the
3207 L<listxattr(2)> and L<getxattr(2)> calls.
3208
3209 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3210
3211   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3212    [],
3213    "list extended attributes of a file or directory",
3214    "\
3215 This is the same as C<guestfs_getxattrs>, but if C<path>
3216 is a symbolic link, then it returns the extended attributes
3217 of the link itself.");
3218
3219   ("setxattr", (RErr, [String "xattr";
3220                        String "val"; Int "vallen"; (* will be BufferIn *)
3221                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3222    [],
3223    "set extended attribute of a file or directory",
3224    "\
3225 This call sets the extended attribute named C<xattr>
3226 of the file C<path> to the value C<val> (of length C<vallen>).
3227 The value is arbitrary 8 bit data.
3228
3229 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3230
3231   ("lsetxattr", (RErr, [String "xattr";
3232                         String "val"; Int "vallen"; (* will be BufferIn *)
3233                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3234    [],
3235    "set extended attribute of a file or directory",
3236    "\
3237 This is the same as C<guestfs_setxattr>, but if C<path>
3238 is a symbolic link, then it sets an extended attribute
3239 of the link itself.");
3240
3241   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3242    [],
3243    "remove extended attribute of a file or directory",
3244    "\
3245 This call removes the extended attribute named C<xattr>
3246 of the file C<path>.
3247
3248 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3249
3250   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3251    [],
3252    "remove extended attribute of a file or directory",
3253    "\
3254 This is the same as C<guestfs_removexattr>, but if C<path>
3255 is a symbolic link, then it removes an extended attribute
3256 of the link itself.");
3257
3258   ("mountpoints", (RHashtable "mps", []), 147, [],
3259    [],
3260    "show mountpoints",
3261    "\
3262 This call is similar to C<guestfs_mounts>.  That call returns
3263 a list of devices.  This one returns a hash table (map) of
3264 device name to directory where the device is mounted.");
3265
3266   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3267    (* This is a special case: while you would expect a parameter
3268     * of type "Pathname", that doesn't work, because it implies
3269     * NEED_ROOT in the generated calling code in stubs.c, and
3270     * this function cannot use NEED_ROOT.
3271     *)
3272    [],
3273    "create a mountpoint",
3274    "\
3275 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3276 specialized calls that can be used to create extra mountpoints
3277 before mounting the first filesystem.
3278
3279 These calls are I<only> necessary in some very limited circumstances,
3280 mainly the case where you want to mount a mix of unrelated and/or
3281 read-only filesystems together.
3282
3283 For example, live CDs often contain a \"Russian doll\" nest of
3284 filesystems, an ISO outer layer, with a squashfs image inside, with
3285 an ext2/3 image inside that.  You can unpack this as follows
3286 in guestfish:
3287
3288  add-ro Fedora-11-i686-Live.iso
3289  run
3290  mkmountpoint /cd
3291  mkmountpoint /squash
3292  mkmountpoint /ext3
3293  mount /dev/sda /cd
3294  mount-loop /cd/LiveOS/squashfs.img /squash
3295  mount-loop /squash/LiveOS/ext3fs.img /ext3
3296
3297 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3298
3299   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3300    [],
3301    "remove a mountpoint",
3302    "\
3303 This calls removes a mountpoint that was previously created
3304 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3305 for full details.");
3306
3307   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3308    [InitISOFS, Always, TestOutputBuffer (
3309       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3310     (* Test various near large, large and too large files (RHBZ#589039). *)
3311     InitBasicFS, Always, TestLastFail (
3312       [["touch"; "/a"];
3313        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3314        ["read_file"; "/a"]]);
3315     InitBasicFS, Always, TestLastFail (
3316       [["touch"; "/a"];
3317        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3318        ["read_file"; "/a"]]);
3319     InitBasicFS, Always, TestLastFail (
3320       [["touch"; "/a"];
3321        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3322        ["read_file"; "/a"]])],
3323    "read a file",
3324    "\
3325 This calls returns the contents of the file C<path> as a
3326 buffer.
3327
3328 Unlike C<guestfs_cat>, this function can correctly
3329 handle files that contain embedded ASCII NUL characters.
3330 However unlike C<guestfs_download>, this function is limited
3331 in the total size of file that can be handled.");
3332
3333   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3334    [InitISOFS, Always, TestOutputList (
3335       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3336     InitISOFS, Always, TestOutputList (
3337       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3338    "return lines matching a pattern",
3339    "\
3340 This calls the external C<grep> program and returns the
3341 matching lines.");
3342
3343   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3344    [InitISOFS, Always, TestOutputList (
3345       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3346    "return lines matching a pattern",
3347    "\
3348 This calls the external C<egrep> program and returns the
3349 matching lines.");
3350
3351   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3352    [InitISOFS, Always, TestOutputList (
3353       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3354    "return lines matching a pattern",
3355    "\
3356 This calls the external C<fgrep> program and returns the
3357 matching lines.");
3358
3359   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3360    [InitISOFS, Always, TestOutputList (
3361       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3362    "return lines matching a pattern",
3363    "\
3364 This calls the external C<grep -i> program and returns the
3365 matching lines.");
3366
3367   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3368    [InitISOFS, Always, TestOutputList (
3369       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3370    "return lines matching a pattern",
3371    "\
3372 This calls the external C<egrep -i> program and returns the
3373 matching lines.");
3374
3375   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3376    [InitISOFS, Always, TestOutputList (
3377       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3378    "return lines matching a pattern",
3379    "\
3380 This calls the external C<fgrep -i> program and returns the
3381 matching lines.");
3382
3383   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3384    [InitISOFS, Always, TestOutputList (
3385       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3386    "return lines matching a pattern",
3387    "\
3388 This calls the external C<zgrep> program and returns the
3389 matching lines.");
3390
3391   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3392    [InitISOFS, Always, TestOutputList (
3393       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3394    "return lines matching a pattern",
3395    "\
3396 This calls the external C<zegrep> program and returns the
3397 matching lines.");
3398
3399   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3400    [InitISOFS, Always, TestOutputList (
3401       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3402    "return lines matching a pattern",
3403    "\
3404 This calls the external C<zfgrep> program and returns the
3405 matching lines.");
3406
3407   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3408    [InitISOFS, Always, TestOutputList (
3409       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3410    "return lines matching a pattern",
3411    "\
3412 This calls the external C<zgrep -i> program and returns the
3413 matching lines.");
3414
3415   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3416    [InitISOFS, Always, TestOutputList (
3417       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3418    "return lines matching a pattern",
3419    "\
3420 This calls the external C<zegrep -i> program and returns the
3421 matching lines.");
3422
3423   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3424    [InitISOFS, Always, TestOutputList (
3425       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3426    "return lines matching a pattern",
3427    "\
3428 This calls the external C<zfgrep -i> program and returns the
3429 matching lines.");
3430
3431   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3432    [InitISOFS, Always, TestOutput (
3433       [["realpath"; "/../directory"]], "/directory")],
3434    "canonicalized absolute pathname",
3435    "\
3436 Return the canonicalized absolute pathname of C<path>.  The
3437 returned path has no C<.>, C<..> or symbolic link path elements.");
3438
3439   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3440    [InitBasicFS, Always, TestOutputStruct (
3441       [["touch"; "/a"];
3442        ["ln"; "/a"; "/b"];
3443        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3444    "create a hard link",
3445    "\
3446 This command creates a hard link using the C<ln> command.");
3447
3448   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3449    [InitBasicFS, Always, TestOutputStruct (
3450       [["touch"; "/a"];
3451        ["touch"; "/b"];
3452        ["ln_f"; "/a"; "/b"];
3453        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3454    "create a hard link",
3455    "\
3456 This command creates a hard link using the C<ln -f> command.
3457 The C<-f> option removes the link (C<linkname>) if it exists already.");
3458
3459   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3460    [InitBasicFS, Always, TestOutputStruct (
3461       [["touch"; "/a"];
3462        ["ln_s"; "a"; "/b"];
3463        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3464    "create a symbolic link",
3465    "\
3466 This command creates a symbolic link using the C<ln -s> command.");
3467
3468   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3469    [InitBasicFS, Always, TestOutput (
3470       [["mkdir_p"; "/a/b"];
3471        ["touch"; "/a/b/c"];
3472        ["ln_sf"; "../d"; "/a/b/c"];
3473        ["readlink"; "/a/b/c"]], "../d")],
3474    "create a symbolic link",
3475    "\
3476 This command creates a symbolic link using the C<ln -sf> command,
3477 The C<-f> option removes the link (C<linkname>) if it exists already.");
3478
3479   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3480    [] (* XXX tested above *),
3481    "read the target of a symbolic link",
3482    "\
3483 This command reads the target of a symbolic link.");
3484
3485   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3486    [InitBasicFS, Always, TestOutputStruct (
3487       [["fallocate"; "/a"; "1000000"];
3488        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3489    "preallocate a file in the guest filesystem",
3490    "\
3491 This command preallocates a file (containing zero bytes) named
3492 C<path> of size C<len> bytes.  If the file exists already, it
3493 is overwritten.
3494
3495 Do not confuse this with the guestfish-specific
3496 C<alloc> command which allocates a file in the host and
3497 attaches it as a device.");
3498
3499   ("swapon_device", (RErr, [Device "device"]), 170, [],
3500    [InitPartition, Always, TestRun (
3501       [["mkswap"; "/dev/sda1"];
3502        ["swapon_device"; "/dev/sda1"];
3503        ["swapoff_device"; "/dev/sda1"]])],
3504    "enable swap on device",
3505    "\
3506 This command enables the libguestfs appliance to use the
3507 swap device or partition named C<device>.  The increased
3508 memory is made available for all commands, for example
3509 those run using C<guestfs_command> or C<guestfs_sh>.
3510
3511 Note that you should not swap to existing guest swap
3512 partitions unless you know what you are doing.  They may
3513 contain hibernation information, or other information that
3514 the guest doesn't want you to trash.  You also risk leaking
3515 information about the host to the guest this way.  Instead,
3516 attach a new host device to the guest and swap on that.");
3517
3518   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3519    [], (* XXX tested by swapon_device *)
3520    "disable swap on device",
3521    "\
3522 This command disables the libguestfs appliance swap
3523 device or partition named C<device>.
3524 See C<guestfs_swapon_device>.");
3525
3526   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3527    [InitBasicFS, Always, TestRun (
3528       [["fallocate"; "/swap"; "8388608"];
3529        ["mkswap_file"; "/swap"];
3530        ["swapon_file"; "/swap"];
3531        ["swapoff_file"; "/swap"]])],
3532    "enable swap on file",
3533    "\
3534 This command enables swap to a file.
3535 See C<guestfs_swapon_device> for other notes.");
3536
3537   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3538    [], (* XXX tested by swapon_file *)
3539    "disable swap on file",
3540    "\
3541 This command disables the libguestfs appliance swap on file.");
3542
3543   ("swapon_label", (RErr, [String "label"]), 174, [],
3544    [InitEmpty, Always, TestRun (
3545       [["part_disk"; "/dev/sdb"; "mbr"];
3546        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3547        ["swapon_label"; "swapit"];
3548        ["swapoff_label"; "swapit"];
3549        ["zero"; "/dev/sdb"];
3550        ["blockdev_rereadpt"; "/dev/sdb"]])],
3551    "enable swap on labeled swap partition",
3552    "\
3553 This command enables swap to a labeled swap partition.
3554 See C<guestfs_swapon_device> for other notes.");
3555
3556   ("swapoff_label", (RErr, [String "label"]), 175, [],
3557    [], (* XXX tested by swapon_label *)
3558    "disable swap on labeled swap partition",
3559    "\
3560 This command disables the libguestfs appliance swap on
3561 labeled swap partition.");
3562
3563   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3564    (let uuid = uuidgen () in
3565     [InitEmpty, Always, TestRun (
3566        [["mkswap_U"; uuid; "/dev/sdb"];
3567         ["swapon_uuid"; uuid];
3568         ["swapoff_uuid"; uuid]])]),
3569    "enable swap on swap partition by UUID",
3570    "\
3571 This command enables swap to a swap partition with the given UUID.
3572 See C<guestfs_swapon_device> for other notes.");
3573
3574   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3575    [], (* XXX tested by swapon_uuid *)
3576    "disable swap on swap partition by UUID",
3577    "\
3578 This command disables the libguestfs appliance swap partition
3579 with the given UUID.");
3580
3581   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3582    [InitBasicFS, Always, TestRun (
3583       [["fallocate"; "/swap"; "8388608"];
3584        ["mkswap_file"; "/swap"]])],
3585    "create a swap file",
3586    "\
3587 Create a swap file.
3588
3589 This command just writes a swap file signature to an existing
3590 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3591
3592   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3593    [InitISOFS, Always, TestRun (
3594       [["inotify_init"; "0"]])],
3595    "create an inotify handle",
3596    "\
3597 This command creates a new inotify handle.
3598 The inotify subsystem can be used to notify events which happen to
3599 objects in the guest filesystem.
3600
3601 C<maxevents> is the maximum number of events which will be
3602 queued up between calls to C<guestfs_inotify_read> or
3603 C<guestfs_inotify_files>.
3604 If this is passed as C<0>, then the kernel (or previously set)
3605 default is used.  For Linux 2.6.29 the default was 16384 events.
3606 Beyond this limit, the kernel throws away events, but records
3607 the fact that it threw them away by setting a flag
3608 C<IN_Q_OVERFLOW> in the returned structure list (see
3609 C<guestfs_inotify_read>).
3610
3611 Before any events are generated, you have to add some
3612 watches to the internal watch list.  See:
3613 C<guestfs_inotify_add_watch>,
3614 C<guestfs_inotify_rm_watch> and
3615 C<guestfs_inotify_watch_all>.
3616
3617 Queued up events should be read periodically by calling
3618 C<guestfs_inotify_read>
3619 (or C<guestfs_inotify_files> which is just a helpful
3620 wrapper around C<guestfs_inotify_read>).  If you don't
3621 read the events out often enough then you risk the internal
3622 queue overflowing.
3623
3624 The handle should be closed after use by calling
3625 C<guestfs_inotify_close>.  This also removes any
3626 watches automatically.
3627
3628 See also L<inotify(7)> for an overview of the inotify interface
3629 as exposed by the Linux kernel, which is roughly what we expose
3630 via libguestfs.  Note that there is one global inotify handle
3631 per libguestfs instance.");
3632
3633   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3634    [InitBasicFS, Always, TestOutputList (
3635       [["inotify_init"; "0"];
3636        ["inotify_add_watch"; "/"; "1073741823"];
3637        ["touch"; "/a"];
3638        ["touch"; "/b"];
3639        ["inotify_files"]], ["a"; "b"])],
3640    "add an inotify watch",
3641    "\
3642 Watch C<path> for the events listed in C<mask>.
3643
3644 Note that if C<path> is a directory then events within that
3645 directory are watched, but this does I<not> happen recursively
3646 (in subdirectories).
3647
3648 Note for non-C or non-Linux callers: the inotify events are
3649 defined by the Linux kernel ABI and are listed in
3650 C</usr/include/sys/inotify.h>.");
3651
3652   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3653    [],
3654    "remove an inotify watch",
3655    "\
3656 Remove a previously defined inotify watch.
3657 See C<guestfs_inotify_add_watch>.");
3658
3659   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3660    [],
3661    "return list of inotify events",
3662    "\
3663 Return the complete queue of events that have happened
3664 since the previous read call.
3665
3666 If no events have happened, this returns an empty list.
3667
3668 I<Note>: In order to make sure that all events have been
3669 read, you must call this function repeatedly until it
3670 returns an empty list.  The reason is that the call will
3671 read events up to the maximum appliance-to-host message
3672 size and leave remaining events in the queue.");
3673
3674   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3675    [],
3676    "return list of watched files that had events",
3677    "\
3678 This function is a helpful wrapper around C<guestfs_inotify_read>
3679 which just returns a list of pathnames of objects that were
3680 touched.  The returned pathnames are sorted and deduplicated.");
3681
3682   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3683    [],
3684    "close the inotify handle",
3685    "\
3686 This closes the inotify handle which was previously
3687 opened by inotify_init.  It removes all watches, throws
3688 away any pending events, and deallocates all resources.");
3689
3690   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3691    [],
3692    "set SELinux security context",
3693    "\
3694 This sets the SELinux security context of the daemon
3695 to the string C<context>.
3696
3697 See the documentation about SELINUX in L<guestfs(3)>.");
3698
3699   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3700    [],
3701    "get SELinux security context",
3702    "\
3703 This gets the SELinux security context of the daemon.
3704
3705 See the documentation about SELINUX in L<guestfs(3)>,
3706 and C<guestfs_setcon>");
3707
3708   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3709    [InitEmpty, Always, TestOutput (
3710       [["part_disk"; "/dev/sda"; "mbr"];
3711        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3712        ["mount_options"; ""; "/dev/sda1"; "/"];
3713        ["write_file"; "/new"; "new file contents"; "0"];
3714        ["cat"; "/new"]], "new file contents")],
3715    "make a filesystem with block size",
3716    "\
3717 This call is similar to C<guestfs_mkfs>, but it allows you to
3718 control the block size of the resulting filesystem.  Supported
3719 block sizes depend on the filesystem type, but typically they
3720 are C<1024>, C<2048> or C<4096> only.");
3721
3722   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3723    [InitEmpty, Always, TestOutput (
3724       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3725        ["mke2journal"; "4096"; "/dev/sda1"];
3726        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3727        ["mount_options"; ""; "/dev/sda2"; "/"];
3728        ["write_file"; "/new"; "new file contents"; "0"];
3729        ["cat"; "/new"]], "new file contents")],
3730    "make ext2/3/4 external journal",
3731    "\
3732 This creates an ext2 external journal on C<device>.  It is equivalent
3733 to the command:
3734
3735  mke2fs -O journal_dev -b blocksize device");
3736
3737   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3738    [InitEmpty, Always, TestOutput (
3739       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3740        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3741        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3742        ["mount_options"; ""; "/dev/sda2"; "/"];
3743        ["write_file"; "/new"; "new file contents"; "0"];
3744        ["cat"; "/new"]], "new file contents")],
3745    "make ext2/3/4 external journal with label",
3746    "\
3747 This creates an ext2 external journal on C<device> with label C<label>.");
3748
3749   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3750    (let uuid = uuidgen () in
3751     [InitEmpty, Always, TestOutput (
3752        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3753         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3754         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3755         ["mount_options"; ""; "/dev/sda2"; "/"];
3756         ["write_file"; "/new"; "new file contents"; "0"];
3757         ["cat"; "/new"]], "new file contents")]),
3758    "make ext2/3/4 external journal with UUID",
3759    "\
3760 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3761
3762   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3763    [],
3764    "make ext2/3/4 filesystem with external journal",
3765    "\
3766 This creates an ext2/3/4 filesystem on C<device> with
3767 an external journal on C<journal>.  It is equivalent
3768 to the command:
3769
3770  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3771
3772 See also C<guestfs_mke2journal>.");
3773
3774   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3775    [],
3776    "make ext2/3/4 filesystem with external journal",
3777    "\
3778 This creates an ext2/3/4 filesystem on C<device> with
3779 an external journal on the journal labeled C<label>.
3780
3781 See also C<guestfs_mke2journal_L>.");
3782
3783   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3784    [],
3785    "make ext2/3/4 filesystem with external journal",
3786    "\
3787 This creates an ext2/3/4 filesystem on C<device> with
3788 an external journal on the journal with UUID C<uuid>.
3789
3790 See also C<guestfs_mke2journal_U>.");
3791
3792   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3793    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3794    "load a kernel module",
3795    "\
3796 This loads a kernel module in the appliance.
3797
3798 The kernel module must have been whitelisted when libguestfs
3799 was built (see C<appliance/kmod.whitelist.in> in the source).");
3800
3801   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3802    [InitNone, Always, TestOutput (
3803       [["echo_daemon"; "This is a test"]], "This is a test"
3804     )],
3805    "echo arguments back to the client",
3806    "\
3807 This command concatenates the list of C<words> passed with single spaces
3808 between them and returns the resulting string.
3809
3810 You can use this command to test the connection through to the daemon.
3811
3812 See also C<guestfs_ping_daemon>.");
3813
3814   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3815    [], (* There is a regression test for this. *)
3816    "find all files and directories, returning NUL-separated list",
3817    "\
3818 This command lists out all files and directories, recursively,
3819 starting at C<directory>, placing the resulting list in the
3820 external file called C<files>.
3821
3822 This command works the same way as C<guestfs_find> with the
3823 following exceptions:
3824
3825 =over 4
3826
3827 =item *
3828
3829 The resulting list is written to an external file.
3830
3831 =item *
3832
3833 Items (filenames) in the result are separated
3834 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3835
3836 =item *
3837
3838 This command is not limited in the number of names that it
3839 can return.
3840
3841 =item *
3842
3843 The result list is not sorted.
3844
3845 =back");
3846
3847   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3848    [InitISOFS, Always, TestOutput (
3849       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3850     InitISOFS, Always, TestOutput (
3851       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3852     InitISOFS, Always, TestOutput (
3853       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3854     InitISOFS, Always, TestLastFail (
3855       [["case_sensitive_path"; "/Known-1/"]]);
3856     InitBasicFS, Always, TestOutput (
3857       [["mkdir"; "/a"];
3858        ["mkdir"; "/a/bbb"];
3859        ["touch"; "/a/bbb/c"];
3860        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3861     InitBasicFS, Always, TestOutput (
3862       [["mkdir"; "/a"];
3863        ["mkdir"; "/a/bbb"];
3864        ["touch"; "/a/bbb/c"];
3865        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3866     InitBasicFS, Always, TestLastFail (
3867       [["mkdir"; "/a"];
3868        ["mkdir"; "/a/bbb"];
3869        ["touch"; "/a/bbb/c"];
3870        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3871    "return true path on case-insensitive filesystem",
3872    "\
3873 This can be used to resolve case insensitive paths on
3874 a filesystem which is case sensitive.  The use case is
3875 to resolve paths which you have read from Windows configuration
3876 files or the Windows Registry, to the true path.
3877
3878 The command handles a peculiarity of the Linux ntfs-3g
3879 filesystem driver (and probably others), which is that although
3880 the underlying filesystem is case-insensitive, the driver
3881 exports the filesystem to Linux as case-sensitive.
3882
3883 One consequence of this is that special directories such
3884 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3885 (or other things) depending on the precise details of how
3886 they were created.  In Windows itself this would not be
3887 a problem.
3888
3889 Bug or feature?  You decide:
3890 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3891
3892 This function resolves the true case of each element in the
3893 path and returns the case-sensitive path.
3894
3895 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3896 might return C<\"/WINDOWS/system32\"> (the exact return value
3897 would depend on details of how the directories were originally
3898 created under Windows).
3899
3900 I<Note>:
3901 This function does not handle drive names, backslashes etc.
3902
3903 See also C<guestfs_realpath>.");
3904
3905   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3906    [InitBasicFS, Always, TestOutput (
3907       [["vfs_type"; "/dev/sda1"]], "ext2")],
3908    "get the Linux VFS type corresponding to a mounted device",
3909    "\
3910 This command gets the filesystem type corresponding to
3911 the filesystem on C<device>.
3912
3913 For most filesystems, the result is the name of the Linux
3914 VFS module which would be used to mount this filesystem
3915 if you mounted it without specifying the filesystem type.
3916 For example a string such as C<ext3> or C<ntfs>.");
3917
3918   ("truncate", (RErr, [Pathname "path"]), 199, [],
3919    [InitBasicFS, Always, TestOutputStruct (
3920       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3921        ["truncate"; "/test"];
3922        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3923    "truncate a file to zero size",
3924    "\
3925 This command truncates C<path> to a zero-length file.  The
3926 file must exist already.");
3927
3928   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3929    [InitBasicFS, Always, TestOutputStruct (
3930       [["touch"; "/test"];
3931        ["truncate_size"; "/test"; "1000"];
3932        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3933    "truncate a file to a particular size",
3934    "\
3935 This command truncates C<path> to size C<size> bytes.  The file
3936 must exist already.
3937
3938 If the current file size is less than C<size> then
3939 the file is extended to the required size with zero bytes.
3940 This creates a sparse file (ie. disk blocks are not allocated
3941 for the file until you write to it).  To create a non-sparse
3942 file of zeroes, use C<guestfs_fallocate64> instead.");
3943
3944   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3945    [InitBasicFS, Always, TestOutputStruct (
3946       [["touch"; "/test"];
3947        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3948        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3949    "set timestamp of a file with nanosecond precision",
3950    "\
3951 This command sets the timestamps of a file with nanosecond
3952 precision.
3953
3954 C<atsecs, atnsecs> are the last access time (atime) in secs and
3955 nanoseconds from the epoch.
3956
3957 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3958 secs and nanoseconds from the epoch.
3959
3960 If the C<*nsecs> field contains the special value C<-1> then
3961 the corresponding timestamp is set to the current time.  (The
3962 C<*secs> field is ignored in this case).
3963
3964 If the C<*nsecs> field contains the special value C<-2> then
3965 the corresponding timestamp is left unchanged.  (The
3966 C<*secs> field is ignored in this case).");
3967
3968   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3969    [InitBasicFS, Always, TestOutputStruct (
3970       [["mkdir_mode"; "/test"; "0o111"];
3971        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3972    "create a directory with a particular mode",
3973    "\
3974 This command creates a directory, setting the initial permissions
3975 of the directory to C<mode>.
3976
3977 For common Linux filesystems, the actual mode which is set will
3978 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3979 interpret the mode in other ways.
3980
3981 See also C<guestfs_mkdir>, C<guestfs_umask>");
3982
3983   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3984    [], (* XXX *)
3985    "change file owner and group",
3986    "\
3987 Change the file owner to C<owner> and group to C<group>.
3988 This is like C<guestfs_chown> but if C<path> is a symlink then
3989 the link itself is changed, not the target.
3990
3991 Only numeric uid and gid are supported.  If you want to use
3992 names, you will need to locate and parse the password file
3993 yourself (Augeas support makes this relatively easy).");
3994
3995   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3996    [], (* XXX *)
3997    "lstat on multiple files",
3998    "\
3999 This call allows you to perform the C<guestfs_lstat> operation
4000 on multiple files, where all files are in the directory C<path>.
4001 C<names> is the list of files from this directory.
4002
4003 On return you get a list of stat structs, with a one-to-one
4004 correspondence to the C<names> list.  If any name did not exist
4005 or could not be lstat'd, then the C<ino> field of that structure
4006 is set to C<-1>.
4007
4008 This call is intended for programs that want to efficiently
4009 list a directory contents without making many round-trips.
4010 See also C<guestfs_lxattrlist> for a similarly efficient call
4011 for getting extended attributes.  Very long directory listings
4012 might cause the protocol message size to be exceeded, causing
4013 this call to fail.  The caller must split up such requests
4014 into smaller groups of names.");
4015
4016   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4017    [], (* XXX *)
4018    "lgetxattr on multiple files",
4019    "\
4020 This call allows you to get the extended attributes
4021 of multiple files, where all files are in the directory C<path>.
4022 C<names> is the list of files from this directory.
4023
4024 On return you get a flat list of xattr structs which must be
4025 interpreted sequentially.  The first xattr struct always has a zero-length
4026 C<attrname>.  C<attrval> in this struct is zero-length
4027 to indicate there was an error doing C<lgetxattr> for this
4028 file, I<or> is a C string which is a decimal number
4029 (the number of following attributes for this file, which could
4030 be C<\"0\">).  Then after the first xattr struct are the
4031 zero or more attributes for the first named file.
4032 This repeats for the second and subsequent files.
4033
4034 This call is intended for programs that want to efficiently
4035 list a directory contents without making many round-trips.
4036 See also C<guestfs_lstatlist> for a similarly efficient call
4037 for getting standard stats.  Very long directory listings
4038 might cause the protocol message size to be exceeded, causing
4039 this call to fail.  The caller must split up such requests
4040 into smaller groups of names.");
4041
4042   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4043    [], (* XXX *)
4044    "readlink on multiple files",
4045    "\
4046 This call allows you to do a C<readlink> operation
4047 on multiple files, where all files are in the directory C<path>.
4048 C<names> is the list of files from this directory.
4049
4050 On return you get a list of strings, with a one-to-one
4051 correspondence to the C<names> list.  Each string is the
4052 value of the symbolic link.
4053
4054 If the C<readlink(2)> operation fails on any name, then
4055 the corresponding result string is the empty string C<\"\">.
4056 However the whole operation is completed even if there
4057 were C<readlink(2)> errors, and so you can call this
4058 function with names where you don't know if they are
4059 symbolic links already (albeit slightly less efficient).
4060
4061 This call is intended for programs that want to efficiently
4062 list a directory contents without making many round-trips.
4063 Very long directory listings might cause the protocol
4064 message size to be exceeded, causing
4065 this call to fail.  The caller must split up such requests
4066 into smaller groups of names.");
4067
4068   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4069    [InitISOFS, Always, TestOutputBuffer (
4070       [["pread"; "/known-4"; "1"; "3"]], "\n");
4071     InitISOFS, Always, TestOutputBuffer (
4072       [["pread"; "/empty"; "0"; "100"]], "")],
4073    "read part of a file",
4074    "\
4075 This command lets you read part of a file.  It reads C<count>
4076 bytes of the file, starting at C<offset>, from file C<path>.
4077
4078 This may read fewer bytes than requested.  For further details
4079 see the L<pread(2)> system call.");
4080
4081   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4082    [InitEmpty, Always, TestRun (
4083       [["part_init"; "/dev/sda"; "gpt"]])],
4084    "create an empty partition table",
4085    "\
4086 This creates an empty partition table on C<device> of one of the
4087 partition types listed below.  Usually C<parttype> should be
4088 either C<msdos> or C<gpt> (for large disks).
4089
4090 Initially there are no partitions.  Following this, you should
4091 call C<guestfs_part_add> for each partition required.
4092
4093 Possible values for C<parttype> are:
4094
4095 =over 4
4096
4097 =item B<efi> | B<gpt>
4098
4099 Intel EFI / GPT partition table.
4100
4101 This is recommended for >= 2 TB partitions that will be accessed
4102 from Linux and Intel-based Mac OS X.  It also has limited backwards
4103 compatibility with the C<mbr> format.
4104
4105 =item B<mbr> | B<msdos>
4106
4107 The standard PC \"Master Boot Record\" (MBR) format used
4108 by MS-DOS and Windows.  This partition type will B<only> work
4109 for device sizes up to 2 TB.  For large disks we recommend
4110 using C<gpt>.
4111
4112 =back
4113
4114 Other partition table types that may work but are not
4115 supported include:
4116
4117 =over 4
4118
4119 =item B<aix>
4120
4121 AIX disk labels.
4122
4123 =item B<amiga> | B<rdb>
4124
4125 Amiga \"Rigid Disk Block\" format.
4126
4127 =item B<bsd>
4128
4129 BSD disk labels.
4130
4131 =item B<dasd>
4132
4133 DASD, used on IBM mainframes.
4134
4135 =item B<dvh>
4136
4137 MIPS/SGI volumes.
4138
4139 =item B<mac>
4140
4141 Old Mac partition format.  Modern Macs use C<gpt>.
4142
4143 =item B<pc98>
4144
4145 NEC PC-98 format, common in Japan apparently.
4146
4147 =item B<sun>
4148
4149 Sun disk labels.
4150
4151 =back");
4152
4153   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4154    [InitEmpty, Always, TestRun (
4155       [["part_init"; "/dev/sda"; "mbr"];
4156        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4157     InitEmpty, Always, TestRun (
4158       [["part_init"; "/dev/sda"; "gpt"];
4159        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4160        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4161     InitEmpty, Always, TestRun (
4162       [["part_init"; "/dev/sda"; "mbr"];
4163        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4164        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4165        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4166        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4167    "add a partition to the device",
4168    "\
4169 This command adds a partition to C<device>.  If there is no partition
4170 table on the device, call C<guestfs_part_init> first.
4171
4172 The C<prlogex> parameter is the type of partition.  Normally you
4173 should pass C<p> or C<primary> here, but MBR partition tables also
4174 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4175 types.
4176
4177 C<startsect> and C<endsect> are the start and end of the partition
4178 in I<sectors>.  C<endsect> may be negative, which means it counts
4179 backwards from the end of the disk (C<-1> is the last sector).
4180
4181 Creating a partition which covers the whole disk is not so easy.
4182 Use C<guestfs_part_disk> to do that.");
4183
4184   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4185    [InitEmpty, Always, TestRun (
4186       [["part_disk"; "/dev/sda"; "mbr"]]);
4187     InitEmpty, Always, TestRun (
4188       [["part_disk"; "/dev/sda"; "gpt"]])],
4189    "partition whole disk with a single primary partition",
4190    "\
4191 This command is simply a combination of C<guestfs_part_init>
4192 followed by C<guestfs_part_add> to create a single primary partition
4193 covering the whole disk.
4194
4195 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4196 but other possible values are described in C<guestfs_part_init>.");
4197
4198   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4199    [InitEmpty, Always, TestRun (
4200       [["part_disk"; "/dev/sda"; "mbr"];
4201        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4202    "make a partition bootable",
4203    "\
4204 This sets the bootable flag on partition numbered C<partnum> on
4205 device C<device>.  Note that partitions are numbered from 1.
4206
4207 The bootable flag is used by some operating systems (notably
4208 Windows) to determine which partition to boot from.  It is by
4209 no means universally recognized.");
4210
4211   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4212    [InitEmpty, Always, TestRun (
4213       [["part_disk"; "/dev/sda"; "gpt"];
4214        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4215    "set partition name",
4216    "\
4217 This sets the partition name on partition numbered C<partnum> on
4218 device C<device>.  Note that partitions are numbered from 1.
4219
4220 The partition name can only be set on certain types of partition
4221 table.  This works on C<gpt> but not on C<mbr> partitions.");
4222
4223   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4224    [], (* XXX Add a regression test for this. *)
4225    "list partitions on a device",
4226    "\
4227 This command parses the partition table on C<device> and
4228 returns the list of partitions found.
4229
4230 The fields in the returned structure are:
4231
4232 =over 4
4233
4234 =item B<part_num>
4235
4236 Partition number, counting from 1.
4237
4238 =item B<part_start>
4239
4240 Start of the partition I<in bytes>.  To get sectors you have to
4241 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4242
4243 =item B<part_end>
4244
4245 End of the partition in bytes.
4246
4247 =item B<part_size>
4248
4249 Size of the partition in bytes.
4250
4251 =back");
4252
4253   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4254    [InitEmpty, Always, TestOutput (
4255       [["part_disk"; "/dev/sda"; "gpt"];
4256        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4257    "get the partition table type",
4258    "\
4259 This command examines the partition table on C<device> and
4260 returns the partition table type (format) being used.
4261
4262 Common return values include: C<msdos> (a DOS/Windows style MBR
4263 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4264 values are possible, although unusual.  See C<guestfs_part_init>
4265 for a full list.");
4266
4267   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4268    [InitBasicFS, Always, TestOutputBuffer (
4269       [["fill"; "0x63"; "10"; "/test"];
4270        ["read_file"; "/test"]], "cccccccccc")],
4271    "fill a file with octets",
4272    "\
4273 This command creates a new file called C<path>.  The initial
4274 content of the file is C<len> octets of C<c>, where C<c>
4275 must be a number in the range C<[0..255]>.
4276
4277 To fill a file with zero bytes (sparsely), it is
4278 much more efficient to use C<guestfs_truncate_size>.");
4279
4280   ("available", (RErr, [StringList "groups"]), 216, [],
4281    [InitNone, Always, TestRun [["available"; ""]]],
4282    "test availability of some parts of the API",
4283    "\
4284 This command is used to check the availability of some
4285 groups of functionality in the appliance, which not all builds of
4286 the libguestfs appliance will be able to provide.
4287
4288 The libguestfs groups, and the functions that those
4289 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4290
4291 The argument C<groups> is a list of group names, eg:
4292 C<[\"inotify\", \"augeas\"]> would check for the availability of
4293 the Linux inotify functions and Augeas (configuration file
4294 editing) functions.
4295
4296 The command returns no error if I<all> requested groups are available.
4297
4298 It fails with an error if one or more of the requested
4299 groups is unavailable in the appliance.
4300
4301 If an unknown group name is included in the
4302 list of groups then an error is always returned.
4303
4304 I<Notes:>
4305
4306 =over 4
4307
4308 =item *
4309
4310 You must call C<guestfs_launch> before calling this function.
4311
4312 The reason is because we don't know what groups are
4313 supported by the appliance/daemon until it is running and can
4314 be queried.
4315
4316 =item *
4317
4318 If a group of functions is available, this does not necessarily
4319 mean that they will work.  You still have to check for errors
4320 when calling individual API functions even if they are
4321 available.
4322
4323 =item *
4324
4325 It is usually the job of distro packagers to build
4326 complete functionality into the libguestfs appliance.
4327 Upstream libguestfs, if built from source with all
4328 requirements satisfied, will support everything.
4329
4330 =item *
4331
4332 This call was added in version C<1.0.80>.  In previous
4333 versions of libguestfs all you could do would be to speculatively
4334 execute a command to find out if the daemon implemented it.
4335 See also C<guestfs_version>.
4336
4337 =back");
4338
4339   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4340    [InitBasicFS, Always, TestOutputBuffer (
4341       [["write_file"; "/src"; "hello, world"; "0"];
4342        ["dd"; "/src"; "/dest"];
4343        ["read_file"; "/dest"]], "hello, world")],
4344    "copy from source to destination using dd",
4345    "\
4346 This command copies from one source device or file C<src>
4347 to another destination device or file C<dest>.  Normally you
4348 would use this to copy to or from a device or partition, for
4349 example to duplicate a filesystem.
4350
4351 If the destination is a device, it must be as large or larger
4352 than the source file or device, otherwise the copy will fail.
4353 This command cannot do partial copies (see C<guestfs_copy_size>).");
4354
4355   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4356    [InitBasicFS, Always, TestOutputInt (
4357       [["write_file"; "/file"; "hello, world"; "0"];
4358        ["filesize"; "/file"]], 12)],
4359    "return the size of the file in bytes",
4360    "\
4361 This command returns the size of C<file> in bytes.
4362
4363 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4364 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4365 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4366
4367   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4368    [InitBasicFSonLVM, Always, TestOutputList (
4369       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4370        ["lvs"]], ["/dev/VG/LV2"])],
4371    "rename an LVM logical volume",
4372    "\
4373 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4374
4375   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4376    [InitBasicFSonLVM, Always, TestOutputList (
4377       [["umount"; "/"];
4378        ["vg_activate"; "false"; "VG"];
4379        ["vgrename"; "VG"; "VG2"];
4380        ["vg_activate"; "true"; "VG2"];
4381        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4382        ["vgs"]], ["VG2"])],
4383    "rename an LVM volume group",
4384    "\
4385 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4386
4387   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4388    [InitISOFS, Always, TestOutputBuffer (
4389       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4390    "list the contents of a single file in an initrd",
4391    "\
4392 This command unpacks the file C<filename> from the initrd file
4393 called C<initrdpath>.  The filename must be given I<without> the
4394 initial C</> character.
4395
4396 For example, in guestfish you could use the following command
4397 to examine the boot script (usually called C</init>)
4398 contained in a Linux initrd or initramfs image:
4399
4400  initrd-cat /boot/initrd-<version>.img init
4401
4402 See also C<guestfs_initrd_list>.");
4403
4404   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4405    [],
4406    "get the UUID of a physical volume",
4407    "\
4408 This command returns the UUID of the LVM PV C<device>.");
4409
4410   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4411    [],
4412    "get the UUID of a volume group",
4413    "\
4414 This command returns the UUID of the LVM VG named C<vgname>.");
4415
4416   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4417    [],
4418    "get the UUID of a logical volume",
4419    "\
4420 This command returns the UUID of the LVM LV C<device>.");
4421
4422   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4423    [],
4424    "get the PV UUIDs containing the volume group",
4425    "\
4426 Given a VG called C<vgname>, this returns the UUIDs of all
4427 the physical volumes that this volume group resides on.
4428
4429 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4430 calls to associate physical volumes and volume groups.
4431
4432 See also C<guestfs_vglvuuids>.");
4433
4434   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4435    [],
4436    "get the LV UUIDs of all LVs in the volume group",
4437    "\
4438 Given a VG called C<vgname>, this returns the UUIDs of all
4439 the logical volumes created in this volume group.
4440
4441 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4442 calls to associate logical volumes and volume groups.
4443
4444 See also C<guestfs_vgpvuuids>.");
4445
4446   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4447    [InitBasicFS, Always, TestOutputBuffer (
4448       [["write_file"; "/src"; "hello, world"; "0"];
4449        ["copy_size"; "/src"; "/dest"; "5"];
4450        ["read_file"; "/dest"]], "hello")],
4451    "copy size bytes from source to destination using dd",
4452    "\
4453 This command copies exactly C<size> bytes from one source device
4454 or file C<src> to another destination device or file C<dest>.
4455
4456 Note this will fail if the source is too short or if the destination
4457 is not large enough.");
4458
4459   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4460    [InitEmpty, Always, TestRun (
4461       [["part_init"; "/dev/sda"; "mbr"];
4462        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4463        ["part_del"; "/dev/sda"; "1"]])],
4464    "delete a partition",
4465    "\
4466 This command deletes the partition numbered C<partnum> on C<device>.
4467
4468 Note that in the case of MBR partitioning, deleting an
4469 extended partition also deletes any logical partitions
4470 it contains.");
4471
4472   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4473    [InitEmpty, Always, TestOutputTrue (
4474       [["part_init"; "/dev/sda"; "mbr"];
4475        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4476        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4477        ["part_get_bootable"; "/dev/sda"; "1"]])],
4478    "return true if a partition is bootable",
4479    "\
4480 This command returns true if the partition C<partnum> on
4481 C<device> has the bootable flag set.
4482
4483 See also C<guestfs_part_set_bootable>.");
4484
4485   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4486    [InitEmpty, Always, TestOutputInt (
4487       [["part_init"; "/dev/sda"; "mbr"];
4488        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4489        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4490        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4491    "get the MBR type byte (ID byte) from a partition",
4492    "\
4493 Returns the MBR type byte (also known as the ID byte) from
4494 the numbered partition C<partnum>.
4495
4496 Note that only MBR (old DOS-style) partitions have type bytes.
4497 You will get undefined results for other partition table
4498 types (see C<guestfs_part_get_parttype>).");
4499
4500   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4501    [], (* tested by part_get_mbr_id *)
4502    "set the MBR type byte (ID byte) of a partition",
4503    "\
4504 Sets the MBR type byte (also known as the ID byte) of
4505 the numbered partition C<partnum> to C<idbyte>.  Note
4506 that the type bytes quoted in most documentation are
4507 in fact hexadecimal numbers, but usually documented
4508 without any leading \"0x\" which might be confusing.
4509
4510 Note that only MBR (old DOS-style) partitions have type bytes.
4511 You will get undefined results for other partition table
4512 types (see C<guestfs_part_get_parttype>).");
4513
4514 ]
4515
4516 let all_functions = non_daemon_functions @ daemon_functions
4517
4518 (* In some places we want the functions to be displayed sorted
4519  * alphabetically, so this is useful:
4520  *)
4521 let all_functions_sorted =
4522   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4523                compare n1 n2) all_functions
4524
4525 (* Field types for structures. *)
4526 type field =
4527   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4528   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4529   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4530   | FUInt32
4531   | FInt32
4532   | FUInt64
4533   | FInt64
4534   | FBytes                      (* Any int measure that counts bytes. *)
4535   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4536   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4537
4538 (* Because we generate extra parsing code for LVM command line tools,
4539  * we have to pull out the LVM columns separately here.
4540  *)
4541 let lvm_pv_cols = [
4542   "pv_name", FString;
4543   "pv_uuid", FUUID;
4544   "pv_fmt", FString;
4545   "pv_size", FBytes;
4546   "dev_size", FBytes;
4547   "pv_free", FBytes;
4548   "pv_used", FBytes;
4549   "pv_attr", FString (* XXX *);
4550   "pv_pe_count", FInt64;
4551   "pv_pe_alloc_count", FInt64;
4552   "pv_tags", FString;
4553   "pe_start", FBytes;
4554   "pv_mda_count", FInt64;
4555   "pv_mda_free", FBytes;
4556   (* Not in Fedora 10:
4557      "pv_mda_size", FBytes;
4558   *)
4559 ]
4560 let lvm_vg_cols = [
4561   "vg_name", FString;
4562   "vg_uuid", FUUID;
4563   "vg_fmt", FString;
4564   "vg_attr", FString (* XXX *);
4565   "vg_size", FBytes;
4566   "vg_free", FBytes;
4567   "vg_sysid", FString;
4568   "vg_extent_size", FBytes;
4569   "vg_extent_count", FInt64;
4570   "vg_free_count", FInt64;
4571   "max_lv", FInt64;
4572   "max_pv", FInt64;
4573   "pv_count", FInt64;
4574   "lv_count", FInt64;
4575   "snap_count", FInt64;
4576   "vg_seqno", FInt64;
4577   "vg_tags", FString;
4578   "vg_mda_count", FInt64;
4579   "vg_mda_free", FBytes;
4580   (* Not in Fedora 10:
4581      "vg_mda_size", FBytes;
4582   *)
4583 ]
4584 let lvm_lv_cols = [
4585   "lv_name", FString;
4586   "lv_uuid", FUUID;
4587   "lv_attr", FString (* XXX *);
4588   "lv_major", FInt64;
4589   "lv_minor", FInt64;
4590   "lv_kernel_major", FInt64;
4591   "lv_kernel_minor", FInt64;
4592   "lv_size", FBytes;
4593   "seg_count", FInt64;
4594   "origin", FString;
4595   "snap_percent", FOptPercent;
4596   "copy_percent", FOptPercent;
4597   "move_pv", FString;
4598   "lv_tags", FString;
4599   "mirror_log", FString;
4600   "modules", FString;
4601 ]
4602
4603 (* Names and fields in all structures (in RStruct and RStructList)
4604  * that we support.
4605  *)
4606 let structs = [
4607   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4608    * not use this struct in any new code.
4609    *)
4610   "int_bool", [
4611     "i", FInt32;                (* for historical compatibility *)
4612     "b", FInt32;                (* for historical compatibility *)
4613   ];
4614
4615   (* LVM PVs, VGs, LVs. *)
4616   "lvm_pv", lvm_pv_cols;
4617   "lvm_vg", lvm_vg_cols;
4618   "lvm_lv", lvm_lv_cols;
4619
4620   (* Column names and types from stat structures.
4621    * NB. Can't use things like 'st_atime' because glibc header files
4622    * define some of these as macros.  Ugh.
4623    *)
4624   "stat", [
4625     "dev", FInt64;
4626     "ino", FInt64;
4627     "mode", FInt64;
4628     "nlink", FInt64;
4629     "uid", FInt64;
4630     "gid", FInt64;
4631     "rdev", FInt64;
4632     "size", FInt64;
4633     "blksize", FInt64;
4634     "blocks", FInt64;
4635     "atime", FInt64;
4636     "mtime", FInt64;
4637     "ctime", FInt64;
4638   ];
4639   "statvfs", [
4640     "bsize", FInt64;
4641     "frsize", FInt64;
4642     "blocks", FInt64;
4643     "bfree", FInt64;
4644     "bavail", FInt64;
4645     "files", FInt64;
4646     "ffree", FInt64;
4647     "favail", FInt64;
4648     "fsid", FInt64;
4649     "flag", FInt64;
4650     "namemax", FInt64;
4651   ];
4652
4653   (* Column names in dirent structure. *)
4654   "dirent", [
4655     "ino", FInt64;
4656     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4657     "ftyp", FChar;
4658     "name", FString;
4659   ];
4660
4661   (* Version numbers. *)
4662   "version", [
4663     "major", FInt64;
4664     "minor", FInt64;
4665     "release", FInt64;
4666     "extra", FString;
4667   ];
4668
4669   (* Extended attribute. *)
4670   "xattr", [
4671     "attrname", FString;
4672     "attrval", FBuffer;
4673   ];
4674
4675   (* Inotify events. *)
4676   "inotify_event", [
4677     "in_wd", FInt64;
4678     "in_mask", FUInt32;
4679     "in_cookie", FUInt32;
4680     "in_name", FString;
4681   ];
4682
4683   (* Partition table entry. *)
4684   "partition", [
4685     "part_num", FInt32;
4686     "part_start", FBytes;
4687     "part_end", FBytes;
4688     "part_size", FBytes;
4689   ];
4690 ] (* end of structs *)
4691
4692 (* Ugh, Java has to be different ..
4693  * These names are also used by the Haskell bindings.
4694  *)
4695 let java_structs = [
4696   "int_bool", "IntBool";
4697   "lvm_pv", "PV";
4698   "lvm_vg", "VG";
4699   "lvm_lv", "LV";
4700   "stat", "Stat";
4701   "statvfs", "StatVFS";
4702   "dirent", "Dirent";
4703   "version", "Version";
4704   "xattr", "XAttr";
4705   "inotify_event", "INotifyEvent";
4706   "partition", "Partition";
4707 ]
4708
4709 (* What structs are actually returned. *)
4710 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4711
4712 (* Returns a list of RStruct/RStructList structs that are returned
4713  * by any function.  Each element of returned list is a pair:
4714  *
4715  * (structname, RStructOnly)
4716  *    == there exists function which returns RStruct (_, structname)
4717  * (structname, RStructListOnly)
4718  *    == there exists function which returns RStructList (_, structname)
4719  * (structname, RStructAndList)
4720  *    == there are functions returning both RStruct (_, structname)
4721  *                                      and RStructList (_, structname)
4722  *)
4723 let rstructs_used_by functions =
4724   (* ||| is a "logical OR" for rstructs_used_t *)
4725   let (|||) a b =
4726     match a, b with
4727     | RStructAndList, _
4728     | _, RStructAndList -> RStructAndList
4729     | RStructOnly, RStructListOnly
4730     | RStructListOnly, RStructOnly -> RStructAndList
4731     | RStructOnly, RStructOnly -> RStructOnly
4732     | RStructListOnly, RStructListOnly -> RStructListOnly
4733   in
4734
4735   let h = Hashtbl.create 13 in
4736
4737   (* if elem->oldv exists, update entry using ||| operator,
4738    * else just add elem->newv to the hash
4739    *)
4740   let update elem newv =
4741     try  let oldv = Hashtbl.find h elem in
4742          Hashtbl.replace h elem (newv ||| oldv)
4743     with Not_found -> Hashtbl.add h elem newv
4744   in
4745
4746   List.iter (
4747     fun (_, style, _, _, _, _, _) ->
4748       match fst style with
4749       | RStruct (_, structname) -> update structname RStructOnly
4750       | RStructList (_, structname) -> update structname RStructListOnly
4751       | _ -> ()
4752   ) functions;
4753
4754   (* return key->values as a list of (key,value) *)
4755   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4756
4757 (* Used for testing language bindings. *)
4758 type callt =
4759   | CallString of string
4760   | CallOptString of string option
4761   | CallStringList of string list
4762   | CallInt of int
4763   | CallInt64 of int64
4764   | CallBool of bool
4765
4766 (* Used to memoize the result of pod2text. *)
4767 let pod2text_memo_filename = "src/.pod2text.data"
4768 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4769   try
4770     let chan = open_in pod2text_memo_filename in
4771     let v = input_value chan in
4772     close_in chan;
4773     v
4774   with
4775     _ -> Hashtbl.create 13
4776 let pod2text_memo_updated () =
4777   let chan = open_out pod2text_memo_filename in
4778   output_value chan pod2text_memo;
4779   close_out chan
4780
4781 (* Useful functions.
4782  * Note we don't want to use any external OCaml libraries which
4783  * makes this a bit harder than it should be.
4784  *)
4785 module StringMap = Map.Make (String)
4786
4787 let failwithf fs = ksprintf failwith fs
4788
4789 let unique = let i = ref 0 in fun () -> incr i; !i
4790
4791 let replace_char s c1 c2 =
4792   let s2 = String.copy s in
4793   let r = ref false in
4794   for i = 0 to String.length s2 - 1 do
4795     if String.unsafe_get s2 i = c1 then (
4796       String.unsafe_set s2 i c2;
4797       r := true
4798     )
4799   done;
4800   if not !r then s else s2
4801
4802 let isspace c =
4803   c = ' '
4804   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4805
4806 let triml ?(test = isspace) str =
4807   let i = ref 0 in
4808   let n = ref (String.length str) in
4809   while !n > 0 && test str.[!i]; do
4810     decr n;
4811     incr i
4812   done;
4813   if !i = 0 then str
4814   else String.sub str !i !n
4815
4816 let trimr ?(test = isspace) str =
4817   let n = ref (String.length str) in
4818   while !n > 0 && test str.[!n-1]; do
4819     decr n
4820   done;
4821   if !n = String.length str then str
4822   else String.sub str 0 !n
4823
4824 let trim ?(test = isspace) str =
4825   trimr ~test (triml ~test str)
4826
4827 let rec find s sub =
4828   let len = String.length s in
4829   let sublen = String.length sub in
4830   let rec loop i =
4831     if i <= len-sublen then (
4832       let rec loop2 j =
4833         if j < sublen then (
4834           if s.[i+j] = sub.[j] then loop2 (j+1)
4835           else -1
4836         ) else
4837           i (* found *)
4838       in
4839       let r = loop2 0 in
4840       if r = -1 then loop (i+1) else r
4841     ) else
4842       -1 (* not found *)
4843   in
4844   loop 0
4845
4846 let rec replace_str s s1 s2 =
4847   let len = String.length s in
4848   let sublen = String.length s1 in
4849   let i = find s s1 in
4850   if i = -1 then s
4851   else (
4852     let s' = String.sub s 0 i in
4853     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4854     s' ^ s2 ^ replace_str s'' s1 s2
4855   )
4856
4857 let rec string_split sep str =
4858   let len = String.length str in
4859   let seplen = String.length sep in
4860   let i = find str sep in
4861   if i = -1 then [str]
4862   else (
4863     let s' = String.sub str 0 i in
4864     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4865     s' :: string_split sep s''
4866   )
4867
4868 let files_equal n1 n2 =
4869   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4870   match Sys.command cmd with
4871   | 0 -> true
4872   | 1 -> false
4873   | i -> failwithf "%s: failed with error code %d" cmd i
4874
4875 let rec filter_map f = function
4876   | [] -> []
4877   | x :: xs ->
4878       match f x with
4879       | Some y -> y :: filter_map f xs
4880       | None -> filter_map f xs
4881
4882 let rec find_map f = function
4883   | [] -> raise Not_found
4884   | x :: xs ->
4885       match f x with
4886       | Some y -> y
4887       | None -> find_map f xs
4888
4889 let iteri f xs =
4890   let rec loop i = function
4891     | [] -> ()
4892     | x :: xs -> f i x; loop (i+1) xs
4893   in
4894   loop 0 xs
4895
4896 let mapi f xs =
4897   let rec loop i = function
4898     | [] -> []
4899     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4900   in
4901   loop 0 xs
4902
4903 let count_chars c str =
4904   let count = ref 0 in
4905   for i = 0 to String.length str - 1 do
4906     if c = String.unsafe_get str i then incr count
4907   done;
4908   !count
4909
4910 let name_of_argt = function
4911   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4912   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4913   | FileIn n | FileOut n -> n
4914
4915 let java_name_of_struct typ =
4916   try List.assoc typ java_structs
4917   with Not_found ->
4918     failwithf
4919       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4920
4921 let cols_of_struct typ =
4922   try List.assoc typ structs
4923   with Not_found ->
4924     failwithf "cols_of_struct: unknown struct %s" typ
4925
4926 let seq_of_test = function
4927   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4928   | TestOutputListOfDevices (s, _)
4929   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4930   | TestOutputTrue s | TestOutputFalse s
4931   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4932   | TestOutputStruct (s, _)
4933   | TestLastFail s -> s
4934
4935 (* Handling for function flags. *)
4936 let protocol_limit_warning =
4937   "Because of the message protocol, there is a transfer limit
4938 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4939
4940 let danger_will_robinson =
4941   "B<This command is dangerous.  Without careful use you
4942 can easily destroy all your data>."
4943
4944 let deprecation_notice flags =
4945   try
4946     let alt =
4947       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4948     let txt =
4949       sprintf "This function is deprecated.
4950 In new code, use the C<%s> call instead.
4951
4952 Deprecated functions will not be removed from the API, but the
4953 fact that they are deprecated indicates that there are problems
4954 with correct use of these functions." alt in
4955     Some txt
4956   with
4957     Not_found -> None
4958
4959 (* Create list of optional groups. *)
4960 let optgroups =
4961   let h = Hashtbl.create 13 in
4962   List.iter (
4963     fun (name, _, _, flags, _, _, _) ->
4964       List.iter (
4965         function
4966         | Optional group ->
4967             let names = try Hashtbl.find h group with Not_found -> [] in
4968             Hashtbl.replace h group (name :: names)
4969         | _ -> ()
4970       ) flags
4971   ) daemon_functions;
4972   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4973   let groups =
4974     List.map (
4975       fun group -> group, List.sort compare (Hashtbl.find h group)
4976     ) groups in
4977   List.sort (fun x y -> compare (fst x) (fst y)) groups
4978
4979 (* Check function names etc. for consistency. *)
4980 let check_functions () =
4981   let contains_uppercase str =
4982     let len = String.length str in
4983     let rec loop i =
4984       if i >= len then false
4985       else (
4986         let c = str.[i] in
4987         if c >= 'A' && c <= 'Z' then true
4988         else loop (i+1)
4989       )
4990     in
4991     loop 0
4992   in
4993
4994   (* Check function names. *)
4995   List.iter (
4996     fun (name, _, _, _, _, _, _) ->
4997       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4998         failwithf "function name %s does not need 'guestfs' prefix" name;
4999       if name = "" then
5000         failwithf "function name is empty";
5001       if name.[0] < 'a' || name.[0] > 'z' then
5002         failwithf "function name %s must start with lowercase a-z" name;
5003       if String.contains name '-' then
5004         failwithf "function name %s should not contain '-', use '_' instead."
5005           name
5006   ) all_functions;
5007
5008   (* Check function parameter/return names. *)
5009   List.iter (
5010     fun (name, style, _, _, _, _, _) ->
5011       let check_arg_ret_name n =
5012         if contains_uppercase n then
5013           failwithf "%s param/ret %s should not contain uppercase chars"
5014             name n;
5015         if String.contains n '-' || String.contains n '_' then
5016           failwithf "%s param/ret %s should not contain '-' or '_'"
5017             name n;
5018         if n = "value" then
5019           failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
5020         if n = "int" || n = "char" || n = "short" || n = "long" then
5021           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5022         if n = "i" || n = "n" then
5023           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5024         if n = "argv" || n = "args" then
5025           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5026
5027         (* List Haskell, OCaml and C keywords here.
5028          * http://www.haskell.org/haskellwiki/Keywords
5029          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5030          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5031          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5032          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5033          * Omitting _-containing words, since they're handled above.
5034          * Omitting the OCaml reserved word, "val", is ok,
5035          * and saves us from renaming several parameters.
5036          *)
5037         let reserved = [
5038           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5039           "char"; "class"; "const"; "constraint"; "continue"; "data";
5040           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5041           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5042           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5043           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5044           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5045           "interface";
5046           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5047           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5048           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5049           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5050           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5051           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5052           "volatile"; "when"; "where"; "while";
5053           ] in
5054         if List.mem n reserved then
5055           failwithf "%s has param/ret using reserved word %s" name n;
5056       in
5057
5058       (match fst style with
5059        | RErr -> ()
5060        | RInt n | RInt64 n | RBool n
5061        | RConstString n | RConstOptString n | RString n
5062        | RStringList n | RStruct (n, _) | RStructList (n, _)
5063        | RHashtable n | RBufferOut n ->
5064            check_arg_ret_name n
5065       );
5066       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5067   ) all_functions;
5068
5069   (* Check short descriptions. *)
5070   List.iter (
5071     fun (name, _, _, _, _, shortdesc, _) ->
5072       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5073         failwithf "short description of %s should begin with lowercase." name;
5074       let c = shortdesc.[String.length shortdesc-1] in
5075       if c = '\n' || c = '.' then
5076         failwithf "short description of %s should not end with . or \\n." name
5077   ) all_functions;
5078
5079   (* Check long descriptions. *)
5080   List.iter (
5081     fun (name, _, _, _, _, _, longdesc) ->
5082       if longdesc.[String.length longdesc-1] = '\n' then
5083         failwithf "long description of %s should not end with \\n." name
5084   ) all_functions;
5085
5086   (* Check proc_nrs. *)
5087   List.iter (
5088     fun (name, _, proc_nr, _, _, _, _) ->
5089       if proc_nr <= 0 then
5090         failwithf "daemon function %s should have proc_nr > 0" name
5091   ) daemon_functions;
5092
5093   List.iter (
5094     fun (name, _, proc_nr, _, _, _, _) ->
5095       if proc_nr <> -1 then
5096         failwithf "non-daemon function %s should have proc_nr -1" name
5097   ) non_daemon_functions;
5098
5099   let proc_nrs =
5100     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5101       daemon_functions in
5102   let proc_nrs =
5103     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5104   let rec loop = function
5105     | [] -> ()
5106     | [_] -> ()
5107     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5108         loop rest
5109     | (name1,nr1) :: (name2,nr2) :: _ ->
5110         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5111           name1 name2 nr1 nr2
5112   in
5113   loop proc_nrs;
5114
5115   (* Check tests. *)
5116   List.iter (
5117     function
5118       (* Ignore functions that have no tests.  We generate a
5119        * warning when the user does 'make check' instead.
5120        *)
5121     | name, _, _, _, [], _, _ -> ()
5122     | name, _, _, _, tests, _, _ ->
5123         let funcs =
5124           List.map (
5125             fun (_, _, test) ->
5126               match seq_of_test test with
5127               | [] ->
5128                   failwithf "%s has a test containing an empty sequence" name
5129               | cmds -> List.map List.hd cmds
5130           ) tests in
5131         let funcs = List.flatten funcs in
5132
5133         let tested = List.mem name funcs in
5134
5135         if not tested then
5136           failwithf "function %s has tests but does not test itself" name
5137   ) all_functions
5138
5139 (* 'pr' prints to the current output file. *)
5140 let chan = ref Pervasives.stdout
5141 let lines = ref 0
5142 let pr fs =
5143   ksprintf
5144     (fun str ->
5145        let i = count_chars '\n' str in
5146        lines := !lines + i;
5147        output_string !chan str
5148     ) fs
5149
5150 let copyright_years =
5151   let this_year = 1900 + (localtime (time ())).tm_year in
5152   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5153
5154 (* Generate a header block in a number of standard styles. *)
5155 type comment_style =
5156     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5157 type license = GPLv2plus | LGPLv2plus
5158
5159 let generate_header ?(extra_inputs = []) comment license =
5160   let inputs = "src/generator.ml" :: extra_inputs in
5161   let c = match comment with
5162     | CStyle ->         pr "/* "; " *"
5163     | CPlusPlusStyle -> pr "// "; "//"
5164     | HashStyle ->      pr "# ";  "#"
5165     | OCamlStyle ->     pr "(* "; " *"
5166     | HaskellStyle ->   pr "{- "; "  " in
5167   pr "libguestfs generated file\n";
5168   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5169   List.iter (pr "%s   %s\n" c) inputs;
5170   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5171   pr "%s\n" c;
5172   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5173   pr "%s\n" c;
5174   (match license with
5175    | GPLv2plus ->
5176        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5177        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5178        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5179        pr "%s (at your option) any later version.\n" c;
5180        pr "%s\n" c;
5181        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5182        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5183        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5184        pr "%s GNU General Public License for more details.\n" c;
5185        pr "%s\n" c;
5186        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5187        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5188        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5189
5190    | LGPLv2plus ->
5191        pr "%s This library is free software; you can redistribute it and/or\n" c;
5192        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5193        pr "%s License as published by the Free Software Foundation; either\n" c;
5194        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5195        pr "%s\n" c;
5196        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5197        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5198        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5199        pr "%s Lesser General Public License for more details.\n" c;
5200        pr "%s\n" c;
5201        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5202        pr "%s License along with this library; if not, write to the Free Software\n" c;
5203        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5204   );
5205   (match comment with
5206    | CStyle -> pr " */\n"
5207    | CPlusPlusStyle
5208    | HashStyle -> ()
5209    | OCamlStyle -> pr " *)\n"
5210    | HaskellStyle -> pr "-}\n"
5211   );
5212   pr "\n"
5213
5214 (* Start of main code generation functions below this line. *)
5215
5216 (* Generate the pod documentation for the C API. *)
5217 let rec generate_actions_pod () =
5218   List.iter (
5219     fun (shortname, style, _, flags, _, _, longdesc) ->
5220       if not (List.mem NotInDocs flags) then (
5221         let name = "guestfs_" ^ shortname in
5222         pr "=head2 %s\n\n" name;
5223         pr " ";
5224         generate_prototype ~extern:false ~handle:"g" name style;
5225         pr "\n\n";
5226         pr "%s\n\n" longdesc;
5227         (match fst style with
5228          | RErr ->
5229              pr "This function returns 0 on success or -1 on error.\n\n"
5230          | RInt _ ->
5231              pr "On error this function returns -1.\n\n"
5232          | RInt64 _ ->
5233              pr "On error this function returns -1.\n\n"
5234          | RBool _ ->
5235              pr "This function returns a C truth value on success or -1 on error.\n\n"
5236          | RConstString _ ->
5237              pr "This function returns a string, or NULL on error.
5238 The string is owned by the guest handle and must I<not> be freed.\n\n"
5239          | RConstOptString _ ->
5240              pr "This function returns a string which may be NULL.
5241 There is way to return an error from this function.
5242 The string is owned by the guest handle and must I<not> be freed.\n\n"
5243          | RString _ ->
5244              pr "This function returns a string, or NULL on error.
5245 I<The caller must free the returned string after use>.\n\n"
5246          | RStringList _ ->
5247              pr "This function returns a NULL-terminated array of strings
5248 (like L<environ(3)>), or NULL if there was an error.
5249 I<The caller must free the strings and the array after use>.\n\n"
5250          | RStruct (_, typ) ->
5251              pr "This function returns a C<struct guestfs_%s *>,
5252 or NULL if there was an error.
5253 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5254          | RStructList (_, typ) ->
5255              pr "This function returns a C<struct guestfs_%s_list *>
5256 (see E<lt>guestfs-structs.hE<gt>),
5257 or NULL if there was an error.
5258 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5259          | RHashtable _ ->
5260              pr "This function returns a NULL-terminated array of
5261 strings, or NULL if there was an error.
5262 The array of strings will always have length C<2n+1>, where
5263 C<n> keys and values alternate, followed by the trailing NULL entry.
5264 I<The caller must free the strings and the array after use>.\n\n"
5265          | RBufferOut _ ->
5266              pr "This function returns a buffer, or NULL on error.
5267 The size of the returned buffer is written to C<*size_r>.
5268 I<The caller must free the returned buffer after use>.\n\n"
5269         );
5270         if List.mem ProtocolLimitWarning flags then
5271           pr "%s\n\n" protocol_limit_warning;
5272         if List.mem DangerWillRobinson flags then
5273           pr "%s\n\n" danger_will_robinson;
5274         match deprecation_notice flags with
5275         | None -> ()
5276         | Some txt -> pr "%s\n\n" txt
5277       )
5278   ) all_functions_sorted
5279
5280 and generate_structs_pod () =
5281   (* Structs documentation. *)
5282   List.iter (
5283     fun (typ, cols) ->
5284       pr "=head2 guestfs_%s\n" typ;
5285       pr "\n";
5286       pr " struct guestfs_%s {\n" typ;
5287       List.iter (
5288         function
5289         | name, FChar -> pr "   char %s;\n" name
5290         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5291         | name, FInt32 -> pr "   int32_t %s;\n" name
5292         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5293         | name, FInt64 -> pr "   int64_t %s;\n" name
5294         | name, FString -> pr "   char *%s;\n" name
5295         | name, FBuffer ->
5296             pr "   /* The next two fields describe a byte array. */\n";
5297             pr "   uint32_t %s_len;\n" name;
5298             pr "   char *%s;\n" name
5299         | name, FUUID ->
5300             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5301             pr "   char %s[32];\n" name
5302         | name, FOptPercent ->
5303             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5304             pr "   float %s;\n" name
5305       ) cols;
5306       pr " };\n";
5307       pr " \n";
5308       pr " struct guestfs_%s_list {\n" typ;
5309       pr "   uint32_t len; /* Number of elements in list. */\n";
5310       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5311       pr " };\n";
5312       pr " \n";
5313       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5314       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5315         typ typ;
5316       pr "\n"
5317   ) structs
5318
5319 and generate_availability_pod () =
5320   (* Availability documentation. *)
5321   pr "=over 4\n";
5322   pr "\n";
5323   List.iter (
5324     fun (group, functions) ->
5325       pr "=item B<%s>\n" group;
5326       pr "\n";
5327       pr "The following functions:\n";
5328       List.iter (pr "L</guestfs_%s>\n") functions;
5329       pr "\n"
5330   ) optgroups;
5331   pr "=back\n";
5332   pr "\n"
5333
5334 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5335  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5336  *
5337  * We have to use an underscore instead of a dash because otherwise
5338  * rpcgen generates incorrect code.
5339  *
5340  * This header is NOT exported to clients, but see also generate_structs_h.
5341  *)
5342 and generate_xdr () =
5343   generate_header CStyle LGPLv2plus;
5344
5345   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5346   pr "typedef string str<>;\n";
5347   pr "\n";
5348
5349   (* Internal structures. *)
5350   List.iter (
5351     function
5352     | typ, cols ->
5353         pr "struct guestfs_int_%s {\n" typ;
5354         List.iter (function
5355                    | name, FChar -> pr "  char %s;\n" name
5356                    | name, FString -> pr "  string %s<>;\n" name
5357                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5358                    | name, FUUID -> pr "  opaque %s[32];\n" name
5359                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5360                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5361                    | name, FOptPercent -> pr "  float %s;\n" name
5362                   ) cols;
5363         pr "};\n";
5364         pr "\n";
5365         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5366         pr "\n";
5367   ) structs;
5368
5369   List.iter (
5370     fun (shortname, style, _, _, _, _, _) ->
5371       let name = "guestfs_" ^ shortname in
5372
5373       (match snd style with
5374        | [] -> ()
5375        | args ->
5376            pr "struct %s_args {\n" name;
5377            List.iter (
5378              function
5379              | Pathname n | Device n | Dev_or_Path n | String n ->
5380                  pr "  string %s<>;\n" n
5381              | OptString n -> pr "  str *%s;\n" n
5382              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5383              | Bool n -> pr "  bool %s;\n" n
5384              | Int n -> pr "  int %s;\n" n
5385              | Int64 n -> pr "  hyper %s;\n" n
5386              | FileIn _ | FileOut _ -> ()
5387            ) args;
5388            pr "};\n\n"
5389       );
5390       (match fst style with
5391        | RErr -> ()
5392        | RInt n ->
5393            pr "struct %s_ret {\n" name;
5394            pr "  int %s;\n" n;
5395            pr "};\n\n"
5396        | RInt64 n ->
5397            pr "struct %s_ret {\n" name;
5398            pr "  hyper %s;\n" n;
5399            pr "};\n\n"
5400        | RBool n ->
5401            pr "struct %s_ret {\n" name;
5402            pr "  bool %s;\n" n;
5403            pr "};\n\n"
5404        | RConstString _ | RConstOptString _ ->
5405            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5406        | RString n ->
5407            pr "struct %s_ret {\n" name;
5408            pr "  string %s<>;\n" n;
5409            pr "};\n\n"
5410        | RStringList n ->
5411            pr "struct %s_ret {\n" name;
5412            pr "  str %s<>;\n" n;
5413            pr "};\n\n"
5414        | RStruct (n, typ) ->
5415            pr "struct %s_ret {\n" name;
5416            pr "  guestfs_int_%s %s;\n" typ n;
5417            pr "};\n\n"
5418        | RStructList (n, typ) ->
5419            pr "struct %s_ret {\n" name;
5420            pr "  guestfs_int_%s_list %s;\n" typ n;
5421            pr "};\n\n"
5422        | RHashtable n ->
5423            pr "struct %s_ret {\n" name;
5424            pr "  str %s<>;\n" n;
5425            pr "};\n\n"
5426        | RBufferOut n ->
5427            pr "struct %s_ret {\n" name;
5428            pr "  opaque %s<>;\n" n;
5429            pr "};\n\n"
5430       );
5431   ) daemon_functions;
5432
5433   (* Table of procedure numbers. *)
5434   pr "enum guestfs_procedure {\n";
5435   List.iter (
5436     fun (shortname, _, proc_nr, _, _, _, _) ->
5437       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5438   ) daemon_functions;
5439   pr "  GUESTFS_PROC_NR_PROCS\n";
5440   pr "};\n";
5441   pr "\n";
5442
5443   (* Having to choose a maximum message size is annoying for several
5444    * reasons (it limits what we can do in the API), but it (a) makes
5445    * the protocol a lot simpler, and (b) provides a bound on the size
5446    * of the daemon which operates in limited memory space.
5447    *)
5448   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5449   pr "\n";
5450
5451   (* Message header, etc. *)
5452   pr "\
5453 /* The communication protocol is now documented in the guestfs(3)
5454  * manpage.
5455  */
5456
5457 const GUESTFS_PROGRAM = 0x2000F5F5;
5458 const GUESTFS_PROTOCOL_VERSION = 1;
5459
5460 /* These constants must be larger than any possible message length. */
5461 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5462 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5463
5464 enum guestfs_message_direction {
5465   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5466   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5467 };
5468
5469 enum guestfs_message_status {
5470   GUESTFS_STATUS_OK = 0,
5471   GUESTFS_STATUS_ERROR = 1
5472 };
5473
5474 const GUESTFS_ERROR_LEN = 256;
5475
5476 struct guestfs_message_error {
5477   string error_message<GUESTFS_ERROR_LEN>;
5478 };
5479
5480 struct guestfs_message_header {
5481   unsigned prog;                     /* GUESTFS_PROGRAM */
5482   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5483   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5484   guestfs_message_direction direction;
5485   unsigned serial;                   /* message serial number */
5486   guestfs_message_status status;
5487 };
5488
5489 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5490
5491 struct guestfs_chunk {
5492   int cancel;                        /* if non-zero, transfer is cancelled */
5493   /* data size is 0 bytes if the transfer has finished successfully */
5494   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5495 };
5496 "
5497
5498 (* Generate the guestfs-structs.h file. *)
5499 and generate_structs_h () =
5500   generate_header CStyle LGPLv2plus;
5501
5502   (* This is a public exported header file containing various
5503    * structures.  The structures are carefully written to have
5504    * exactly the same in-memory format as the XDR structures that
5505    * we use on the wire to the daemon.  The reason for creating
5506    * copies of these structures here is just so we don't have to
5507    * export the whole of guestfs_protocol.h (which includes much
5508    * unrelated and XDR-dependent stuff that we don't want to be
5509    * public, or required by clients).
5510    *
5511    * To reiterate, we will pass these structures to and from the
5512    * client with a simple assignment or memcpy, so the format
5513    * must be identical to what rpcgen / the RFC defines.
5514    *)
5515
5516   (* Public structures. *)
5517   List.iter (
5518     fun (typ, cols) ->
5519       pr "struct guestfs_%s {\n" typ;
5520       List.iter (
5521         function
5522         | name, FChar -> pr "  char %s;\n" name
5523         | name, FString -> pr "  char *%s;\n" name
5524         | name, FBuffer ->
5525             pr "  uint32_t %s_len;\n" name;
5526             pr "  char *%s;\n" name
5527         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5528         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5529         | name, FInt32 -> pr "  int32_t %s;\n" name
5530         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5531         | name, FInt64 -> pr "  int64_t %s;\n" name
5532         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5533       ) cols;
5534       pr "};\n";
5535       pr "\n";
5536       pr "struct guestfs_%s_list {\n" typ;
5537       pr "  uint32_t len;\n";
5538       pr "  struct guestfs_%s *val;\n" typ;
5539       pr "};\n";
5540       pr "\n";
5541       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5542       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5543       pr "\n"
5544   ) structs
5545
5546 (* Generate the guestfs-actions.h file. *)
5547 and generate_actions_h () =
5548   generate_header CStyle LGPLv2plus;
5549   List.iter (
5550     fun (shortname, style, _, _, _, _, _) ->
5551       let name = "guestfs_" ^ shortname in
5552       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5553         name style
5554   ) all_functions
5555
5556 (* Generate the guestfs-internal-actions.h file. *)
5557 and generate_internal_actions_h () =
5558   generate_header CStyle LGPLv2plus;
5559   List.iter (
5560     fun (shortname, style, _, _, _, _, _) ->
5561       let name = "guestfs__" ^ shortname in
5562       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5563         name style
5564   ) non_daemon_functions
5565
5566 (* Generate the client-side dispatch stubs. *)
5567 and generate_client_actions () =
5568   generate_header CStyle LGPLv2plus;
5569
5570   pr "\
5571 #include <stdio.h>
5572 #include <stdlib.h>
5573 #include <stdint.h>
5574 #include <string.h>
5575 #include <inttypes.h>
5576
5577 #include \"guestfs.h\"
5578 #include \"guestfs-internal.h\"
5579 #include \"guestfs-internal-actions.h\"
5580 #include \"guestfs_protocol.h\"
5581
5582 #define error guestfs_error
5583 //#define perrorf guestfs_perrorf
5584 #define safe_malloc guestfs_safe_malloc
5585 #define safe_realloc guestfs_safe_realloc
5586 //#define safe_strdup guestfs_safe_strdup
5587 #define safe_memdup guestfs_safe_memdup
5588
5589 /* Check the return message from a call for validity. */
5590 static int
5591 check_reply_header (guestfs_h *g,
5592                     const struct guestfs_message_header *hdr,
5593                     unsigned int proc_nr, unsigned int serial)
5594 {
5595   if (hdr->prog != GUESTFS_PROGRAM) {
5596     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5597     return -1;
5598   }
5599   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5600     error (g, \"wrong protocol version (%%d/%%d)\",
5601            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5602     return -1;
5603   }
5604   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5605     error (g, \"unexpected message direction (%%d/%%d)\",
5606            hdr->direction, GUESTFS_DIRECTION_REPLY);
5607     return -1;
5608   }
5609   if (hdr->proc != proc_nr) {
5610     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5611     return -1;
5612   }
5613   if (hdr->serial != serial) {
5614     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5615     return -1;
5616   }
5617
5618   return 0;
5619 }
5620
5621 /* Check we are in the right state to run a high-level action. */
5622 static int
5623 check_state (guestfs_h *g, const char *caller)
5624 {
5625   if (!guestfs__is_ready (g)) {
5626     if (guestfs__is_config (g) || guestfs__is_launching (g))
5627       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5628         caller);
5629     else
5630       error (g, \"%%s called from the wrong state, %%d != READY\",
5631         caller, guestfs__get_state (g));
5632     return -1;
5633   }
5634   return 0;
5635 }
5636
5637 ";
5638
5639   (* Generate code to generate guestfish call traces. *)
5640   let trace_call shortname style =
5641     pr "  if (guestfs__get_trace (g)) {\n";
5642
5643     let needs_i =
5644       List.exists (function
5645                    | StringList _ | DeviceList _ -> true
5646                    | _ -> false) (snd style) in
5647     if needs_i then (
5648       pr "    int i;\n";
5649       pr "\n"
5650     );
5651
5652     pr "    printf (\"%s\");\n" shortname;
5653     List.iter (
5654       function
5655       | String n                        (* strings *)
5656       | Device n
5657       | Pathname n
5658       | Dev_or_Path n
5659       | FileIn n
5660       | FileOut n ->
5661           (* guestfish doesn't support string escaping, so neither do we *)
5662           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5663       | OptString n ->                  (* string option *)
5664           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5665           pr "    else printf (\" null\");\n"
5666       | StringList n
5667       | DeviceList n ->                 (* string list *)
5668           pr "    putchar (' ');\n";
5669           pr "    putchar ('\"');\n";
5670           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5671           pr "      if (i > 0) putchar (' ');\n";
5672           pr "      fputs (%s[i], stdout);\n" n;
5673           pr "    }\n";
5674           pr "    putchar ('\"');\n";
5675       | Bool n ->                       (* boolean *)
5676           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5677       | Int n ->                        (* int *)
5678           pr "    printf (\" %%d\", %s);\n" n
5679       | Int64 n ->
5680           pr "    printf (\" %%\" PRIi64, %s);\n" n
5681     ) (snd style);
5682     pr "    putchar ('\\n');\n";
5683     pr "  }\n";
5684     pr "\n";
5685   in
5686
5687   (* For non-daemon functions, generate a wrapper around each function. *)
5688   List.iter (
5689     fun (shortname, style, _, _, _, _, _) ->
5690       let name = "guestfs_" ^ shortname in
5691
5692       generate_prototype ~extern:false ~semicolon:false ~newline:true
5693         ~handle:"g" name style;
5694       pr "{\n";
5695       trace_call shortname style;
5696       pr "  return guestfs__%s " shortname;
5697       generate_c_call_args ~handle:"g" style;
5698       pr ";\n";
5699       pr "}\n";
5700       pr "\n"
5701   ) non_daemon_functions;
5702
5703   (* Client-side stubs for each function. *)
5704   List.iter (
5705     fun (shortname, style, _, _, _, _, _) ->
5706       let name = "guestfs_" ^ shortname in
5707
5708       (* Generate the action stub. *)
5709       generate_prototype ~extern:false ~semicolon:false ~newline:true
5710         ~handle:"g" name style;
5711
5712       let error_code =
5713         match fst style with
5714         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5715         | RConstString _ | RConstOptString _ ->
5716             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5717         | RString _ | RStringList _
5718         | RStruct _ | RStructList _
5719         | RHashtable _ | RBufferOut _ ->
5720             "NULL" in
5721
5722       pr "{\n";
5723
5724       (match snd style with
5725        | [] -> ()
5726        | _ -> pr "  struct %s_args args;\n" name
5727       );
5728
5729       pr "  guestfs_message_header hdr;\n";
5730       pr "  guestfs_message_error err;\n";
5731       let has_ret =
5732         match fst style with
5733         | RErr -> false
5734         | RConstString _ | RConstOptString _ ->
5735             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5736         | RInt _ | RInt64 _
5737         | RBool _ | RString _ | RStringList _
5738         | RStruct _ | RStructList _
5739         | RHashtable _ | RBufferOut _ ->
5740             pr "  struct %s_ret ret;\n" name;
5741             true in
5742
5743       pr "  int serial;\n";
5744       pr "  int r;\n";
5745       pr "\n";
5746       trace_call shortname style;
5747       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5748       pr "  guestfs___set_busy (g);\n";
5749       pr "\n";
5750
5751       (* Send the main header and arguments. *)
5752       (match snd style with
5753        | [] ->
5754            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5755              (String.uppercase shortname)
5756        | args ->
5757            List.iter (
5758              function
5759              | Pathname n | Device n | Dev_or_Path n | String n ->
5760                  pr "  args.%s = (char *) %s;\n" n n
5761              | OptString n ->
5762                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5763              | StringList n | DeviceList n ->
5764                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5765                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5766              | Bool n ->
5767                  pr "  args.%s = %s;\n" n n
5768              | Int n ->
5769                  pr "  args.%s = %s;\n" n n
5770              | Int64 n ->
5771                  pr "  args.%s = %s;\n" n n
5772              | FileIn _ | FileOut _ -> ()
5773            ) args;
5774            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5775              (String.uppercase shortname);
5776            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5777              name;
5778       );
5779       pr "  if (serial == -1) {\n";
5780       pr "    guestfs___end_busy (g);\n";
5781       pr "    return %s;\n" error_code;
5782       pr "  }\n";
5783       pr "\n";
5784
5785       (* Send any additional files (FileIn) requested. *)
5786       let need_read_reply_label = ref false in
5787       List.iter (
5788         function
5789         | FileIn n ->
5790             pr "  r = guestfs___send_file (g, %s);\n" n;
5791             pr "  if (r == -1) {\n";
5792             pr "    guestfs___end_busy (g);\n";
5793             pr "    return %s;\n" error_code;
5794             pr "  }\n";
5795             pr "  if (r == -2) /* daemon cancelled */\n";
5796             pr "    goto read_reply;\n";
5797             need_read_reply_label := true;
5798             pr "\n";
5799         | _ -> ()
5800       ) (snd style);
5801
5802       (* Wait for the reply from the remote end. *)
5803       if !need_read_reply_label then pr " read_reply:\n";
5804       pr "  memset (&hdr, 0, sizeof hdr);\n";
5805       pr "  memset (&err, 0, sizeof err);\n";
5806       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5807       pr "\n";
5808       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5809       if not has_ret then
5810         pr "NULL, NULL"
5811       else
5812         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5813       pr ");\n";
5814
5815       pr "  if (r == -1) {\n";
5816       pr "    guestfs___end_busy (g);\n";
5817       pr "    return %s;\n" error_code;
5818       pr "  }\n";
5819       pr "\n";
5820
5821       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5822         (String.uppercase shortname);
5823       pr "    guestfs___end_busy (g);\n";
5824       pr "    return %s;\n" error_code;
5825       pr "  }\n";
5826       pr "\n";
5827
5828       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5829       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5830       pr "    free (err.error_message);\n";
5831       pr "    guestfs___end_busy (g);\n";
5832       pr "    return %s;\n" error_code;
5833       pr "  }\n";
5834       pr "\n";
5835
5836       (* Expecting to receive further files (FileOut)? *)
5837       List.iter (
5838         function
5839         | FileOut n ->
5840             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5841             pr "    guestfs___end_busy (g);\n";
5842             pr "    return %s;\n" error_code;
5843             pr "  }\n";
5844             pr "\n";
5845         | _ -> ()
5846       ) (snd style);
5847
5848       pr "  guestfs___end_busy (g);\n";
5849
5850       (match fst style with
5851        | RErr -> pr "  return 0;\n"
5852        | RInt n | RInt64 n | RBool n ->
5853            pr "  return ret.%s;\n" n
5854        | RConstString _ | RConstOptString _ ->
5855            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5856        | RString n ->
5857            pr "  return ret.%s; /* caller will free */\n" n
5858        | RStringList n | RHashtable n ->
5859            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5860            pr "  ret.%s.%s_val =\n" n n;
5861            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5862            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5863              n n;
5864            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5865            pr "  return ret.%s.%s_val;\n" n n
5866        | RStruct (n, _) ->
5867            pr "  /* caller will free this */\n";
5868            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5869        | RStructList (n, _) ->
5870            pr "  /* caller will free this */\n";
5871            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5872        | RBufferOut n ->
5873            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5874            pr "   * _val might be NULL here.  To make the API saner for\n";
5875            pr "   * callers, we turn this case into a unique pointer (using\n";
5876            pr "   * malloc(1)).\n";
5877            pr "   */\n";
5878            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5879            pr "    *size_r = ret.%s.%s_len;\n" n n;
5880            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5881            pr "  } else {\n";
5882            pr "    free (ret.%s.%s_val);\n" n n;
5883            pr "    char *p = safe_malloc (g, 1);\n";
5884            pr "    *size_r = ret.%s.%s_len;\n" n n;
5885            pr "    return p;\n";
5886            pr "  }\n";
5887       );
5888
5889       pr "}\n\n"
5890   ) daemon_functions;
5891
5892   (* Functions to free structures. *)
5893   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5894   pr " * structure format is identical to the XDR format.  See note in\n";
5895   pr " * generator.ml.\n";
5896   pr " */\n";
5897   pr "\n";
5898
5899   List.iter (
5900     fun (typ, _) ->
5901       pr "void\n";
5902       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5903       pr "{\n";
5904       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5905       pr "  free (x);\n";
5906       pr "}\n";
5907       pr "\n";
5908
5909       pr "void\n";
5910       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5911       pr "{\n";
5912       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5913       pr "  free (x);\n";
5914       pr "}\n";
5915       pr "\n";
5916
5917   ) structs;
5918
5919 (* Generate daemon/actions.h. *)
5920 and generate_daemon_actions_h () =
5921   generate_header CStyle GPLv2plus;
5922
5923   pr "#include \"../src/guestfs_protocol.h\"\n";
5924   pr "\n";
5925
5926   List.iter (
5927     fun (name, style, _, _, _, _, _) ->
5928       generate_prototype
5929         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5930         name style;
5931   ) daemon_functions
5932
5933 (* Generate the linker script which controls the visibility of
5934  * symbols in the public ABI and ensures no other symbols get
5935  * exported accidentally.
5936  *)
5937 and generate_linker_script () =
5938   generate_header HashStyle GPLv2plus;
5939
5940   let globals = [
5941     "guestfs_create";
5942     "guestfs_close";
5943     "guestfs_get_error_handler";
5944     "guestfs_get_out_of_memory_handler";
5945     "guestfs_last_error";
5946     "guestfs_set_error_handler";
5947     "guestfs_set_launch_done_callback";
5948     "guestfs_set_log_message_callback";
5949     "guestfs_set_out_of_memory_handler";
5950     "guestfs_set_subprocess_quit_callback";
5951
5952     (* Unofficial parts of the API: the bindings code use these
5953      * functions, so it is useful to export them.
5954      *)
5955     "guestfs_safe_calloc";
5956     "guestfs_safe_malloc";
5957   ] in
5958   let functions =
5959     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5960       all_functions in
5961   let structs =
5962     List.concat (
5963       List.map (fun (typ, _) ->
5964                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5965         structs
5966     ) in
5967   let globals = List.sort compare (globals @ functions @ structs) in
5968
5969   pr "{\n";
5970   pr "    global:\n";
5971   List.iter (pr "        %s;\n") globals;
5972   pr "\n";
5973
5974   pr "    local:\n";
5975   pr "        *;\n";
5976   pr "};\n"
5977
5978 (* Generate the server-side stubs. *)
5979 and generate_daemon_actions () =
5980   generate_header CStyle GPLv2plus;
5981
5982   pr "#include <config.h>\n";
5983   pr "\n";
5984   pr "#include <stdio.h>\n";
5985   pr "#include <stdlib.h>\n";
5986   pr "#include <string.h>\n";
5987   pr "#include <inttypes.h>\n";
5988   pr "#include <rpc/types.h>\n";
5989   pr "#include <rpc/xdr.h>\n";
5990   pr "\n";
5991   pr "#include \"daemon.h\"\n";
5992   pr "#include \"c-ctype.h\"\n";
5993   pr "#include \"../src/guestfs_protocol.h\"\n";
5994   pr "#include \"actions.h\"\n";
5995   pr "\n";
5996
5997   List.iter (
5998     fun (name, style, _, _, _, _, _) ->
5999       (* Generate server-side stubs. *)
6000       pr "static void %s_stub (XDR *xdr_in)\n" name;
6001       pr "{\n";
6002       let error_code =
6003         match fst style with
6004         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6005         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6006         | RBool _ -> pr "  int r;\n"; "-1"
6007         | RConstString _ | RConstOptString _ ->
6008             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6009         | RString _ -> pr "  char *r;\n"; "NULL"
6010         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6011         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6012         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6013         | RBufferOut _ ->
6014             pr "  size_t size = 1;\n";
6015             pr "  char *r;\n";
6016             "NULL" in
6017
6018       (match snd style with
6019        | [] -> ()
6020        | args ->
6021            pr "  struct guestfs_%s_args args;\n" name;
6022            List.iter (
6023              function
6024              | Device n | Dev_or_Path n
6025              | Pathname n
6026              | String n -> ()
6027              | OptString n -> pr "  char *%s;\n" n
6028              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6029              | Bool n -> pr "  int %s;\n" n
6030              | Int n -> pr "  int %s;\n" n
6031              | Int64 n -> pr "  int64_t %s;\n" n
6032              | FileIn _ | FileOut _ -> ()
6033            ) args
6034       );
6035       pr "\n";
6036
6037       (match snd style with
6038        | [] -> ()
6039        | args ->
6040            pr "  memset (&args, 0, sizeof args);\n";
6041            pr "\n";
6042            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6043            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6044            pr "    return;\n";
6045            pr "  }\n";
6046            let pr_args n =
6047              pr "  char *%s = args.%s;\n" n n
6048            in
6049            let pr_list_handling_code n =
6050              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6051              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6052              pr "  if (%s == NULL) {\n" n;
6053              pr "    reply_with_perror (\"realloc\");\n";
6054              pr "    goto done;\n";
6055              pr "  }\n";
6056              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6057              pr "  args.%s.%s_val = %s;\n" n n n;
6058            in
6059            List.iter (
6060              function
6061              | Pathname n ->
6062                  pr_args n;
6063                  pr "  ABS_PATH (%s, goto done);\n" n;
6064              | Device n ->
6065                  pr_args n;
6066                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6067              | Dev_or_Path n ->
6068                  pr_args n;
6069                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6070              | String n -> pr_args n
6071              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6072              | StringList n ->
6073                  pr_list_handling_code n;
6074              | DeviceList n ->
6075                  pr_list_handling_code n;
6076                  pr "  /* Ensure that each is a device,\n";
6077                  pr "   * and perform device name translation. */\n";
6078                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
6079                  pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
6080                  pr "  }\n";
6081              | Bool n -> pr "  %s = args.%s;\n" n n
6082              | Int n -> pr "  %s = args.%s;\n" n n
6083              | Int64 n -> pr "  %s = args.%s;\n" n n
6084              | FileIn _ | FileOut _ -> ()
6085            ) args;
6086            pr "\n"
6087       );
6088
6089
6090       (* this is used at least for do_equal *)
6091       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6092         (* Emit NEED_ROOT just once, even when there are two or
6093            more Pathname args *)
6094         pr "  NEED_ROOT (goto done);\n";
6095       );
6096
6097       (* Don't want to call the impl with any FileIn or FileOut
6098        * parameters, since these go "outside" the RPC protocol.
6099        *)
6100       let args' =
6101         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6102           (snd style) in
6103       pr "  r = do_%s " name;
6104       generate_c_call_args (fst style, args');
6105       pr ";\n";
6106
6107       (match fst style with
6108        | RErr | RInt _ | RInt64 _ | RBool _
6109        | RConstString _ | RConstOptString _
6110        | RString _ | RStringList _ | RHashtable _
6111        | RStruct (_, _) | RStructList (_, _) ->
6112            pr "  if (r == %s)\n" error_code;
6113            pr "    /* do_%s has already called reply_with_error */\n" name;
6114            pr "    goto done;\n";
6115            pr "\n"
6116        | RBufferOut _ ->
6117            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6118            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6119            pr "   */\n";
6120            pr "  if (size == 1 && r == %s)\n" error_code;
6121            pr "    /* do_%s has already called reply_with_error */\n" name;
6122            pr "    goto done;\n";
6123            pr "\n"
6124       );
6125
6126       (* If there are any FileOut parameters, then the impl must
6127        * send its own reply.
6128        *)
6129       let no_reply =
6130         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6131       if no_reply then
6132         pr "  /* do_%s has already sent a reply */\n" name
6133       else (
6134         match fst style with
6135         | RErr -> pr "  reply (NULL, NULL);\n"
6136         | RInt n | RInt64 n | RBool n ->
6137             pr "  struct guestfs_%s_ret ret;\n" name;
6138             pr "  ret.%s = r;\n" n;
6139             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6140               name
6141         | RConstString _ | RConstOptString _ ->
6142             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6143         | RString n ->
6144             pr "  struct guestfs_%s_ret ret;\n" name;
6145             pr "  ret.%s = r;\n" n;
6146             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6147               name;
6148             pr "  free (r);\n"
6149         | RStringList n | RHashtable n ->
6150             pr "  struct guestfs_%s_ret ret;\n" name;
6151             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6152             pr "  ret.%s.%s_val = r;\n" n n;
6153             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6154               name;
6155             pr "  free_strings (r);\n"
6156         | RStruct (n, _) ->
6157             pr "  struct guestfs_%s_ret ret;\n" name;
6158             pr "  ret.%s = *r;\n" n;
6159             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6160               name;
6161             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6162               name
6163         | RStructList (n, _) ->
6164             pr "  struct guestfs_%s_ret ret;\n" name;
6165             pr "  ret.%s = *r;\n" n;
6166             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6167               name;
6168             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6169               name
6170         | RBufferOut n ->
6171             pr "  struct guestfs_%s_ret ret;\n" name;
6172             pr "  ret.%s.%s_val = r;\n" n n;
6173             pr "  ret.%s.%s_len = size;\n" n n;
6174             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6175               name;
6176             pr "  free (r);\n"
6177       );
6178
6179       (* Free the args. *)
6180       (match snd style with
6181        | [] ->
6182            pr "done: ;\n";
6183        | _ ->
6184            pr "done:\n";
6185            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6186              name
6187       );
6188
6189       pr "}\n\n";
6190   ) daemon_functions;
6191
6192   (* Dispatch function. *)
6193   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6194   pr "{\n";
6195   pr "  switch (proc_nr) {\n";
6196
6197   List.iter (
6198     fun (name, style, _, _, _, _, _) ->
6199       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6200       pr "      %s_stub (xdr_in);\n" name;
6201       pr "      break;\n"
6202   ) daemon_functions;
6203
6204   pr "    default:\n";
6205   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";
6206   pr "  }\n";
6207   pr "}\n";
6208   pr "\n";
6209
6210   (* LVM columns and tokenization functions. *)
6211   (* XXX This generates crap code.  We should rethink how we
6212    * do this parsing.
6213    *)
6214   List.iter (
6215     function
6216     | typ, cols ->
6217         pr "static const char *lvm_%s_cols = \"%s\";\n"
6218           typ (String.concat "," (List.map fst cols));
6219         pr "\n";
6220
6221         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6222         pr "{\n";
6223         pr "  char *tok, *p, *next;\n";
6224         pr "  int i, j;\n";
6225         pr "\n";
6226         (*
6227           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6228           pr "\n";
6229         *)
6230         pr "  if (!str) {\n";
6231         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6232         pr "    return -1;\n";
6233         pr "  }\n";
6234         pr "  if (!*str || c_isspace (*str)) {\n";
6235         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6236         pr "    return -1;\n";
6237         pr "  }\n";
6238         pr "  tok = str;\n";
6239         List.iter (
6240           fun (name, coltype) ->
6241             pr "  if (!tok) {\n";
6242             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6243             pr "    return -1;\n";
6244             pr "  }\n";
6245             pr "  p = strchrnul (tok, ',');\n";
6246             pr "  if (*p) next = p+1; else next = NULL;\n";
6247             pr "  *p = '\\0';\n";
6248             (match coltype with
6249              | FString ->
6250                  pr "  r->%s = strdup (tok);\n" name;
6251                  pr "  if (r->%s == NULL) {\n" name;
6252                  pr "    perror (\"strdup\");\n";
6253                  pr "    return -1;\n";
6254                  pr "  }\n"
6255              | FUUID ->
6256                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6257                  pr "    if (tok[j] == '\\0') {\n";
6258                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6259                  pr "      return -1;\n";
6260                  pr "    } else if (tok[j] != '-')\n";
6261                  pr "      r->%s[i++] = tok[j];\n" name;
6262                  pr "  }\n";
6263              | FBytes ->
6264                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6265                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6266                  pr "    return -1;\n";
6267                  pr "  }\n";
6268              | FInt64 ->
6269                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6270                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6271                  pr "    return -1;\n";
6272                  pr "  }\n";
6273              | FOptPercent ->
6274                  pr "  if (tok[0] == '\\0')\n";
6275                  pr "    r->%s = -1;\n" name;
6276                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6277                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6278                  pr "    return -1;\n";
6279                  pr "  }\n";
6280              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6281                  assert false (* can never be an LVM column *)
6282             );
6283             pr "  tok = next;\n";
6284         ) cols;
6285
6286         pr "  if (tok != NULL) {\n";
6287         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6288         pr "    return -1;\n";
6289         pr "  }\n";
6290         pr "  return 0;\n";
6291         pr "}\n";
6292         pr "\n";
6293
6294         pr "guestfs_int_lvm_%s_list *\n" typ;
6295         pr "parse_command_line_%ss (void)\n" typ;
6296         pr "{\n";
6297         pr "  char *out, *err;\n";
6298         pr "  char *p, *pend;\n";
6299         pr "  int r, i;\n";
6300         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6301         pr "  void *newp;\n";
6302         pr "\n";
6303         pr "  ret = malloc (sizeof *ret);\n";
6304         pr "  if (!ret) {\n";
6305         pr "    reply_with_perror (\"malloc\");\n";
6306         pr "    return NULL;\n";
6307         pr "  }\n";
6308         pr "\n";
6309         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6310         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6311         pr "\n";
6312         pr "  r = command (&out, &err,\n";
6313         pr "           \"lvm\", \"%ss\",\n" typ;
6314         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6315         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6316         pr "  if (r == -1) {\n";
6317         pr "    reply_with_error (\"%%s\", err);\n";
6318         pr "    free (out);\n";
6319         pr "    free (err);\n";
6320         pr "    free (ret);\n";
6321         pr "    return NULL;\n";
6322         pr "  }\n";
6323         pr "\n";
6324         pr "  free (err);\n";
6325         pr "\n";
6326         pr "  /* Tokenize each line of the output. */\n";
6327         pr "  p = out;\n";
6328         pr "  i = 0;\n";
6329         pr "  while (p) {\n";
6330         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6331         pr "    if (pend) {\n";
6332         pr "      *pend = '\\0';\n";
6333         pr "      pend++;\n";
6334         pr "    }\n";
6335         pr "\n";
6336         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6337         pr "      p++;\n";
6338         pr "\n";
6339         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6340         pr "      p = pend;\n";
6341         pr "      continue;\n";
6342         pr "    }\n";
6343         pr "\n";
6344         pr "    /* Allocate some space to store this next entry. */\n";
6345         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6346         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6347         pr "    if (newp == NULL) {\n";
6348         pr "      reply_with_perror (\"realloc\");\n";
6349         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6350         pr "      free (ret);\n";
6351         pr "      free (out);\n";
6352         pr "      return NULL;\n";
6353         pr "    }\n";
6354         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6355         pr "\n";
6356         pr "    /* Tokenize the next entry. */\n";
6357         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6358         pr "    if (r == -1) {\n";
6359         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6360         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6361         pr "      free (ret);\n";
6362         pr "      free (out);\n";
6363         pr "      return NULL;\n";
6364         pr "    }\n";
6365         pr "\n";
6366         pr "    ++i;\n";
6367         pr "    p = pend;\n";
6368         pr "  }\n";
6369         pr "\n";
6370         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6371         pr "\n";
6372         pr "  free (out);\n";
6373         pr "  return ret;\n";
6374         pr "}\n"
6375
6376   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6377
6378 (* Generate a list of function names, for debugging in the daemon.. *)
6379 and generate_daemon_names () =
6380   generate_header CStyle GPLv2plus;
6381
6382   pr "#include <config.h>\n";
6383   pr "\n";
6384   pr "#include \"daemon.h\"\n";
6385   pr "\n";
6386
6387   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6388   pr "const char *function_names[] = {\n";
6389   List.iter (
6390     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6391   ) daemon_functions;
6392   pr "};\n";
6393
6394 (* Generate the optional groups for the daemon to implement
6395  * guestfs_available.
6396  *)
6397 and generate_daemon_optgroups_c () =
6398   generate_header CStyle GPLv2plus;
6399
6400   pr "#include <config.h>\n";
6401   pr "\n";
6402   pr "#include \"daemon.h\"\n";
6403   pr "#include \"optgroups.h\"\n";
6404   pr "\n";
6405
6406   pr "struct optgroup optgroups[] = {\n";
6407   List.iter (
6408     fun (group, _) ->
6409       pr "  { \"%s\", optgroup_%s_available },\n" group group
6410   ) optgroups;
6411   pr "  { NULL, NULL }\n";
6412   pr "};\n"
6413
6414 and generate_daemon_optgroups_h () =
6415   generate_header CStyle GPLv2plus;
6416
6417   List.iter (
6418     fun (group, _) ->
6419       pr "extern int optgroup_%s_available (void);\n" group
6420   ) optgroups
6421
6422 (* Generate the tests. *)
6423 and generate_tests () =
6424   generate_header CStyle GPLv2plus;
6425
6426   pr "\
6427 #include <stdio.h>
6428 #include <stdlib.h>
6429 #include <string.h>
6430 #include <unistd.h>
6431 #include <sys/types.h>
6432 #include <fcntl.h>
6433
6434 #include \"guestfs.h\"
6435 #include \"guestfs-internal.h\"
6436
6437 static guestfs_h *g;
6438 static int suppress_error = 0;
6439
6440 static void print_error (guestfs_h *g, void *data, const char *msg)
6441 {
6442   if (!suppress_error)
6443     fprintf (stderr, \"%%s\\n\", msg);
6444 }
6445
6446 /* FIXME: nearly identical code appears in fish.c */
6447 static void print_strings (char *const *argv)
6448 {
6449   int argc;
6450
6451   for (argc = 0; argv[argc] != NULL; ++argc)
6452     printf (\"\\t%%s\\n\", argv[argc]);
6453 }
6454
6455 /*
6456 static void print_table (char const *const *argv)
6457 {
6458   int i;
6459
6460   for (i = 0; argv[i] != NULL; i += 2)
6461     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6462 }
6463 */
6464
6465 static int
6466 is_available (const char *group)
6467 {
6468   const char *groups[] = { group, NULL };
6469   int r;
6470
6471   suppress_error = 1;
6472   r = guestfs_available (g, (char **) groups);
6473   suppress_error = 0;
6474
6475   return r == 0;
6476 }
6477
6478 ";
6479
6480   (* Generate a list of commands which are not tested anywhere. *)
6481   pr "static void no_test_warnings (void)\n";
6482   pr "{\n";
6483
6484   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6485   List.iter (
6486     fun (_, _, _, _, tests, _, _) ->
6487       let tests = filter_map (
6488         function
6489         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
6490         | (_, Disabled, _) -> None
6491       ) tests in
6492       let seq = List.concat (List.map seq_of_test tests) in
6493       let cmds_tested = List.map List.hd seq in
6494       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6495   ) all_functions;
6496
6497   List.iter (
6498     fun (name, _, _, _, _, _, _) ->
6499       if not (Hashtbl.mem hash name) then
6500         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6501   ) all_functions;
6502
6503   pr "}\n";
6504   pr "\n";
6505
6506   (* Generate the actual tests.  Note that we generate the tests
6507    * in reverse order, deliberately, so that (in general) the
6508    * newest tests run first.  This makes it quicker and easier to
6509    * debug them.
6510    *)
6511   let test_names =
6512     List.map (
6513       fun (name, _, _, flags, tests, _, _) ->
6514         mapi (generate_one_test name flags) tests
6515     ) (List.rev all_functions) in
6516   let test_names = List.concat test_names in
6517   let nr_tests = List.length test_names in
6518
6519   pr "\
6520 int main (int argc, char *argv[])
6521 {
6522   char c = 0;
6523   unsigned long int n_failed = 0;
6524   const char *filename;
6525   int fd;
6526   int nr_tests, test_num = 0;
6527
6528   setbuf (stdout, NULL);
6529
6530   no_test_warnings ();
6531
6532   g = guestfs_create ();
6533   if (g == NULL) {
6534     printf (\"guestfs_create FAILED\\n\");
6535     exit (EXIT_FAILURE);
6536   }
6537
6538   guestfs_set_error_handler (g, print_error, NULL);
6539
6540   guestfs_set_path (g, \"../appliance\");
6541
6542   filename = \"test1.img\";
6543   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6544   if (fd == -1) {
6545     perror (filename);
6546     exit (EXIT_FAILURE);
6547   }
6548   if (lseek (fd, %d, SEEK_SET) == -1) {
6549     perror (\"lseek\");
6550     close (fd);
6551     unlink (filename);
6552     exit (EXIT_FAILURE);
6553   }
6554   if (write (fd, &c, 1) == -1) {
6555     perror (\"write\");
6556     close (fd);
6557     unlink (filename);
6558     exit (EXIT_FAILURE);
6559   }
6560   if (close (fd) == -1) {
6561     perror (filename);
6562     unlink (filename);
6563     exit (EXIT_FAILURE);
6564   }
6565   if (guestfs_add_drive (g, filename) == -1) {
6566     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6567     exit (EXIT_FAILURE);
6568   }
6569
6570   filename = \"test2.img\";
6571   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6572   if (fd == -1) {
6573     perror (filename);
6574     exit (EXIT_FAILURE);
6575   }
6576   if (lseek (fd, %d, SEEK_SET) == -1) {
6577     perror (\"lseek\");
6578     close (fd);
6579     unlink (filename);
6580     exit (EXIT_FAILURE);
6581   }
6582   if (write (fd, &c, 1) == -1) {
6583     perror (\"write\");
6584     close (fd);
6585     unlink (filename);
6586     exit (EXIT_FAILURE);
6587   }
6588   if (close (fd) == -1) {
6589     perror (filename);
6590     unlink (filename);
6591     exit (EXIT_FAILURE);
6592   }
6593   if (guestfs_add_drive (g, filename) == -1) {
6594     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6595     exit (EXIT_FAILURE);
6596   }
6597
6598   filename = \"test3.img\";
6599   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6600   if (fd == -1) {
6601     perror (filename);
6602     exit (EXIT_FAILURE);
6603   }
6604   if (lseek (fd, %d, SEEK_SET) == -1) {
6605     perror (\"lseek\");
6606     close (fd);
6607     unlink (filename);
6608     exit (EXIT_FAILURE);
6609   }
6610   if (write (fd, &c, 1) == -1) {
6611     perror (\"write\");
6612     close (fd);
6613     unlink (filename);
6614     exit (EXIT_FAILURE);
6615   }
6616   if (close (fd) == -1) {
6617     perror (filename);
6618     unlink (filename);
6619     exit (EXIT_FAILURE);
6620   }
6621   if (guestfs_add_drive (g, filename) == -1) {
6622     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6623     exit (EXIT_FAILURE);
6624   }
6625
6626   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6627     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6628     exit (EXIT_FAILURE);
6629   }
6630
6631   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6632   alarm (600);
6633
6634   if (guestfs_launch (g) == -1) {
6635     printf (\"guestfs_launch FAILED\\n\");
6636     exit (EXIT_FAILURE);
6637   }
6638
6639   /* Cancel previous alarm. */
6640   alarm (0);
6641
6642   nr_tests = %d;
6643
6644 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6645
6646   iteri (
6647     fun i test_name ->
6648       pr "  test_num++;\n";
6649       pr "  if (guestfs_get_verbose (g))\n";
6650       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6651       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6652       pr "  if (%s () == -1) {\n" test_name;
6653       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6654       pr "    n_failed++;\n";
6655       pr "  }\n";
6656   ) test_names;
6657   pr "\n";
6658
6659   pr "  guestfs_close (g);\n";
6660   pr "  unlink (\"test1.img\");\n";
6661   pr "  unlink (\"test2.img\");\n";
6662   pr "  unlink (\"test3.img\");\n";
6663   pr "\n";
6664
6665   pr "  if (n_failed > 0) {\n";
6666   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6667   pr "    exit (EXIT_FAILURE);\n";
6668   pr "  }\n";
6669   pr "\n";
6670
6671   pr "  exit (EXIT_SUCCESS);\n";
6672   pr "}\n"
6673
6674 and generate_one_test name flags i (init, prereq, test) =
6675   let test_name = sprintf "test_%s_%d" name i in
6676
6677   pr "\
6678 static int %s_skip (void)
6679 {
6680   const char *str;
6681
6682   str = getenv (\"TEST_ONLY\");
6683   if (str)
6684     return strstr (str, \"%s\") == NULL;
6685   str = getenv (\"SKIP_%s\");
6686   if (str && STREQ (str, \"1\")) return 1;
6687   str = getenv (\"SKIP_TEST_%s\");
6688   if (str && STREQ (str, \"1\")) return 1;
6689   return 0;
6690 }
6691
6692 " test_name name (String.uppercase test_name) (String.uppercase name);
6693
6694   (match prereq with
6695    | Disabled | Always | IfAvailable _ -> ()
6696    | If code | Unless code ->
6697        pr "static int %s_prereq (void)\n" test_name;
6698        pr "{\n";
6699        pr "  %s\n" code;
6700        pr "}\n";
6701        pr "\n";
6702   );
6703
6704   pr "\
6705 static int %s (void)
6706 {
6707   if (%s_skip ()) {
6708     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6709     return 0;
6710   }
6711
6712 " test_name test_name test_name;
6713
6714   (* Optional functions should only be tested if the relevant
6715    * support is available in the daemon.
6716    *)
6717   List.iter (
6718     function
6719     | Optional group ->
6720         pr "  if (!is_available (\"%s\")) {\n" group;
6721         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
6722         pr "    return 0;\n";
6723         pr "  }\n";
6724     | _ -> ()
6725   ) flags;
6726
6727   (match prereq with
6728    | Disabled ->
6729        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6730    | If _ ->
6731        pr "  if (! %s_prereq ()) {\n" test_name;
6732        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6733        pr "    return 0;\n";
6734        pr "  }\n";
6735        pr "\n";
6736        generate_one_test_body name i test_name init test;
6737    | Unless _ ->
6738        pr "  if (%s_prereq ()) {\n" test_name;
6739        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6740        pr "    return 0;\n";
6741        pr "  }\n";
6742        pr "\n";
6743        generate_one_test_body name i test_name init test;
6744    | IfAvailable group ->
6745        pr "  if (!is_available (\"%s\")) {\n" group;
6746        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
6747        pr "    return 0;\n";
6748        pr "  }\n";
6749        pr "\n";
6750        generate_one_test_body name i test_name init test;
6751    | Always ->
6752        generate_one_test_body name i test_name init test
6753   );
6754
6755   pr "  return 0;\n";
6756   pr "}\n";
6757   pr "\n";
6758   test_name
6759
6760 and generate_one_test_body name i test_name init test =
6761   (match init with
6762    | InitNone (* XXX at some point, InitNone and InitEmpty became
6763                * folded together as the same thing.  Really we should
6764                * make InitNone do nothing at all, but the tests may
6765                * need to be checked to make sure this is OK.
6766                *)
6767    | InitEmpty ->
6768        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6769        List.iter (generate_test_command_call test_name)
6770          [["blockdev_setrw"; "/dev/sda"];
6771           ["umount_all"];
6772           ["lvm_remove_all"]]
6773    | InitPartition ->
6774        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6775        List.iter (generate_test_command_call test_name)
6776          [["blockdev_setrw"; "/dev/sda"];
6777           ["umount_all"];
6778           ["lvm_remove_all"];
6779           ["part_disk"; "/dev/sda"; "mbr"]]
6780    | InitBasicFS ->
6781        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6782        List.iter (generate_test_command_call test_name)
6783          [["blockdev_setrw"; "/dev/sda"];
6784           ["umount_all"];
6785           ["lvm_remove_all"];
6786           ["part_disk"; "/dev/sda"; "mbr"];
6787           ["mkfs"; "ext2"; "/dev/sda1"];
6788           ["mount_options"; ""; "/dev/sda1"; "/"]]
6789    | InitBasicFSonLVM ->
6790        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6791          test_name;
6792        List.iter (generate_test_command_call test_name)
6793          [["blockdev_setrw"; "/dev/sda"];
6794           ["umount_all"];
6795           ["lvm_remove_all"];
6796           ["part_disk"; "/dev/sda"; "mbr"];
6797           ["pvcreate"; "/dev/sda1"];
6798           ["vgcreate"; "VG"; "/dev/sda1"];
6799           ["lvcreate"; "LV"; "VG"; "8"];
6800           ["mkfs"; "ext2"; "/dev/VG/LV"];
6801           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6802    | InitISOFS ->
6803        pr "  /* InitISOFS for %s */\n" test_name;
6804        List.iter (generate_test_command_call test_name)
6805          [["blockdev_setrw"; "/dev/sda"];
6806           ["umount_all"];
6807           ["lvm_remove_all"];
6808           ["mount_ro"; "/dev/sdd"; "/"]]
6809   );
6810
6811   let get_seq_last = function
6812     | [] ->
6813         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6814           test_name
6815     | seq ->
6816         let seq = List.rev seq in
6817         List.rev (List.tl seq), List.hd seq
6818   in
6819
6820   match test with
6821   | TestRun seq ->
6822       pr "  /* TestRun for %s (%d) */\n" name i;
6823       List.iter (generate_test_command_call test_name) seq
6824   | TestOutput (seq, expected) ->
6825       pr "  /* TestOutput for %s (%d) */\n" name i;
6826       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6827       let seq, last = get_seq_last seq in
6828       let test () =
6829         pr "    if (STRNEQ (r, expected)) {\n";
6830         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6831         pr "      return -1;\n";
6832         pr "    }\n"
6833       in
6834       List.iter (generate_test_command_call test_name) seq;
6835       generate_test_command_call ~test test_name last
6836   | TestOutputList (seq, expected) ->
6837       pr "  /* TestOutputList for %s (%d) */\n" name i;
6838       let seq, last = get_seq_last seq in
6839       let test () =
6840         iteri (
6841           fun i str ->
6842             pr "    if (!r[%d]) {\n" i;
6843             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6844             pr "      print_strings (r);\n";
6845             pr "      return -1;\n";
6846             pr "    }\n";
6847             pr "    {\n";
6848             pr "      const char *expected = \"%s\";\n" (c_quote str);
6849             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6850             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6851             pr "        return -1;\n";
6852             pr "      }\n";
6853             pr "    }\n"
6854         ) expected;
6855         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6856         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6857           test_name;
6858         pr "      print_strings (r);\n";
6859         pr "      return -1;\n";
6860         pr "    }\n"
6861       in
6862       List.iter (generate_test_command_call test_name) seq;
6863       generate_test_command_call ~test test_name last
6864   | TestOutputListOfDevices (seq, expected) ->
6865       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6866       let seq, last = get_seq_last seq in
6867       let test () =
6868         iteri (
6869           fun i str ->
6870             pr "    if (!r[%d]) {\n" i;
6871             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6872             pr "      print_strings (r);\n";
6873             pr "      return -1;\n";
6874             pr "    }\n";
6875             pr "    {\n";
6876             pr "      const char *expected = \"%s\";\n" (c_quote str);
6877             pr "      r[%d][5] = 's';\n" i;
6878             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6879             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6880             pr "        return -1;\n";
6881             pr "      }\n";
6882             pr "    }\n"
6883         ) expected;
6884         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6885         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6886           test_name;
6887         pr "      print_strings (r);\n";
6888         pr "      return -1;\n";
6889         pr "    }\n"
6890       in
6891       List.iter (generate_test_command_call test_name) seq;
6892       generate_test_command_call ~test test_name last
6893   | TestOutputInt (seq, expected) ->
6894       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6895       let seq, last = get_seq_last seq in
6896       let test () =
6897         pr "    if (r != %d) {\n" expected;
6898         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6899           test_name expected;
6900         pr "               (int) r);\n";
6901         pr "      return -1;\n";
6902         pr "    }\n"
6903       in
6904       List.iter (generate_test_command_call test_name) seq;
6905       generate_test_command_call ~test test_name last
6906   | TestOutputIntOp (seq, op, expected) ->
6907       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6908       let seq, last = get_seq_last seq in
6909       let test () =
6910         pr "    if (! (r %s %d)) {\n" op expected;
6911         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6912           test_name op expected;
6913         pr "               (int) r);\n";
6914         pr "      return -1;\n";
6915         pr "    }\n"
6916       in
6917       List.iter (generate_test_command_call test_name) seq;
6918       generate_test_command_call ~test test_name last
6919   | TestOutputTrue seq ->
6920       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6921       let seq, last = get_seq_last seq in
6922       let test () =
6923         pr "    if (!r) {\n";
6924         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6925           test_name;
6926         pr "      return -1;\n";
6927         pr "    }\n"
6928       in
6929       List.iter (generate_test_command_call test_name) seq;
6930       generate_test_command_call ~test test_name last
6931   | TestOutputFalse seq ->
6932       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6933       let seq, last = get_seq_last seq in
6934       let test () =
6935         pr "    if (r) {\n";
6936         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6937           test_name;
6938         pr "      return -1;\n";
6939         pr "    }\n"
6940       in
6941       List.iter (generate_test_command_call test_name) seq;
6942       generate_test_command_call ~test test_name last
6943   | TestOutputLength (seq, expected) ->
6944       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6945       let seq, last = get_seq_last seq in
6946       let test () =
6947         pr "    int j;\n";
6948         pr "    for (j = 0; j < %d; ++j)\n" expected;
6949         pr "      if (r[j] == NULL) {\n";
6950         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6951           test_name;
6952         pr "        print_strings (r);\n";
6953         pr "        return -1;\n";
6954         pr "      }\n";
6955         pr "    if (r[j] != NULL) {\n";
6956         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6957           test_name;
6958         pr "      print_strings (r);\n";
6959         pr "      return -1;\n";
6960         pr "    }\n"
6961       in
6962       List.iter (generate_test_command_call test_name) seq;
6963       generate_test_command_call ~test test_name last
6964   | TestOutputBuffer (seq, expected) ->
6965       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6966       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6967       let seq, last = get_seq_last seq in
6968       let len = String.length expected in
6969       let test () =
6970         pr "    if (size != %d) {\n" len;
6971         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6972         pr "      return -1;\n";
6973         pr "    }\n";
6974         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6975         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6976         pr "      return -1;\n";
6977         pr "    }\n"
6978       in
6979       List.iter (generate_test_command_call test_name) seq;
6980       generate_test_command_call ~test test_name last
6981   | TestOutputStruct (seq, checks) ->
6982       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6983       let seq, last = get_seq_last seq in
6984       let test () =
6985         List.iter (
6986           function
6987           | CompareWithInt (field, expected) ->
6988               pr "    if (r->%s != %d) {\n" field expected;
6989               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6990                 test_name field expected;
6991               pr "               (int) r->%s);\n" field;
6992               pr "      return -1;\n";
6993               pr "    }\n"
6994           | CompareWithIntOp (field, op, expected) ->
6995               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6996               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
6997                 test_name field op expected;
6998               pr "               (int) r->%s);\n" field;
6999               pr "      return -1;\n";
7000               pr "    }\n"
7001           | CompareWithString (field, expected) ->
7002               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7003               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7004                 test_name field expected;
7005               pr "               r->%s);\n" field;
7006               pr "      return -1;\n";
7007               pr "    }\n"
7008           | CompareFieldsIntEq (field1, field2) ->
7009               pr "    if (r->%s != r->%s) {\n" field1 field2;
7010               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7011                 test_name field1 field2;
7012               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7013               pr "      return -1;\n";
7014               pr "    }\n"
7015           | CompareFieldsStrEq (field1, field2) ->
7016               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7017               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7018                 test_name field1 field2;
7019               pr "               r->%s, r->%s);\n" field1 field2;
7020               pr "      return -1;\n";
7021               pr "    }\n"
7022         ) checks
7023       in
7024       List.iter (generate_test_command_call test_name) seq;
7025       generate_test_command_call ~test test_name last
7026   | TestLastFail seq ->
7027       pr "  /* TestLastFail for %s (%d) */\n" name i;
7028       let seq, last = get_seq_last seq in
7029       List.iter (generate_test_command_call test_name) seq;
7030       generate_test_command_call test_name ~expect_error:true last
7031
7032 (* Generate the code to run a command, leaving the result in 'r'.
7033  * If you expect to get an error then you should set expect_error:true.
7034  *)
7035 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7036   match cmd with
7037   | [] -> assert false
7038   | name :: args ->
7039       (* Look up the command to find out what args/ret it has. *)
7040       let style =
7041         try
7042           let _, style, _, _, _, _, _ =
7043             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7044           style
7045         with Not_found ->
7046           failwithf "%s: in test, command %s was not found" test_name name in
7047
7048       if List.length (snd style) <> List.length args then
7049         failwithf "%s: in test, wrong number of args given to %s"
7050           test_name name;
7051
7052       pr "  {\n";
7053
7054       List.iter (
7055         function
7056         | OptString n, "NULL" -> ()
7057         | Pathname n, arg
7058         | Device n, arg
7059         | Dev_or_Path n, arg
7060         | String n, arg
7061         | OptString n, arg ->
7062             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7063         | Int _, _
7064         | Int64 _, _
7065         | Bool _, _
7066         | FileIn _, _ | FileOut _, _ -> ()
7067         | StringList n, "" | DeviceList n, "" ->
7068             pr "    const char *const %s[1] = { NULL };\n" n
7069         | StringList n, arg | DeviceList n, arg ->
7070             let strs = string_split " " arg in
7071             iteri (
7072               fun i str ->
7073                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7074             ) strs;
7075             pr "    const char *const %s[] = {\n" n;
7076             iteri (
7077               fun i _ -> pr "      %s_%d,\n" n i
7078             ) strs;
7079             pr "      NULL\n";
7080             pr "    };\n";
7081       ) (List.combine (snd style) args);
7082
7083       let error_code =
7084         match fst style with
7085         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7086         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7087         | RConstString _ | RConstOptString _ ->
7088             pr "    const char *r;\n"; "NULL"
7089         | RString _ -> pr "    char *r;\n"; "NULL"
7090         | RStringList _ | RHashtable _ ->
7091             pr "    char **r;\n";
7092             pr "    int i;\n";
7093             "NULL"
7094         | RStruct (_, typ) ->
7095             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7096         | RStructList (_, typ) ->
7097             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7098         | RBufferOut _ ->
7099             pr "    char *r;\n";
7100             pr "    size_t size;\n";
7101             "NULL" in
7102
7103       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7104       pr "    r = guestfs_%s (g" name;
7105
7106       (* Generate the parameters. *)
7107       List.iter (
7108         function
7109         | OptString _, "NULL" -> pr ", NULL"
7110         | Pathname n, _
7111         | Device n, _ | Dev_or_Path n, _
7112         | String n, _
7113         | OptString n, _ ->
7114             pr ", %s" n
7115         | FileIn _, arg | FileOut _, arg ->
7116             pr ", \"%s\"" (c_quote arg)
7117         | StringList n, _ | DeviceList n, _ ->
7118             pr ", (char **) %s" n
7119         | Int _, arg ->
7120             let i =
7121               try int_of_string arg
7122               with Failure "int_of_string" ->
7123                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7124             pr ", %d" i
7125         | Int64 _, arg ->
7126             let i =
7127               try Int64.of_string arg
7128               with Failure "int_of_string" ->
7129                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7130             pr ", %Ld" i
7131         | Bool _, arg ->
7132             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7133       ) (List.combine (snd style) args);
7134
7135       (match fst style with
7136        | RBufferOut _ -> pr ", &size"
7137        | _ -> ()
7138       );
7139
7140       pr ");\n";
7141
7142       if not expect_error then
7143         pr "    if (r == %s)\n" error_code
7144       else
7145         pr "    if (r != %s)\n" error_code;
7146       pr "      return -1;\n";
7147
7148       (* Insert the test code. *)
7149       (match test with
7150        | None -> ()
7151        | Some f -> f ()
7152       );
7153
7154       (match fst style with
7155        | RErr | RInt _ | RInt64 _ | RBool _
7156        | RConstString _ | RConstOptString _ -> ()
7157        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7158        | RStringList _ | RHashtable _ ->
7159            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7160            pr "      free (r[i]);\n";
7161            pr "    free (r);\n"
7162        | RStruct (_, typ) ->
7163            pr "    guestfs_free_%s (r);\n" typ
7164        | RStructList (_, typ) ->
7165            pr "    guestfs_free_%s_list (r);\n" typ
7166       );
7167
7168       pr "  }\n"
7169
7170 and c_quote str =
7171   let str = replace_str str "\r" "\\r" in
7172   let str = replace_str str "\n" "\\n" in
7173   let str = replace_str str "\t" "\\t" in
7174   let str = replace_str str "\000" "\\0" in
7175   str
7176
7177 (* Generate a lot of different functions for guestfish. *)
7178 and generate_fish_cmds () =
7179   generate_header CStyle GPLv2plus;
7180
7181   let all_functions =
7182     List.filter (
7183       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7184     ) all_functions in
7185   let all_functions_sorted =
7186     List.filter (
7187       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7188     ) all_functions_sorted in
7189
7190   pr "#include <config.h>\n";
7191   pr "\n";
7192   pr "#include <stdio.h>\n";
7193   pr "#include <stdlib.h>\n";
7194   pr "#include <string.h>\n";
7195   pr "#include <inttypes.h>\n";
7196   pr "\n";
7197   pr "#include <guestfs.h>\n";
7198   pr "#include \"c-ctype.h\"\n";
7199   pr "#include \"full-write.h\"\n";
7200   pr "#include \"xstrtol.h\"\n";
7201   pr "#include \"fish.h\"\n";
7202   pr "\n";
7203
7204   (* list_commands function, which implements guestfish -h *)
7205   pr "void list_commands (void)\n";
7206   pr "{\n";
7207   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7208   pr "  list_builtin_commands ();\n";
7209   List.iter (
7210     fun (name, _, _, flags, _, shortdesc, _) ->
7211       let name = replace_char name '_' '-' in
7212       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7213         name shortdesc
7214   ) all_functions_sorted;
7215   pr "  printf (\"    %%s\\n\",";
7216   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7217   pr "}\n";
7218   pr "\n";
7219
7220   (* display_command function, which implements guestfish -h cmd *)
7221   pr "int display_command (const char *cmd)\n";
7222   pr "{\n";
7223   List.iter (
7224     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7225       let name2 = replace_char name '_' '-' in
7226       let alias =
7227         try find_map (function FishAlias n -> Some n | _ -> None) flags
7228         with Not_found -> name in
7229       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7230       let synopsis =
7231         match snd style with
7232         | [] -> name2
7233         | args ->
7234             sprintf "%s %s"
7235               name2 (String.concat " " (List.map name_of_argt args)) in
7236
7237       let warnings =
7238         if List.mem ProtocolLimitWarning flags then
7239           ("\n\n" ^ protocol_limit_warning)
7240         else "" in
7241
7242       (* For DangerWillRobinson commands, we should probably have
7243        * guestfish prompt before allowing you to use them (especially
7244        * in interactive mode). XXX
7245        *)
7246       let warnings =
7247         warnings ^
7248           if List.mem DangerWillRobinson flags then
7249             ("\n\n" ^ danger_will_robinson)
7250           else "" in
7251
7252       let warnings =
7253         warnings ^
7254           match deprecation_notice flags with
7255           | None -> ""
7256           | Some txt -> "\n\n" ^ txt in
7257
7258       let describe_alias =
7259         if name <> alias then
7260           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7261         else "" in
7262
7263       pr "  if (";
7264       pr "STRCASEEQ (cmd, \"%s\")" name;
7265       if name <> name2 then
7266         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7267       if name <> alias then
7268         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7269       pr ") {\n";
7270       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7271         name2 shortdesc
7272         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7273          "=head1 DESCRIPTION\n\n" ^
7274          longdesc ^ warnings ^ describe_alias);
7275       pr "    return 0;\n";
7276       pr "  }\n";
7277       pr "  else\n"
7278   ) all_functions;
7279   pr "    return display_builtin_command (cmd);\n";
7280   pr "}\n";
7281   pr "\n";
7282
7283   let emit_print_list_function typ =
7284     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7285       typ typ typ;
7286     pr "{\n";
7287     pr "  unsigned int i;\n";
7288     pr "\n";
7289     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7290     pr "    printf (\"[%%d] = {\\n\", i);\n";
7291     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7292     pr "    printf (\"}\\n\");\n";
7293     pr "  }\n";
7294     pr "}\n";
7295     pr "\n";
7296   in
7297
7298   (* print_* functions *)
7299   List.iter (
7300     fun (typ, cols) ->
7301       let needs_i =
7302         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7303
7304       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7305       pr "{\n";
7306       if needs_i then (
7307         pr "  unsigned int i;\n";
7308         pr "\n"
7309       );
7310       List.iter (
7311         function
7312         | name, FString ->
7313             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7314         | name, FUUID ->
7315             pr "  printf (\"%%s%s: \", indent);\n" name;
7316             pr "  for (i = 0; i < 32; ++i)\n";
7317             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7318             pr "  printf (\"\\n\");\n"
7319         | name, FBuffer ->
7320             pr "  printf (\"%%s%s: \", indent);\n" name;
7321             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7322             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7323             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7324             pr "    else\n";
7325             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7326             pr "  printf (\"\\n\");\n"
7327         | name, (FUInt64|FBytes) ->
7328             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7329               name typ name
7330         | name, FInt64 ->
7331             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7332               name typ name
7333         | name, FUInt32 ->
7334             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7335               name typ name
7336         | name, FInt32 ->
7337             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7338               name typ name
7339         | name, FChar ->
7340             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7341               name typ name
7342         | name, FOptPercent ->
7343             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7344               typ name name typ name;
7345             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7346       ) cols;
7347       pr "}\n";
7348       pr "\n";
7349   ) structs;
7350
7351   (* Emit a print_TYPE_list function definition only if that function is used. *)
7352   List.iter (
7353     function
7354     | typ, (RStructListOnly | RStructAndList) ->
7355         (* generate the function for typ *)
7356         emit_print_list_function typ
7357     | typ, _ -> () (* empty *)
7358   ) (rstructs_used_by all_functions);
7359
7360   (* Emit a print_TYPE function definition only if that function is used. *)
7361   List.iter (
7362     function
7363     | typ, (RStructOnly | RStructAndList) ->
7364         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7365         pr "{\n";
7366         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7367         pr "}\n";
7368         pr "\n";
7369     | typ, _ -> () (* empty *)
7370   ) (rstructs_used_by all_functions);
7371
7372   (* run_<action> actions *)
7373   List.iter (
7374     fun (name, style, _, flags, _, _, _) ->
7375       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7376       pr "{\n";
7377       (match fst style with
7378        | RErr
7379        | RInt _
7380        | RBool _ -> pr "  int r;\n"
7381        | RInt64 _ -> pr "  int64_t r;\n"
7382        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7383        | RString _ -> pr "  char *r;\n"
7384        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7385        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7386        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7387        | RBufferOut _ ->
7388            pr "  char *r;\n";
7389            pr "  size_t size;\n";
7390       );
7391       List.iter (
7392         function
7393         | Device n
7394         | String n
7395         | OptString n
7396         | FileIn n
7397         | FileOut n -> pr "  const char *%s;\n" n
7398         | Pathname n
7399         | Dev_or_Path n -> pr "  char *%s;\n" n
7400         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7401         | Bool n -> pr "  int %s;\n" n
7402         | Int n -> pr "  int %s;\n" n
7403         | Int64 n -> pr "  int64_t %s;\n" n
7404       ) (snd style);
7405
7406       (* Check and convert parameters. *)
7407       let argc_expected = List.length (snd style) in
7408       pr "  if (argc != %d) {\n" argc_expected;
7409       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7410         argc_expected;
7411       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7412       pr "    return -1;\n";
7413       pr "  }\n";
7414
7415       let parse_integer fn fntyp rtyp range name i =
7416         pr "  {\n";
7417         pr "    strtol_error xerr;\n";
7418         pr "    %s r;\n" fntyp;
7419         pr "\n";
7420         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7421         pr "    if (xerr != LONGINT_OK) {\n";
7422         pr "      fprintf (stderr,\n";
7423         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7424         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7425         pr "      return -1;\n";
7426         pr "    }\n";
7427         (match range with
7428          | None -> ()
7429          | Some (min, max, comment) ->
7430              pr "    /* %s */\n" comment;
7431              pr "    if (r < %s || r > %s) {\n" min max;
7432              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7433                name;
7434              pr "      return -1;\n";
7435              pr "    }\n";
7436              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7437         );
7438         pr "    %s = r;\n" name;
7439         pr "  }\n";
7440       in
7441
7442       iteri (
7443         fun i ->
7444           function
7445           | Device name
7446           | String name ->
7447               pr "  %s = argv[%d];\n" name i
7448           | Pathname name
7449           | Dev_or_Path name ->
7450               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7451               pr "  if (%s == NULL) return -1;\n" name
7452           | OptString name ->
7453               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7454                 name i i
7455           | FileIn name ->
7456               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7457                 name i i
7458           | FileOut name ->
7459               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7460                 name i i
7461           | StringList name | DeviceList name ->
7462               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7463               pr "  if (%s == NULL) return -1;\n" name;
7464           | Bool name ->
7465               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7466           | Int name ->
7467               let range =
7468                 let min = "(-(2LL<<30))"
7469                 and max = "((2LL<<30)-1)"
7470                 and comment =
7471                   "The Int type in the generator is a signed 31 bit int." in
7472                 Some (min, max, comment) in
7473               parse_integer "xstrtoll" "long long" "int" range name i
7474           | Int64 name ->
7475               parse_integer "xstrtoll" "long long" "int64_t" None name i
7476       ) (snd style);
7477
7478       (* Call C API function. *)
7479       let fn =
7480         try find_map (function FishAction n -> Some n | _ -> None) flags
7481         with Not_found -> sprintf "guestfs_%s" name in
7482       pr "  r = %s " fn;
7483       generate_c_call_args ~handle:"g" style;
7484       pr ";\n";
7485
7486       List.iter (
7487         function
7488         | Device name | String name
7489         | OptString name | FileIn name | FileOut name | Bool name
7490         | Int name | Int64 name -> ()
7491         | Pathname name | Dev_or_Path name ->
7492             pr "  free (%s);\n" name
7493         | StringList name | DeviceList name ->
7494             pr "  free_strings (%s);\n" name
7495       ) (snd style);
7496
7497       (* Check return value for errors and display command results. *)
7498       (match fst style with
7499        | RErr -> pr "  return r;\n"
7500        | RInt _ ->
7501            pr "  if (r == -1) return -1;\n";
7502            pr "  printf (\"%%d\\n\", r);\n";
7503            pr "  return 0;\n"
7504        | RInt64 _ ->
7505            pr "  if (r == -1) return -1;\n";
7506            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7507            pr "  return 0;\n"
7508        | RBool _ ->
7509            pr "  if (r == -1) return -1;\n";
7510            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7511            pr "  return 0;\n"
7512        | RConstString _ ->
7513            pr "  if (r == NULL) return -1;\n";
7514            pr "  printf (\"%%s\\n\", r);\n";
7515            pr "  return 0;\n"
7516        | RConstOptString _ ->
7517            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7518            pr "  return 0;\n"
7519        | RString _ ->
7520            pr "  if (r == NULL) return -1;\n";
7521            pr "  printf (\"%%s\\n\", r);\n";
7522            pr "  free (r);\n";
7523            pr "  return 0;\n"
7524        | RStringList _ ->
7525            pr "  if (r == NULL) return -1;\n";
7526            pr "  print_strings (r);\n";
7527            pr "  free_strings (r);\n";
7528            pr "  return 0;\n"
7529        | RStruct (_, typ) ->
7530            pr "  if (r == NULL) return -1;\n";
7531            pr "  print_%s (r);\n" typ;
7532            pr "  guestfs_free_%s (r);\n" typ;
7533            pr "  return 0;\n"
7534        | RStructList (_, typ) ->
7535            pr "  if (r == NULL) return -1;\n";
7536            pr "  print_%s_list (r);\n" typ;
7537            pr "  guestfs_free_%s_list (r);\n" typ;
7538            pr "  return 0;\n"
7539        | RHashtable _ ->
7540            pr "  if (r == NULL) return -1;\n";
7541            pr "  print_table (r);\n";
7542            pr "  free_strings (r);\n";
7543            pr "  return 0;\n"
7544        | RBufferOut _ ->
7545            pr "  if (r == NULL) return -1;\n";
7546            pr "  if (full_write (1, r, size) != size) {\n";
7547            pr "    perror (\"write\");\n";
7548            pr "    free (r);\n";
7549            pr "    return -1;\n";
7550            pr "  }\n";
7551            pr "  free (r);\n";
7552            pr "  return 0;\n"
7553       );
7554       pr "}\n";
7555       pr "\n"
7556   ) all_functions;
7557
7558   (* run_action function *)
7559   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7560   pr "{\n";
7561   List.iter (
7562     fun (name, _, _, flags, _, _, _) ->
7563       let name2 = replace_char name '_' '-' in
7564       let alias =
7565         try find_map (function FishAlias n -> Some n | _ -> None) flags
7566         with Not_found -> name in
7567       pr "  if (";
7568       pr "STRCASEEQ (cmd, \"%s\")" name;
7569       if name <> name2 then
7570         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7571       if name <> alias then
7572         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7573       pr ")\n";
7574       pr "    return run_%s (cmd, argc, argv);\n" name;
7575       pr "  else\n";
7576   ) all_functions;
7577   pr "    {\n";
7578   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7579   pr "      if (command_num == 1)\n";
7580   pr "        extended_help_message ();\n";
7581   pr "      return -1;\n";
7582   pr "    }\n";
7583   pr "  return 0;\n";
7584   pr "}\n";
7585   pr "\n"
7586
7587 (* Readline completion for guestfish. *)
7588 and generate_fish_completion () =
7589   generate_header CStyle GPLv2plus;
7590
7591   let all_functions =
7592     List.filter (
7593       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7594     ) all_functions in
7595
7596   pr "\
7597 #include <config.h>
7598
7599 #include <stdio.h>
7600 #include <stdlib.h>
7601 #include <string.h>
7602
7603 #ifdef HAVE_LIBREADLINE
7604 #include <readline/readline.h>
7605 #endif
7606
7607 #include \"fish.h\"
7608
7609 #ifdef HAVE_LIBREADLINE
7610
7611 static const char *const commands[] = {
7612   BUILTIN_COMMANDS_FOR_COMPLETION,
7613 ";
7614
7615   (* Get the commands, including the aliases.  They don't need to be
7616    * sorted - the generator() function just does a dumb linear search.
7617    *)
7618   let commands =
7619     List.map (
7620       fun (name, _, _, flags, _, _, _) ->
7621         let name2 = replace_char name '_' '-' in
7622         let alias =
7623           try find_map (function FishAlias n -> Some n | _ -> None) flags
7624           with Not_found -> name in
7625
7626         if name <> alias then [name2; alias] else [name2]
7627     ) all_functions in
7628   let commands = List.flatten commands in
7629
7630   List.iter (pr "  \"%s\",\n") commands;
7631
7632   pr "  NULL
7633 };
7634
7635 static char *
7636 generator (const char *text, int state)
7637 {
7638   static int index, len;
7639   const char *name;
7640
7641   if (!state) {
7642     index = 0;
7643     len = strlen (text);
7644   }
7645
7646   rl_attempted_completion_over = 1;
7647
7648   while ((name = commands[index]) != NULL) {
7649     index++;
7650     if (STRCASEEQLEN (name, text, len))
7651       return strdup (name);
7652   }
7653
7654   return NULL;
7655 }
7656
7657 #endif /* HAVE_LIBREADLINE */
7658
7659 #ifdef HAVE_RL_COMPLETION_MATCHES
7660 #define RL_COMPLETION_MATCHES rl_completion_matches
7661 #else
7662 #ifdef HAVE_COMPLETION_MATCHES
7663 #define RL_COMPLETION_MATCHES completion_matches
7664 #endif
7665 #endif /* else just fail if we don't have either symbol */
7666
7667 char **
7668 do_completion (const char *text, int start, int end)
7669 {
7670   char **matches = NULL;
7671
7672 #ifdef HAVE_LIBREADLINE
7673   rl_completion_append_character = ' ';
7674
7675   if (start == 0)
7676     matches = RL_COMPLETION_MATCHES (text, generator);
7677   else if (complete_dest_paths)
7678     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7679 #endif
7680
7681   return matches;
7682 }
7683 ";
7684
7685 (* Generate the POD documentation for guestfish. *)
7686 and generate_fish_actions_pod () =
7687   let all_functions_sorted =
7688     List.filter (
7689       fun (_, _, _, flags, _, _, _) ->
7690         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7691     ) all_functions_sorted in
7692
7693   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7694
7695   List.iter (
7696     fun (name, style, _, flags, _, _, longdesc) ->
7697       let longdesc =
7698         Str.global_substitute rex (
7699           fun s ->
7700             let sub =
7701               try Str.matched_group 1 s
7702               with Not_found ->
7703                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7704             "C<" ^ replace_char sub '_' '-' ^ ">"
7705         ) longdesc in
7706       let name = replace_char name '_' '-' in
7707       let alias =
7708         try find_map (function FishAlias n -> Some n | _ -> None) flags
7709         with Not_found -> name in
7710
7711       pr "=head2 %s" name;
7712       if name <> alias then
7713         pr " | %s" alias;
7714       pr "\n";
7715       pr "\n";
7716       pr " %s" name;
7717       List.iter (
7718         function
7719         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7720         | OptString n -> pr " %s" n
7721         | StringList n | DeviceList n -> pr " '%s ...'" n
7722         | Bool _ -> pr " true|false"
7723         | Int n -> pr " %s" n
7724         | Int64 n -> pr " %s" n
7725         | FileIn n | FileOut n -> pr " (%s|-)" n
7726       ) (snd style);
7727       pr "\n";
7728       pr "\n";
7729       pr "%s\n\n" longdesc;
7730
7731       if List.exists (function FileIn _ | FileOut _ -> true
7732                       | _ -> false) (snd style) then
7733         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7734
7735       if List.mem ProtocolLimitWarning flags then
7736         pr "%s\n\n" protocol_limit_warning;
7737
7738       if List.mem DangerWillRobinson flags then
7739         pr "%s\n\n" danger_will_robinson;
7740
7741       match deprecation_notice flags with
7742       | None -> ()
7743       | Some txt -> pr "%s\n\n" txt
7744   ) all_functions_sorted
7745
7746 (* Generate a C function prototype. *)
7747 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7748     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7749     ?(prefix = "")
7750     ?handle name style =
7751   if extern then pr "extern ";
7752   if static then pr "static ";
7753   (match fst style with
7754    | RErr -> pr "int "
7755    | RInt _ -> pr "int "
7756    | RInt64 _ -> pr "int64_t "
7757    | RBool _ -> pr "int "
7758    | RConstString _ | RConstOptString _ -> pr "const char *"
7759    | RString _ | RBufferOut _ -> pr "char *"
7760    | RStringList _ | RHashtable _ -> pr "char **"
7761    | RStruct (_, typ) ->
7762        if not in_daemon then pr "struct guestfs_%s *" typ
7763        else pr "guestfs_int_%s *" typ
7764    | RStructList (_, typ) ->
7765        if not in_daemon then pr "struct guestfs_%s_list *" typ
7766        else pr "guestfs_int_%s_list *" typ
7767   );
7768   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7769   pr "%s%s (" prefix name;
7770   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7771     pr "void"
7772   else (
7773     let comma = ref false in
7774     (match handle with
7775      | None -> ()
7776      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7777     );
7778     let next () =
7779       if !comma then (
7780         if single_line then pr ", " else pr ",\n\t\t"
7781       );
7782       comma := true
7783     in
7784     List.iter (
7785       function
7786       | Pathname n
7787       | Device n | Dev_or_Path n
7788       | String n
7789       | OptString n ->
7790           next ();
7791           pr "const char *%s" n
7792       | StringList n | DeviceList n ->
7793           next ();
7794           pr "char *const *%s" n
7795       | Bool n -> next (); pr "int %s" n
7796       | Int n -> next (); pr "int %s" n
7797       | Int64 n -> next (); pr "int64_t %s" n
7798       | FileIn n
7799       | FileOut n ->
7800           if not in_daemon then (next (); pr "const char *%s" n)
7801     ) (snd style);
7802     if is_RBufferOut then (next (); pr "size_t *size_r");
7803   );
7804   pr ")";
7805   if semicolon then pr ";";
7806   if newline then pr "\n"
7807
7808 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7809 and generate_c_call_args ?handle ?(decl = false) style =
7810   pr "(";
7811   let comma = ref false in
7812   let next () =
7813     if !comma then pr ", ";
7814     comma := true
7815   in
7816   (match handle with
7817    | None -> ()
7818    | Some handle -> pr "%s" handle; comma := true
7819   );
7820   List.iter (
7821     fun arg ->
7822       next ();
7823       pr "%s" (name_of_argt arg)
7824   ) (snd style);
7825   (* For RBufferOut calls, add implicit &size parameter. *)
7826   if not decl then (
7827     match fst style with
7828     | RBufferOut _ ->
7829         next ();
7830         pr "&size"
7831     | _ -> ()
7832   );
7833   pr ")"
7834
7835 (* Generate the OCaml bindings interface. *)
7836 and generate_ocaml_mli () =
7837   generate_header OCamlStyle LGPLv2plus;
7838
7839   pr "\
7840 (** For API documentation you should refer to the C API
7841     in the guestfs(3) manual page.  The OCaml API uses almost
7842     exactly the same calls. *)
7843
7844 type t
7845 (** A [guestfs_h] handle. *)
7846
7847 exception Error of string
7848 (** This exception is raised when there is an error. *)
7849
7850 exception Handle_closed of string
7851 (** This exception is raised if you use a {!Guestfs.t} handle
7852     after calling {!close} on it.  The string is the name of
7853     the function. *)
7854
7855 val create : unit -> t
7856 (** Create a {!Guestfs.t} handle. *)
7857
7858 val close : t -> unit
7859 (** Close the {!Guestfs.t} handle and free up all resources used
7860     by it immediately.
7861
7862     Handles are closed by the garbage collector when they become
7863     unreferenced, but callers can call this in order to provide
7864     predictable cleanup. *)
7865
7866 ";
7867   generate_ocaml_structure_decls ();
7868
7869   (* The actions. *)
7870   List.iter (
7871     fun (name, style, _, _, _, shortdesc, _) ->
7872       generate_ocaml_prototype name style;
7873       pr "(** %s *)\n" shortdesc;
7874       pr "\n"
7875   ) all_functions_sorted
7876
7877 (* Generate the OCaml bindings implementation. *)
7878 and generate_ocaml_ml () =
7879   generate_header OCamlStyle LGPLv2plus;
7880
7881   pr "\
7882 type t
7883
7884 exception Error of string
7885 exception Handle_closed of string
7886
7887 external create : unit -> t = \"ocaml_guestfs_create\"
7888 external close : t -> unit = \"ocaml_guestfs_close\"
7889
7890 (* Give the exceptions names, so they can be raised from the C code. *)
7891 let () =
7892   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7893   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7894
7895 ";
7896
7897   generate_ocaml_structure_decls ();
7898
7899   (* The actions. *)
7900   List.iter (
7901     fun (name, style, _, _, _, shortdesc, _) ->
7902       generate_ocaml_prototype ~is_external:true name style;
7903   ) all_functions_sorted
7904
7905 (* Generate the OCaml bindings C implementation. *)
7906 and generate_ocaml_c () =
7907   generate_header CStyle LGPLv2plus;
7908
7909   pr "\
7910 #include <stdio.h>
7911 #include <stdlib.h>
7912 #include <string.h>
7913
7914 #include <caml/config.h>
7915 #include <caml/alloc.h>
7916 #include <caml/callback.h>
7917 #include <caml/fail.h>
7918 #include <caml/memory.h>
7919 #include <caml/mlvalues.h>
7920 #include <caml/signals.h>
7921
7922 #include <guestfs.h>
7923
7924 #include \"guestfs_c.h\"
7925
7926 /* Copy a hashtable of string pairs into an assoc-list.  We return
7927  * the list in reverse order, but hashtables aren't supposed to be
7928  * ordered anyway.
7929  */
7930 static CAMLprim value
7931 copy_table (char * const * argv)
7932 {
7933   CAMLparam0 ();
7934   CAMLlocal5 (rv, pairv, kv, vv, cons);
7935   int i;
7936
7937   rv = Val_int (0);
7938   for (i = 0; argv[i] != NULL; i += 2) {
7939     kv = caml_copy_string (argv[i]);
7940     vv = caml_copy_string (argv[i+1]);
7941     pairv = caml_alloc (2, 0);
7942     Store_field (pairv, 0, kv);
7943     Store_field (pairv, 1, vv);
7944     cons = caml_alloc (2, 0);
7945     Store_field (cons, 1, rv);
7946     rv = cons;
7947     Store_field (cons, 0, pairv);
7948   }
7949
7950   CAMLreturn (rv);
7951 }
7952
7953 ";
7954
7955   (* Struct copy functions. *)
7956
7957   let emit_ocaml_copy_list_function typ =
7958     pr "static CAMLprim value\n";
7959     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7960     pr "{\n";
7961     pr "  CAMLparam0 ();\n";
7962     pr "  CAMLlocal2 (rv, v);\n";
7963     pr "  unsigned int i;\n";
7964     pr "\n";
7965     pr "  if (%ss->len == 0)\n" typ;
7966     pr "    CAMLreturn (Atom (0));\n";
7967     pr "  else {\n";
7968     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7969     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7970     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7971     pr "      caml_modify (&Field (rv, i), v);\n";
7972     pr "    }\n";
7973     pr "    CAMLreturn (rv);\n";
7974     pr "  }\n";
7975     pr "}\n";
7976     pr "\n";
7977   in
7978
7979   List.iter (
7980     fun (typ, cols) ->
7981       let has_optpercent_col =
7982         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7983
7984       pr "static CAMLprim value\n";
7985       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7986       pr "{\n";
7987       pr "  CAMLparam0 ();\n";
7988       if has_optpercent_col then
7989         pr "  CAMLlocal3 (rv, v, v2);\n"
7990       else
7991         pr "  CAMLlocal2 (rv, v);\n";
7992       pr "\n";
7993       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7994       iteri (
7995         fun i col ->
7996           (match col with
7997            | name, FString ->
7998                pr "  v = caml_copy_string (%s->%s);\n" typ name
7999            | name, FBuffer ->
8000                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8001                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8002                  typ name typ name
8003            | name, FUUID ->
8004                pr "  v = caml_alloc_string (32);\n";
8005                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8006            | name, (FBytes|FInt64|FUInt64) ->
8007                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8008            | name, (FInt32|FUInt32) ->
8009                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8010            | name, FOptPercent ->
8011                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8012                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8013                pr "    v = caml_alloc (1, 0);\n";
8014                pr "    Store_field (v, 0, v2);\n";
8015                pr "  } else /* None */\n";
8016                pr "    v = Val_int (0);\n";
8017            | name, FChar ->
8018                pr "  v = Val_int (%s->%s);\n" typ name
8019           );
8020           pr "  Store_field (rv, %d, v);\n" i
8021       ) cols;
8022       pr "  CAMLreturn (rv);\n";
8023       pr "}\n";
8024       pr "\n";
8025   ) structs;
8026
8027   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8028   List.iter (
8029     function
8030     | typ, (RStructListOnly | RStructAndList) ->
8031         (* generate the function for typ *)
8032         emit_ocaml_copy_list_function typ
8033     | typ, _ -> () (* empty *)
8034   ) (rstructs_used_by all_functions);
8035
8036   (* The wrappers. *)
8037   List.iter (
8038     fun (name, style, _, _, _, _, _) ->
8039       pr "/* Automatically generated wrapper for function\n";
8040       pr " * ";
8041       generate_ocaml_prototype name style;
8042       pr " */\n";
8043       pr "\n";
8044
8045       let params =
8046         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8047
8048       let needs_extra_vs =
8049         match fst style with RConstOptString _ -> true | _ -> false in
8050
8051       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8052       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8053       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8054       pr "\n";
8055
8056       pr "CAMLprim value\n";
8057       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8058       List.iter (pr ", value %s") (List.tl params);
8059       pr ")\n";
8060       pr "{\n";
8061
8062       (match params with
8063        | [p1; p2; p3; p4; p5] ->
8064            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8065        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8066            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8067            pr "  CAMLxparam%d (%s);\n"
8068              (List.length rest) (String.concat ", " rest)
8069        | ps ->
8070            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8071       );
8072       if not needs_extra_vs then
8073         pr "  CAMLlocal1 (rv);\n"
8074       else
8075         pr "  CAMLlocal3 (rv, v, v2);\n";
8076       pr "\n";
8077
8078       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8079       pr "  if (g == NULL)\n";
8080       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8081       pr "\n";
8082
8083       List.iter (
8084         function
8085         | Pathname n
8086         | Device n | Dev_or_Path n
8087         | String n
8088         | FileIn n
8089         | FileOut n ->
8090             pr "  const char *%s = String_val (%sv);\n" n n
8091         | OptString n ->
8092             pr "  const char *%s =\n" n;
8093             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
8094               n n
8095         | StringList n | DeviceList n ->
8096             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8097         | Bool n ->
8098             pr "  int %s = Bool_val (%sv);\n" n n
8099         | Int n ->
8100             pr "  int %s = Int_val (%sv);\n" n n
8101         | Int64 n ->
8102             pr "  int64_t %s = Int64_val (%sv);\n" n n
8103       ) (snd style);
8104       let error_code =
8105         match fst style with
8106         | RErr -> pr "  int r;\n"; "-1"
8107         | RInt _ -> pr "  int r;\n"; "-1"
8108         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8109         | RBool _ -> pr "  int r;\n"; "-1"
8110         | RConstString _ | RConstOptString _ ->
8111             pr "  const char *r;\n"; "NULL"
8112         | RString _ -> pr "  char *r;\n"; "NULL"
8113         | RStringList _ ->
8114             pr "  int i;\n";
8115             pr "  char **r;\n";
8116             "NULL"
8117         | RStruct (_, typ) ->
8118             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8119         | RStructList (_, typ) ->
8120             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8121         | RHashtable _ ->
8122             pr "  int i;\n";
8123             pr "  char **r;\n";
8124             "NULL"
8125         | RBufferOut _ ->
8126             pr "  char *r;\n";
8127             pr "  size_t size;\n";
8128             "NULL" in
8129       pr "\n";
8130
8131       pr "  caml_enter_blocking_section ();\n";
8132       pr "  r = guestfs_%s " name;
8133       generate_c_call_args ~handle:"g" style;
8134       pr ";\n";
8135       pr "  caml_leave_blocking_section ();\n";
8136
8137       List.iter (
8138         function
8139         | StringList n | DeviceList n ->
8140             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8141         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8142         | Bool _ | Int _ | Int64 _
8143         | FileIn _ | FileOut _ -> ()
8144       ) (snd style);
8145
8146       pr "  if (r == %s)\n" error_code;
8147       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8148       pr "\n";
8149
8150       (match fst style with
8151        | RErr -> pr "  rv = Val_unit;\n"
8152        | RInt _ -> pr "  rv = Val_int (r);\n"
8153        | RInt64 _ ->
8154            pr "  rv = caml_copy_int64 (r);\n"
8155        | RBool _ -> pr "  rv = Val_bool (r);\n"
8156        | RConstString _ ->
8157            pr "  rv = caml_copy_string (r);\n"
8158        | RConstOptString _ ->
8159            pr "  if (r) { /* Some string */\n";
8160            pr "    v = caml_alloc (1, 0);\n";
8161            pr "    v2 = caml_copy_string (r);\n";
8162            pr "    Store_field (v, 0, v2);\n";
8163            pr "  } else /* None */\n";
8164            pr "    v = Val_int (0);\n";
8165        | RString _ ->
8166            pr "  rv = caml_copy_string (r);\n";
8167            pr "  free (r);\n"
8168        | RStringList _ ->
8169            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8170            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8171            pr "  free (r);\n"
8172        | RStruct (_, typ) ->
8173            pr "  rv = copy_%s (r);\n" typ;
8174            pr "  guestfs_free_%s (r);\n" typ;
8175        | RStructList (_, typ) ->
8176            pr "  rv = copy_%s_list (r);\n" typ;
8177            pr "  guestfs_free_%s_list (r);\n" typ;
8178        | RHashtable _ ->
8179            pr "  rv = copy_table (r);\n";
8180            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8181            pr "  free (r);\n";
8182        | RBufferOut _ ->
8183            pr "  rv = caml_alloc_string (size);\n";
8184            pr "  memcpy (String_val (rv), r, size);\n";
8185       );
8186
8187       pr "  CAMLreturn (rv);\n";
8188       pr "}\n";
8189       pr "\n";
8190
8191       if List.length params > 5 then (
8192         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8193         pr "CAMLprim value ";
8194         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8195         pr "CAMLprim value\n";
8196         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8197         pr "{\n";
8198         pr "  return ocaml_guestfs_%s (argv[0]" name;
8199         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8200         pr ");\n";
8201         pr "}\n";
8202         pr "\n"
8203       )
8204   ) all_functions_sorted
8205
8206 and generate_ocaml_structure_decls () =
8207   List.iter (
8208     fun (typ, cols) ->
8209       pr "type %s = {\n" typ;
8210       List.iter (
8211         function
8212         | name, FString -> pr "  %s : string;\n" name
8213         | name, FBuffer -> pr "  %s : string;\n" name
8214         | name, FUUID -> pr "  %s : string;\n" name
8215         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8216         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8217         | name, FChar -> pr "  %s : char;\n" name
8218         | name, FOptPercent -> pr "  %s : float option;\n" name
8219       ) cols;
8220       pr "}\n";
8221       pr "\n"
8222   ) structs
8223
8224 and generate_ocaml_prototype ?(is_external = false) name style =
8225   if is_external then pr "external " else pr "val ";
8226   pr "%s : t -> " name;
8227   List.iter (
8228     function
8229     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8230     | OptString _ -> pr "string option -> "
8231     | StringList _ | DeviceList _ -> pr "string array -> "
8232     | Bool _ -> pr "bool -> "
8233     | Int _ -> pr "int -> "
8234     | Int64 _ -> pr "int64 -> "
8235   ) (snd style);
8236   (match fst style with
8237    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8238    | RInt _ -> pr "int"
8239    | RInt64 _ -> pr "int64"
8240    | RBool _ -> pr "bool"
8241    | RConstString _ -> pr "string"
8242    | RConstOptString _ -> pr "string option"
8243    | RString _ | RBufferOut _ -> pr "string"
8244    | RStringList _ -> pr "string array"
8245    | RStruct (_, typ) -> pr "%s" typ
8246    | RStructList (_, typ) -> pr "%s array" typ
8247    | RHashtable _ -> pr "(string * string) list"
8248   );
8249   if is_external then (
8250     pr " = ";
8251     if List.length (snd style) + 1 > 5 then
8252       pr "\"ocaml_guestfs_%s_byte\" " name;
8253     pr "\"ocaml_guestfs_%s\"" name
8254   );
8255   pr "\n"
8256
8257 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8258 and generate_perl_xs () =
8259   generate_header CStyle LGPLv2plus;
8260
8261   pr "\
8262 #include \"EXTERN.h\"
8263 #include \"perl.h\"
8264 #include \"XSUB.h\"
8265
8266 #include <guestfs.h>
8267
8268 #ifndef PRId64
8269 #define PRId64 \"lld\"
8270 #endif
8271
8272 static SV *
8273 my_newSVll(long long val) {
8274 #ifdef USE_64_BIT_ALL
8275   return newSViv(val);
8276 #else
8277   char buf[100];
8278   int len;
8279   len = snprintf(buf, 100, \"%%\" PRId64, val);
8280   return newSVpv(buf, len);
8281 #endif
8282 }
8283
8284 #ifndef PRIu64
8285 #define PRIu64 \"llu\"
8286 #endif
8287
8288 static SV *
8289 my_newSVull(unsigned long long val) {
8290 #ifdef USE_64_BIT_ALL
8291   return newSVuv(val);
8292 #else
8293   char buf[100];
8294   int len;
8295   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8296   return newSVpv(buf, len);
8297 #endif
8298 }
8299
8300 /* http://www.perlmonks.org/?node_id=680842 */
8301 static char **
8302 XS_unpack_charPtrPtr (SV *arg) {
8303   char **ret;
8304   AV *av;
8305   I32 i;
8306
8307   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8308     croak (\"array reference expected\");
8309
8310   av = (AV *)SvRV (arg);
8311   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8312   if (!ret)
8313     croak (\"malloc failed\");
8314
8315   for (i = 0; i <= av_len (av); i++) {
8316     SV **elem = av_fetch (av, i, 0);
8317
8318     if (!elem || !*elem)
8319       croak (\"missing element in list\");
8320
8321     ret[i] = SvPV_nolen (*elem);
8322   }
8323
8324   ret[i] = NULL;
8325
8326   return ret;
8327 }
8328
8329 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8330
8331 PROTOTYPES: ENABLE
8332
8333 guestfs_h *
8334 _create ()
8335    CODE:
8336       RETVAL = guestfs_create ();
8337       if (!RETVAL)
8338         croak (\"could not create guestfs handle\");
8339       guestfs_set_error_handler (RETVAL, NULL, NULL);
8340  OUTPUT:
8341       RETVAL
8342
8343 void
8344 DESTROY (g)
8345       guestfs_h *g;
8346  PPCODE:
8347       guestfs_close (g);
8348
8349 ";
8350
8351   List.iter (
8352     fun (name, style, _, _, _, _, _) ->
8353       (match fst style with
8354        | RErr -> pr "void\n"
8355        | RInt _ -> pr "SV *\n"
8356        | RInt64 _ -> pr "SV *\n"
8357        | RBool _ -> pr "SV *\n"
8358        | RConstString _ -> pr "SV *\n"
8359        | RConstOptString _ -> pr "SV *\n"
8360        | RString _ -> pr "SV *\n"
8361        | RBufferOut _ -> pr "SV *\n"
8362        | RStringList _
8363        | RStruct _ | RStructList _
8364        | RHashtable _ ->
8365            pr "void\n" (* all lists returned implictly on the stack *)
8366       );
8367       (* Call and arguments. *)
8368       pr "%s " name;
8369       generate_c_call_args ~handle:"g" ~decl:true style;
8370       pr "\n";
8371       pr "      guestfs_h *g;\n";
8372       iteri (
8373         fun i ->
8374           function
8375           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8376               pr "      char *%s;\n" n
8377           | OptString n ->
8378               (* http://www.perlmonks.org/?node_id=554277
8379                * Note that the implicit handle argument means we have
8380                * to add 1 to the ST(x) operator.
8381                *)
8382               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8383           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8384           | Bool n -> pr "      int %s;\n" n
8385           | Int n -> pr "      int %s;\n" n
8386           | Int64 n -> pr "      int64_t %s;\n" n
8387       ) (snd style);
8388
8389       let do_cleanups () =
8390         List.iter (
8391           function
8392           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8393           | Bool _ | Int _ | Int64 _
8394           | FileIn _ | FileOut _ -> ()
8395           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8396         ) (snd style)
8397       in
8398
8399       (* Code. *)
8400       (match fst style with
8401        | RErr ->
8402            pr "PREINIT:\n";
8403            pr "      int r;\n";
8404            pr " PPCODE:\n";
8405            pr "      r = guestfs_%s " name;
8406            generate_c_call_args ~handle:"g" style;
8407            pr ";\n";
8408            do_cleanups ();
8409            pr "      if (r == -1)\n";
8410            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8411        | RInt n
8412        | RBool n ->
8413            pr "PREINIT:\n";
8414            pr "      int %s;\n" n;
8415            pr "   CODE:\n";
8416            pr "      %s = guestfs_%s " n name;
8417            generate_c_call_args ~handle:"g" style;
8418            pr ";\n";
8419            do_cleanups ();
8420            pr "      if (%s == -1)\n" n;
8421            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8422            pr "      RETVAL = newSViv (%s);\n" n;
8423            pr " OUTPUT:\n";
8424            pr "      RETVAL\n"
8425        | RInt64 n ->
8426            pr "PREINIT:\n";
8427            pr "      int64_t %s;\n" n;
8428            pr "   CODE:\n";
8429            pr "      %s = guestfs_%s " n name;
8430            generate_c_call_args ~handle:"g" style;
8431            pr ";\n";
8432            do_cleanups ();
8433            pr "      if (%s == -1)\n" n;
8434            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8435            pr "      RETVAL = my_newSVll (%s);\n" n;
8436            pr " OUTPUT:\n";
8437            pr "      RETVAL\n"
8438        | RConstString n ->
8439            pr "PREINIT:\n";
8440            pr "      const char *%s;\n" n;
8441            pr "   CODE:\n";
8442            pr "      %s = guestfs_%s " n name;
8443            generate_c_call_args ~handle:"g" style;
8444            pr ";\n";
8445            do_cleanups ();
8446            pr "      if (%s == NULL)\n" n;
8447            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8448            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8449            pr " OUTPUT:\n";
8450            pr "      RETVAL\n"
8451        | RConstOptString n ->
8452            pr "PREINIT:\n";
8453            pr "      const char *%s;\n" n;
8454            pr "   CODE:\n";
8455            pr "      %s = guestfs_%s " n name;
8456            generate_c_call_args ~handle:"g" style;
8457            pr ";\n";
8458            do_cleanups ();
8459            pr "      if (%s == NULL)\n" n;
8460            pr "        RETVAL = &PL_sv_undef;\n";
8461            pr "      else\n";
8462            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8463            pr " OUTPUT:\n";
8464            pr "      RETVAL\n"
8465        | RString n ->
8466            pr "PREINIT:\n";
8467            pr "      char *%s;\n" n;
8468            pr "   CODE:\n";
8469            pr "      %s = guestfs_%s " n name;
8470            generate_c_call_args ~handle:"g" style;
8471            pr ";\n";
8472            do_cleanups ();
8473            pr "      if (%s == NULL)\n" n;
8474            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8475            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8476            pr "      free (%s);\n" n;
8477            pr " OUTPUT:\n";
8478            pr "      RETVAL\n"
8479        | RStringList n | RHashtable n ->
8480            pr "PREINIT:\n";
8481            pr "      char **%s;\n" n;
8482            pr "      int i, n;\n";
8483            pr " PPCODE:\n";
8484            pr "      %s = guestfs_%s " n name;
8485            generate_c_call_args ~handle:"g" style;
8486            pr ";\n";
8487            do_cleanups ();
8488            pr "      if (%s == NULL)\n" n;
8489            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8490            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8491            pr "      EXTEND (SP, n);\n";
8492            pr "      for (i = 0; i < n; ++i) {\n";
8493            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8494            pr "        free (%s[i]);\n" n;
8495            pr "      }\n";
8496            pr "      free (%s);\n" n;
8497        | RStruct (n, typ) ->
8498            let cols = cols_of_struct typ in
8499            generate_perl_struct_code typ cols name style n do_cleanups
8500        | RStructList (n, typ) ->
8501            let cols = cols_of_struct typ in
8502            generate_perl_struct_list_code typ cols name style n do_cleanups
8503        | RBufferOut n ->
8504            pr "PREINIT:\n";
8505            pr "      char *%s;\n" n;
8506            pr "      size_t size;\n";
8507            pr "   CODE:\n";
8508            pr "      %s = guestfs_%s " n name;
8509            generate_c_call_args ~handle:"g" style;
8510            pr ";\n";
8511            do_cleanups ();
8512            pr "      if (%s == NULL)\n" n;
8513            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8514            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8515            pr "      free (%s);\n" n;
8516            pr " OUTPUT:\n";
8517            pr "      RETVAL\n"
8518       );
8519
8520       pr "\n"
8521   ) all_functions
8522
8523 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8524   pr "PREINIT:\n";
8525   pr "      struct guestfs_%s_list *%s;\n" typ n;
8526   pr "      int i;\n";
8527   pr "      HV *hv;\n";
8528   pr " PPCODE:\n";
8529   pr "      %s = guestfs_%s " n name;
8530   generate_c_call_args ~handle:"g" style;
8531   pr ";\n";
8532   do_cleanups ();
8533   pr "      if (%s == NULL)\n" n;
8534   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8535   pr "      EXTEND (SP, %s->len);\n" n;
8536   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8537   pr "        hv = newHV ();\n";
8538   List.iter (
8539     function
8540     | name, FString ->
8541         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8542           name (String.length name) n name
8543     | name, FUUID ->
8544         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8545           name (String.length name) n name
8546     | name, FBuffer ->
8547         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8548           name (String.length name) n name n name
8549     | name, (FBytes|FUInt64) ->
8550         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8551           name (String.length name) n name
8552     | name, FInt64 ->
8553         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8554           name (String.length name) n name
8555     | name, (FInt32|FUInt32) ->
8556         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8557           name (String.length name) n name
8558     | name, FChar ->
8559         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8560           name (String.length name) n name
8561     | name, FOptPercent ->
8562         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8563           name (String.length name) n name
8564   ) cols;
8565   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8566   pr "      }\n";
8567   pr "      guestfs_free_%s_list (%s);\n" typ n
8568
8569 and generate_perl_struct_code typ cols name style n do_cleanups =
8570   pr "PREINIT:\n";
8571   pr "      struct guestfs_%s *%s;\n" typ n;
8572   pr " PPCODE:\n";
8573   pr "      %s = guestfs_%s " n name;
8574   generate_c_call_args ~handle:"g" style;
8575   pr ";\n";
8576   do_cleanups ();
8577   pr "      if (%s == NULL)\n" n;
8578   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8579   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8580   List.iter (
8581     fun ((name, _) as col) ->
8582       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8583
8584       match col with
8585       | name, FString ->
8586           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8587             n name
8588       | name, FBuffer ->
8589           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8590             n name n name
8591       | name, FUUID ->
8592           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8593             n name
8594       | name, (FBytes|FUInt64) ->
8595           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8596             n name
8597       | name, FInt64 ->
8598           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8599             n name
8600       | name, (FInt32|FUInt32) ->
8601           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8602             n name
8603       | name, FChar ->
8604           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8605             n name
8606       | name, FOptPercent ->
8607           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8608             n name
8609   ) cols;
8610   pr "      free (%s);\n" n
8611
8612 (* Generate Sys/Guestfs.pm. *)
8613 and generate_perl_pm () =
8614   generate_header HashStyle LGPLv2plus;
8615
8616   pr "\
8617 =pod
8618
8619 =head1 NAME
8620
8621 Sys::Guestfs - Perl bindings for libguestfs
8622
8623 =head1 SYNOPSIS
8624
8625  use Sys::Guestfs;
8626
8627  my $h = Sys::Guestfs->new ();
8628  $h->add_drive ('guest.img');
8629  $h->launch ();
8630  $h->mount ('/dev/sda1', '/');
8631  $h->touch ('/hello');
8632  $h->sync ();
8633
8634 =head1 DESCRIPTION
8635
8636 The C<Sys::Guestfs> module provides a Perl XS binding to the
8637 libguestfs API for examining and modifying virtual machine
8638 disk images.
8639
8640 Amongst the things this is good for: making batch configuration
8641 changes to guests, getting disk used/free statistics (see also:
8642 virt-df), migrating between virtualization systems (see also:
8643 virt-p2v), performing partial backups, performing partial guest
8644 clones, cloning guests and changing registry/UUID/hostname info, and
8645 much else besides.
8646
8647 Libguestfs uses Linux kernel and qemu code, and can access any type of
8648 guest filesystem that Linux and qemu can, including but not limited
8649 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8650 schemes, qcow, qcow2, vmdk.
8651
8652 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8653 LVs, what filesystem is in each LV, etc.).  It can also run commands
8654 in the context of the guest.  Also you can access filesystems over
8655 FUSE.
8656
8657 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8658 functions for using libguestfs from Perl, including integration
8659 with libvirt.
8660
8661 =head1 ERRORS
8662
8663 All errors turn into calls to C<croak> (see L<Carp(3)>).
8664
8665 =head1 METHODS
8666
8667 =over 4
8668
8669 =cut
8670
8671 package Sys::Guestfs;
8672
8673 use strict;
8674 use warnings;
8675
8676 require XSLoader;
8677 XSLoader::load ('Sys::Guestfs');
8678
8679 =item $h = Sys::Guestfs->new ();
8680
8681 Create a new guestfs handle.
8682
8683 =cut
8684
8685 sub new {
8686   my $proto = shift;
8687   my $class = ref ($proto) || $proto;
8688
8689   my $self = Sys::Guestfs::_create ();
8690   bless $self, $class;
8691   return $self;
8692 }
8693
8694 ";
8695
8696   (* Actions.  We only need to print documentation for these as
8697    * they are pulled in from the XS code automatically.
8698    *)
8699   List.iter (
8700     fun (name, style, _, flags, _, _, longdesc) ->
8701       if not (List.mem NotInDocs flags) then (
8702         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8703         pr "=item ";
8704         generate_perl_prototype name style;
8705         pr "\n\n";
8706         pr "%s\n\n" longdesc;
8707         if List.mem ProtocolLimitWarning flags then
8708           pr "%s\n\n" protocol_limit_warning;
8709         if List.mem DangerWillRobinson flags then
8710           pr "%s\n\n" danger_will_robinson;
8711         match deprecation_notice flags with
8712         | None -> ()
8713         | Some txt -> pr "%s\n\n" txt
8714       )
8715   ) all_functions_sorted;
8716
8717   (* End of file. *)
8718   pr "\
8719 =cut
8720
8721 1;
8722
8723 =back
8724
8725 =head1 COPYRIGHT
8726
8727 Copyright (C) %s Red Hat Inc.
8728
8729 =head1 LICENSE
8730
8731 Please see the file COPYING.LIB for the full license.
8732
8733 =head1 SEE ALSO
8734
8735 L<guestfs(3)>,
8736 L<guestfish(1)>,
8737 L<http://libguestfs.org>,
8738 L<Sys::Guestfs::Lib(3)>.
8739
8740 =cut
8741 " copyright_years
8742
8743 and generate_perl_prototype name style =
8744   (match fst style with
8745    | RErr -> ()
8746    | RBool n
8747    | RInt n
8748    | RInt64 n
8749    | RConstString n
8750    | RConstOptString n
8751    | RString n
8752    | RBufferOut n -> pr "$%s = " n
8753    | RStruct (n,_)
8754    | RHashtable n -> pr "%%%s = " n
8755    | RStringList n
8756    | RStructList (n,_) -> pr "@%s = " n
8757   );
8758   pr "$h->%s (" name;
8759   let comma = ref false in
8760   List.iter (
8761     fun arg ->
8762       if !comma then pr ", ";
8763       comma := true;
8764       match arg with
8765       | Pathname n | Device n | Dev_or_Path n | String n
8766       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8767           pr "$%s" n
8768       | StringList n | DeviceList n ->
8769           pr "\\@%s" n
8770   ) (snd style);
8771   pr ");"
8772
8773 (* Generate Python C module. *)
8774 and generate_python_c () =
8775   generate_header CStyle LGPLv2plus;
8776
8777   pr "\
8778 #include <Python.h>
8779
8780 #include <stdio.h>
8781 #include <stdlib.h>
8782 #include <assert.h>
8783
8784 #include \"guestfs.h\"
8785
8786 typedef struct {
8787   PyObject_HEAD
8788   guestfs_h *g;
8789 } Pyguestfs_Object;
8790
8791 static guestfs_h *
8792 get_handle (PyObject *obj)
8793 {
8794   assert (obj);
8795   assert (obj != Py_None);
8796   return ((Pyguestfs_Object *) obj)->g;
8797 }
8798
8799 static PyObject *
8800 put_handle (guestfs_h *g)
8801 {
8802   assert (g);
8803   return
8804     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8805 }
8806
8807 /* This list should be freed (but not the strings) after use. */
8808 static char **
8809 get_string_list (PyObject *obj)
8810 {
8811   int i, len;
8812   char **r;
8813
8814   assert (obj);
8815
8816   if (!PyList_Check (obj)) {
8817     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8818     return NULL;
8819   }
8820
8821   len = PyList_Size (obj);
8822   r = malloc (sizeof (char *) * (len+1));
8823   if (r == NULL) {
8824     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8825     return NULL;
8826   }
8827
8828   for (i = 0; i < len; ++i)
8829     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8830   r[len] = NULL;
8831
8832   return r;
8833 }
8834
8835 static PyObject *
8836 put_string_list (char * const * const argv)
8837 {
8838   PyObject *list;
8839   int argc, i;
8840
8841   for (argc = 0; argv[argc] != NULL; ++argc)
8842     ;
8843
8844   list = PyList_New (argc);
8845   for (i = 0; i < argc; ++i)
8846     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8847
8848   return list;
8849 }
8850
8851 static PyObject *
8852 put_table (char * const * const argv)
8853 {
8854   PyObject *list, *item;
8855   int argc, i;
8856
8857   for (argc = 0; argv[argc] != NULL; ++argc)
8858     ;
8859
8860   list = PyList_New (argc >> 1);
8861   for (i = 0; i < argc; i += 2) {
8862     item = PyTuple_New (2);
8863     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8864     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8865     PyList_SetItem (list, i >> 1, item);
8866   }
8867
8868   return list;
8869 }
8870
8871 static void
8872 free_strings (char **argv)
8873 {
8874   int argc;
8875
8876   for (argc = 0; argv[argc] != NULL; ++argc)
8877     free (argv[argc]);
8878   free (argv);
8879 }
8880
8881 static PyObject *
8882 py_guestfs_create (PyObject *self, PyObject *args)
8883 {
8884   guestfs_h *g;
8885
8886   g = guestfs_create ();
8887   if (g == NULL) {
8888     PyErr_SetString (PyExc_RuntimeError,
8889                      \"guestfs.create: failed to allocate handle\");
8890     return NULL;
8891   }
8892   guestfs_set_error_handler (g, NULL, NULL);
8893   return put_handle (g);
8894 }
8895
8896 static PyObject *
8897 py_guestfs_close (PyObject *self, PyObject *args)
8898 {
8899   PyObject *py_g;
8900   guestfs_h *g;
8901
8902   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8903     return NULL;
8904   g = get_handle (py_g);
8905
8906   guestfs_close (g);
8907
8908   Py_INCREF (Py_None);
8909   return Py_None;
8910 }
8911
8912 ";
8913
8914   let emit_put_list_function typ =
8915     pr "static PyObject *\n";
8916     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8917     pr "{\n";
8918     pr "  PyObject *list;\n";
8919     pr "  int i;\n";
8920     pr "\n";
8921     pr "  list = PyList_New (%ss->len);\n" typ;
8922     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8923     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8924     pr "  return list;\n";
8925     pr "};\n";
8926     pr "\n"
8927   in
8928
8929   (* Structures, turned into Python dictionaries. *)
8930   List.iter (
8931     fun (typ, cols) ->
8932       pr "static PyObject *\n";
8933       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8934       pr "{\n";
8935       pr "  PyObject *dict;\n";
8936       pr "\n";
8937       pr "  dict = PyDict_New ();\n";
8938       List.iter (
8939         function
8940         | name, FString ->
8941             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8942             pr "                        PyString_FromString (%s->%s));\n"
8943               typ name
8944         | name, FBuffer ->
8945             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8946             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8947               typ name typ name
8948         | name, FUUID ->
8949             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8950             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8951               typ name
8952         | name, (FBytes|FUInt64) ->
8953             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8954             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8955               typ name
8956         | name, FInt64 ->
8957             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8958             pr "                        PyLong_FromLongLong (%s->%s));\n"
8959               typ name
8960         | name, FUInt32 ->
8961             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8962             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8963               typ name
8964         | name, FInt32 ->
8965             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8966             pr "                        PyLong_FromLong (%s->%s));\n"
8967               typ name
8968         | name, FOptPercent ->
8969             pr "  if (%s->%s >= 0)\n" typ name;
8970             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8971             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8972               typ name;
8973             pr "  else {\n";
8974             pr "    Py_INCREF (Py_None);\n";
8975             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8976             pr "  }\n"
8977         | name, FChar ->
8978             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8979             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8980       ) cols;
8981       pr "  return dict;\n";
8982       pr "};\n";
8983       pr "\n";
8984
8985   ) structs;
8986
8987   (* Emit a put_TYPE_list function definition only if that function is used. *)
8988   List.iter (
8989     function
8990     | typ, (RStructListOnly | RStructAndList) ->
8991         (* generate the function for typ *)
8992         emit_put_list_function typ
8993     | typ, _ -> () (* empty *)
8994   ) (rstructs_used_by all_functions);
8995
8996   (* Python wrapper functions. *)
8997   List.iter (
8998     fun (name, style, _, _, _, _, _) ->
8999       pr "static PyObject *\n";
9000       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9001       pr "{\n";
9002
9003       pr "  PyObject *py_g;\n";
9004       pr "  guestfs_h *g;\n";
9005       pr "  PyObject *py_r;\n";
9006
9007       let error_code =
9008         match fst style with
9009         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9010         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9011         | RConstString _ | RConstOptString _ ->
9012             pr "  const char *r;\n"; "NULL"
9013         | RString _ -> pr "  char *r;\n"; "NULL"
9014         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9015         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9016         | RStructList (_, typ) ->
9017             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9018         | RBufferOut _ ->
9019             pr "  char *r;\n";
9020             pr "  size_t size;\n";
9021             "NULL" in
9022
9023       List.iter (
9024         function
9025         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9026             pr "  const char *%s;\n" n
9027         | OptString n -> pr "  const char *%s;\n" n
9028         | StringList n | DeviceList n ->
9029             pr "  PyObject *py_%s;\n" n;
9030             pr "  char **%s;\n" n
9031         | Bool n -> pr "  int %s;\n" n
9032         | Int n -> pr "  int %s;\n" n
9033         | Int64 n -> pr "  long long %s;\n" n
9034       ) (snd style);
9035
9036       pr "\n";
9037
9038       (* Convert the parameters. *)
9039       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9040       List.iter (
9041         function
9042         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9043         | OptString _ -> pr "z"
9044         | StringList _ | DeviceList _ -> pr "O"
9045         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9046         | Int _ -> pr "i"
9047         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9048                              * emulate C's int/long/long long in Python?
9049                              *)
9050       ) (snd style);
9051       pr ":guestfs_%s\",\n" name;
9052       pr "                         &py_g";
9053       List.iter (
9054         function
9055         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9056         | OptString n -> pr ", &%s" n
9057         | StringList n | DeviceList n -> pr ", &py_%s" n
9058         | Bool n -> pr ", &%s" n
9059         | Int n -> pr ", &%s" n
9060         | Int64 n -> pr ", &%s" n
9061       ) (snd style);
9062
9063       pr "))\n";
9064       pr "    return NULL;\n";
9065
9066       pr "  g = get_handle (py_g);\n";
9067       List.iter (
9068         function
9069         | Pathname _ | Device _ | Dev_or_Path _ | String _
9070         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9071         | StringList n | DeviceList n ->
9072             pr "  %s = get_string_list (py_%s);\n" n n;
9073             pr "  if (!%s) return NULL;\n" n
9074       ) (snd style);
9075
9076       pr "\n";
9077
9078       pr "  r = guestfs_%s " name;
9079       generate_c_call_args ~handle:"g" style;
9080       pr ";\n";
9081
9082       List.iter (
9083         function
9084         | Pathname _ | Device _ | Dev_or_Path _ | String _
9085         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9086         | StringList n | DeviceList n ->
9087             pr "  free (%s);\n" n
9088       ) (snd style);
9089
9090       pr "  if (r == %s) {\n" error_code;
9091       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9092       pr "    return NULL;\n";
9093       pr "  }\n";
9094       pr "\n";
9095
9096       (match fst style with
9097        | RErr ->
9098            pr "  Py_INCREF (Py_None);\n";
9099            pr "  py_r = Py_None;\n"
9100        | RInt _
9101        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9102        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9103        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9104        | RConstOptString _ ->
9105            pr "  if (r)\n";
9106            pr "    py_r = PyString_FromString (r);\n";
9107            pr "  else {\n";
9108            pr "    Py_INCREF (Py_None);\n";
9109            pr "    py_r = Py_None;\n";
9110            pr "  }\n"
9111        | RString _ ->
9112            pr "  py_r = PyString_FromString (r);\n";
9113            pr "  free (r);\n"
9114        | RStringList _ ->
9115            pr "  py_r = put_string_list (r);\n";
9116            pr "  free_strings (r);\n"
9117        | RStruct (_, typ) ->
9118            pr "  py_r = put_%s (r);\n" typ;
9119            pr "  guestfs_free_%s (r);\n" typ
9120        | RStructList (_, typ) ->
9121            pr "  py_r = put_%s_list (r);\n" typ;
9122            pr "  guestfs_free_%s_list (r);\n" typ
9123        | RHashtable n ->
9124            pr "  py_r = put_table (r);\n";
9125            pr "  free_strings (r);\n"
9126        | RBufferOut _ ->
9127            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9128            pr "  free (r);\n"
9129       );
9130
9131       pr "  return py_r;\n";
9132       pr "}\n";
9133       pr "\n"
9134   ) all_functions;
9135
9136   (* Table of functions. *)
9137   pr "static PyMethodDef methods[] = {\n";
9138   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9139   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9140   List.iter (
9141     fun (name, _, _, _, _, _, _) ->
9142       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9143         name name
9144   ) all_functions;
9145   pr "  { NULL, NULL, 0, NULL }\n";
9146   pr "};\n";
9147   pr "\n";
9148
9149   (* Init function. *)
9150   pr "\
9151 void
9152 initlibguestfsmod (void)
9153 {
9154   static int initialized = 0;
9155
9156   if (initialized) return;
9157   Py_InitModule ((char *) \"libguestfsmod\", methods);
9158   initialized = 1;
9159 }
9160 "
9161
9162 (* Generate Python module. *)
9163 and generate_python_py () =
9164   generate_header HashStyle LGPLv2plus;
9165
9166   pr "\
9167 u\"\"\"Python bindings for libguestfs
9168
9169 import guestfs
9170 g = guestfs.GuestFS ()
9171 g.add_drive (\"guest.img\")
9172 g.launch ()
9173 parts = g.list_partitions ()
9174
9175 The guestfs module provides a Python binding to the libguestfs API
9176 for examining and modifying virtual machine disk images.
9177
9178 Amongst the things this is good for: making batch configuration
9179 changes to guests, getting disk used/free statistics (see also:
9180 virt-df), migrating between virtualization systems (see also:
9181 virt-p2v), performing partial backups, performing partial guest
9182 clones, cloning guests and changing registry/UUID/hostname info, and
9183 much else besides.
9184
9185 Libguestfs uses Linux kernel and qemu code, and can access any type of
9186 guest filesystem that Linux and qemu can, including but not limited
9187 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9188 schemes, qcow, qcow2, vmdk.
9189
9190 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9191 LVs, what filesystem is in each LV, etc.).  It can also run commands
9192 in the context of the guest.  Also you can access filesystems over
9193 FUSE.
9194
9195 Errors which happen while using the API are turned into Python
9196 RuntimeError exceptions.
9197
9198 To create a guestfs handle you usually have to perform the following
9199 sequence of calls:
9200
9201 # Create the handle, call add_drive at least once, and possibly
9202 # several times if the guest has multiple block devices:
9203 g = guestfs.GuestFS ()
9204 g.add_drive (\"guest.img\")
9205
9206 # Launch the qemu subprocess and wait for it to become ready:
9207 g.launch ()
9208
9209 # Now you can issue commands, for example:
9210 logvols = g.lvs ()
9211
9212 \"\"\"
9213
9214 import libguestfsmod
9215
9216 class GuestFS:
9217     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9218
9219     def __init__ (self):
9220         \"\"\"Create a new libguestfs handle.\"\"\"
9221         self._o = libguestfsmod.create ()
9222
9223     def __del__ (self):
9224         libguestfsmod.close (self._o)
9225
9226 ";
9227
9228   List.iter (
9229     fun (name, style, _, flags, _, _, longdesc) ->
9230       pr "    def %s " name;
9231       generate_py_call_args ~handle:"self" (snd style);
9232       pr ":\n";
9233
9234       if not (List.mem NotInDocs flags) then (
9235         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9236         let doc =
9237           match fst style with
9238           | RErr | RInt _ | RInt64 _ | RBool _
9239           | RConstOptString _ | RConstString _
9240           | RString _ | RBufferOut _ -> doc
9241           | RStringList _ ->
9242               doc ^ "\n\nThis function returns a list of strings."
9243           | RStruct (_, typ) ->
9244               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9245           | RStructList (_, typ) ->
9246               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9247           | RHashtable _ ->
9248               doc ^ "\n\nThis function returns a dictionary." in
9249         let doc =
9250           if List.mem ProtocolLimitWarning flags then
9251             doc ^ "\n\n" ^ protocol_limit_warning
9252           else doc in
9253         let doc =
9254           if List.mem DangerWillRobinson flags then
9255             doc ^ "\n\n" ^ danger_will_robinson
9256           else doc in
9257         let doc =
9258           match deprecation_notice flags with
9259           | None -> doc
9260           | Some txt -> doc ^ "\n\n" ^ txt in
9261         let doc = pod2text ~width:60 name doc in
9262         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9263         let doc = String.concat "\n        " doc in
9264         pr "        u\"\"\"%s\"\"\"\n" doc;
9265       );
9266       pr "        return libguestfsmod.%s " name;
9267       generate_py_call_args ~handle:"self._o" (snd style);
9268       pr "\n";
9269       pr "\n";
9270   ) all_functions
9271
9272 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9273 and generate_py_call_args ~handle args =
9274   pr "(%s" handle;
9275   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9276   pr ")"
9277
9278 (* Useful if you need the longdesc POD text as plain text.  Returns a
9279  * list of lines.
9280  *
9281  * Because this is very slow (the slowest part of autogeneration),
9282  * we memoize the results.
9283  *)
9284 and pod2text ~width name longdesc =
9285   let key = width, name, longdesc in
9286   try Hashtbl.find pod2text_memo key
9287   with Not_found ->
9288     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9289     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9290     close_out chan;
9291     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9292     let chan = open_process_in cmd in
9293     let lines = ref [] in
9294     let rec loop i =
9295       let line = input_line chan in
9296       if i = 1 then             (* discard the first line of output *)
9297         loop (i+1)
9298       else (
9299         let line = triml line in
9300         lines := line :: !lines;
9301         loop (i+1)
9302       ) in
9303     let lines = try loop 1 with End_of_file -> List.rev !lines in
9304     unlink filename;
9305     (match close_process_in chan with
9306      | WEXITED 0 -> ()
9307      | WEXITED i ->
9308          failwithf "pod2text: process exited with non-zero status (%d)" i
9309      | WSIGNALED i | WSTOPPED i ->
9310          failwithf "pod2text: process signalled or stopped by signal %d" i
9311     );
9312     Hashtbl.add pod2text_memo key lines;
9313     pod2text_memo_updated ();
9314     lines
9315
9316 (* Generate ruby bindings. *)
9317 and generate_ruby_c () =
9318   generate_header CStyle LGPLv2plus;
9319
9320   pr "\
9321 #include <stdio.h>
9322 #include <stdlib.h>
9323
9324 #include <ruby.h>
9325
9326 #include \"guestfs.h\"
9327
9328 #include \"extconf.h\"
9329
9330 /* For Ruby < 1.9 */
9331 #ifndef RARRAY_LEN
9332 #define RARRAY_LEN(r) (RARRAY((r))->len)
9333 #endif
9334
9335 static VALUE m_guestfs;                 /* guestfs module */
9336 static VALUE c_guestfs;                 /* guestfs_h handle */
9337 static VALUE e_Error;                   /* used for all errors */
9338
9339 static void ruby_guestfs_free (void *p)
9340 {
9341   if (!p) return;
9342   guestfs_close ((guestfs_h *) p);
9343 }
9344
9345 static VALUE ruby_guestfs_create (VALUE m)
9346 {
9347   guestfs_h *g;
9348
9349   g = guestfs_create ();
9350   if (!g)
9351     rb_raise (e_Error, \"failed to create guestfs handle\");
9352
9353   /* Don't print error messages to stderr by default. */
9354   guestfs_set_error_handler (g, NULL, NULL);
9355
9356   /* Wrap it, and make sure the close function is called when the
9357    * handle goes away.
9358    */
9359   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9360 }
9361
9362 static VALUE ruby_guestfs_close (VALUE gv)
9363 {
9364   guestfs_h *g;
9365   Data_Get_Struct (gv, guestfs_h, g);
9366
9367   ruby_guestfs_free (g);
9368   DATA_PTR (gv) = NULL;
9369
9370   return Qnil;
9371 }
9372
9373 ";
9374
9375   List.iter (
9376     fun (name, style, _, _, _, _, _) ->
9377       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9378       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9379       pr ")\n";
9380       pr "{\n";
9381       pr "  guestfs_h *g;\n";
9382       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9383       pr "  if (!g)\n";
9384       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9385         name;
9386       pr "\n";
9387
9388       List.iter (
9389         function
9390         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9391             pr "  Check_Type (%sv, T_STRING);\n" n;
9392             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9393             pr "  if (!%s)\n" n;
9394             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9395             pr "              \"%s\", \"%s\");\n" n name
9396         | OptString n ->
9397             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9398         | StringList n | DeviceList n ->
9399             pr "  char **%s;\n" n;
9400             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9401             pr "  {\n";
9402             pr "    int i, len;\n";
9403             pr "    len = RARRAY_LEN (%sv);\n" n;
9404             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9405               n;
9406             pr "    for (i = 0; i < len; ++i) {\n";
9407             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9408             pr "      %s[i] = StringValueCStr (v);\n" n;
9409             pr "    }\n";
9410             pr "    %s[len] = NULL;\n" n;
9411             pr "  }\n";
9412         | Bool n ->
9413             pr "  int %s = RTEST (%sv);\n" n n
9414         | Int n ->
9415             pr "  int %s = NUM2INT (%sv);\n" n n
9416         | Int64 n ->
9417             pr "  long long %s = NUM2LL (%sv);\n" n n
9418       ) (snd style);
9419       pr "\n";
9420
9421       let error_code =
9422         match fst style with
9423         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9424         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9425         | RConstString _ | RConstOptString _ ->
9426             pr "  const char *r;\n"; "NULL"
9427         | RString _ -> pr "  char *r;\n"; "NULL"
9428         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9429         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9430         | RStructList (_, typ) ->
9431             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9432         | RBufferOut _ ->
9433             pr "  char *r;\n";
9434             pr "  size_t size;\n";
9435             "NULL" in
9436       pr "\n";
9437
9438       pr "  r = guestfs_%s " name;
9439       generate_c_call_args ~handle:"g" style;
9440       pr ";\n";
9441
9442       List.iter (
9443         function
9444         | Pathname _ | Device _ | Dev_or_Path _ | String _
9445         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9446         | StringList n | DeviceList n ->
9447             pr "  free (%s);\n" n
9448       ) (snd style);
9449
9450       pr "  if (r == %s)\n" error_code;
9451       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9452       pr "\n";
9453
9454       (match fst style with
9455        | RErr ->
9456            pr "  return Qnil;\n"
9457        | RInt _ | RBool _ ->
9458            pr "  return INT2NUM (r);\n"
9459        | RInt64 _ ->
9460            pr "  return ULL2NUM (r);\n"
9461        | RConstString _ ->
9462            pr "  return rb_str_new2 (r);\n";
9463        | RConstOptString _ ->
9464            pr "  if (r)\n";
9465            pr "    return rb_str_new2 (r);\n";
9466            pr "  else\n";
9467            pr "    return Qnil;\n";
9468        | RString _ ->
9469            pr "  VALUE rv = rb_str_new2 (r);\n";
9470            pr "  free (r);\n";
9471            pr "  return rv;\n";
9472        | RStringList _ ->
9473            pr "  int i, len = 0;\n";
9474            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9475            pr "  VALUE rv = rb_ary_new2 (len);\n";
9476            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9477            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9478            pr "    free (r[i]);\n";
9479            pr "  }\n";
9480            pr "  free (r);\n";
9481            pr "  return rv;\n"
9482        | RStruct (_, typ) ->
9483            let cols = cols_of_struct typ in
9484            generate_ruby_struct_code typ cols
9485        | RStructList (_, typ) ->
9486            let cols = cols_of_struct typ in
9487            generate_ruby_struct_list_code typ cols
9488        | RHashtable _ ->
9489            pr "  VALUE rv = rb_hash_new ();\n";
9490            pr "  int i;\n";
9491            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9492            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9493            pr "    free (r[i]);\n";
9494            pr "    free (r[i+1]);\n";
9495            pr "  }\n";
9496            pr "  free (r);\n";
9497            pr "  return rv;\n"
9498        | RBufferOut _ ->
9499            pr "  VALUE rv = rb_str_new (r, size);\n";
9500            pr "  free (r);\n";
9501            pr "  return rv;\n";
9502       );
9503
9504       pr "}\n";
9505       pr "\n"
9506   ) all_functions;
9507
9508   pr "\
9509 /* Initialize the module. */
9510 void Init__guestfs ()
9511 {
9512   m_guestfs = rb_define_module (\"Guestfs\");
9513   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9514   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9515
9516   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9517   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9518
9519 ";
9520   (* Define the rest of the methods. *)
9521   List.iter (
9522     fun (name, style, _, _, _, _, _) ->
9523       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9524       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9525   ) all_functions;
9526
9527   pr "}\n"
9528
9529 (* Ruby code to return a struct. *)
9530 and generate_ruby_struct_code typ cols =
9531   pr "  VALUE rv = rb_hash_new ();\n";
9532   List.iter (
9533     function
9534     | name, FString ->
9535         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9536     | name, FBuffer ->
9537         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9538     | name, FUUID ->
9539         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9540     | name, (FBytes|FUInt64) ->
9541         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9542     | name, FInt64 ->
9543         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9544     | name, FUInt32 ->
9545         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9546     | name, FInt32 ->
9547         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9548     | name, FOptPercent ->
9549         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9550     | name, FChar -> (* XXX wrong? *)
9551         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9552   ) cols;
9553   pr "  guestfs_free_%s (r);\n" typ;
9554   pr "  return rv;\n"
9555
9556 (* Ruby code to return a struct list. *)
9557 and generate_ruby_struct_list_code typ cols =
9558   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9559   pr "  int i;\n";
9560   pr "  for (i = 0; i < r->len; ++i) {\n";
9561   pr "    VALUE hv = rb_hash_new ();\n";
9562   List.iter (
9563     function
9564     | name, FString ->
9565         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9566     | name, FBuffer ->
9567         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
9568     | name, FUUID ->
9569         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9570     | name, (FBytes|FUInt64) ->
9571         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9572     | name, FInt64 ->
9573         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9574     | name, FUInt32 ->
9575         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9576     | name, FInt32 ->
9577         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9578     | name, FOptPercent ->
9579         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9580     | name, FChar -> (* XXX wrong? *)
9581         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9582   ) cols;
9583   pr "    rb_ary_push (rv, hv);\n";
9584   pr "  }\n";
9585   pr "  guestfs_free_%s_list (r);\n" typ;
9586   pr "  return rv;\n"
9587
9588 (* Generate Java bindings GuestFS.java file. *)
9589 and generate_java_java () =
9590   generate_header CStyle LGPLv2plus;
9591
9592   pr "\
9593 package com.redhat.et.libguestfs;
9594
9595 import java.util.HashMap;
9596 import com.redhat.et.libguestfs.LibGuestFSException;
9597 import com.redhat.et.libguestfs.PV;
9598 import com.redhat.et.libguestfs.VG;
9599 import com.redhat.et.libguestfs.LV;
9600 import com.redhat.et.libguestfs.Stat;
9601 import com.redhat.et.libguestfs.StatVFS;
9602 import com.redhat.et.libguestfs.IntBool;
9603 import com.redhat.et.libguestfs.Dirent;
9604
9605 /**
9606  * The GuestFS object is a libguestfs handle.
9607  *
9608  * @author rjones
9609  */
9610 public class GuestFS {
9611   // Load the native code.
9612   static {
9613     System.loadLibrary (\"guestfs_jni\");
9614   }
9615
9616   /**
9617    * The native guestfs_h pointer.
9618    */
9619   long g;
9620
9621   /**
9622    * Create a libguestfs handle.
9623    *
9624    * @throws LibGuestFSException
9625    */
9626   public GuestFS () throws LibGuestFSException
9627   {
9628     g = _create ();
9629   }
9630   private native long _create () throws LibGuestFSException;
9631
9632   /**
9633    * Close a libguestfs handle.
9634    *
9635    * You can also leave handles to be collected by the garbage
9636    * collector, but this method ensures that the resources used
9637    * by the handle are freed up immediately.  If you call any
9638    * other methods after closing the handle, you will get an
9639    * exception.
9640    *
9641    * @throws LibGuestFSException
9642    */
9643   public void close () throws LibGuestFSException
9644   {
9645     if (g != 0)
9646       _close (g);
9647     g = 0;
9648   }
9649   private native void _close (long g) throws LibGuestFSException;
9650
9651   public void finalize () throws LibGuestFSException
9652   {
9653     close ();
9654   }
9655
9656 ";
9657
9658   List.iter (
9659     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9660       if not (List.mem NotInDocs flags); then (
9661         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9662         let doc =
9663           if List.mem ProtocolLimitWarning flags then
9664             doc ^ "\n\n" ^ protocol_limit_warning
9665           else doc in
9666         let doc =
9667           if List.mem DangerWillRobinson flags then
9668             doc ^ "\n\n" ^ danger_will_robinson
9669           else doc in
9670         let doc =
9671           match deprecation_notice flags with
9672           | None -> doc
9673           | Some txt -> doc ^ "\n\n" ^ txt in
9674         let doc = pod2text ~width:60 name doc in
9675         let doc = List.map (            (* RHBZ#501883 *)
9676           function
9677           | "" -> "<p>"
9678           | nonempty -> nonempty
9679         ) doc in
9680         let doc = String.concat "\n   * " doc in
9681
9682         pr "  /**\n";
9683         pr "   * %s\n" shortdesc;
9684         pr "   * <p>\n";
9685         pr "   * %s\n" doc;
9686         pr "   * @throws LibGuestFSException\n";
9687         pr "   */\n";
9688         pr "  ";
9689       );
9690       generate_java_prototype ~public:true ~semicolon:false name style;
9691       pr "\n";
9692       pr "  {\n";
9693       pr "    if (g == 0)\n";
9694       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9695         name;
9696       pr "    ";
9697       if fst style <> RErr then pr "return ";
9698       pr "_%s " name;
9699       generate_java_call_args ~handle:"g" (snd style);
9700       pr ";\n";
9701       pr "  }\n";
9702       pr "  ";
9703       generate_java_prototype ~privat:true ~native:true name style;
9704       pr "\n";
9705       pr "\n";
9706   ) all_functions;
9707
9708   pr "}\n"
9709
9710 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9711 and generate_java_call_args ~handle args =
9712   pr "(%s" handle;
9713   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9714   pr ")"
9715
9716 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9717     ?(semicolon=true) name style =
9718   if privat then pr "private ";
9719   if public then pr "public ";
9720   if native then pr "native ";
9721
9722   (* return type *)
9723   (match fst style with
9724    | RErr -> pr "void ";
9725    | RInt _ -> pr "int ";
9726    | RInt64 _ -> pr "long ";
9727    | RBool _ -> pr "boolean ";
9728    | RConstString _ | RConstOptString _ | RString _
9729    | RBufferOut _ -> pr "String ";
9730    | RStringList _ -> pr "String[] ";
9731    | RStruct (_, typ) ->
9732        let name = java_name_of_struct typ in
9733        pr "%s " name;
9734    | RStructList (_, typ) ->
9735        let name = java_name_of_struct typ in
9736        pr "%s[] " name;
9737    | RHashtable _ -> pr "HashMap<String,String> ";
9738   );
9739
9740   if native then pr "_%s " name else pr "%s " name;
9741   pr "(";
9742   let needs_comma = ref false in
9743   if native then (
9744     pr "long g";
9745     needs_comma := true
9746   );
9747
9748   (* args *)
9749   List.iter (
9750     fun arg ->
9751       if !needs_comma then pr ", ";
9752       needs_comma := true;
9753
9754       match arg with
9755       | Pathname n
9756       | Device n | Dev_or_Path n
9757       | String n
9758       | OptString n
9759       | FileIn n
9760       | FileOut n ->
9761           pr "String %s" n
9762       | StringList n | DeviceList n ->
9763           pr "String[] %s" n
9764       | Bool n ->
9765           pr "boolean %s" n
9766       | Int n ->
9767           pr "int %s" n
9768       | Int64 n ->
9769           pr "long %s" n
9770   ) (snd style);
9771
9772   pr ")\n";
9773   pr "    throws LibGuestFSException";
9774   if semicolon then pr ";"
9775
9776 and generate_java_struct jtyp cols () =
9777   generate_header CStyle LGPLv2plus;
9778
9779   pr "\
9780 package com.redhat.et.libguestfs;
9781
9782 /**
9783  * Libguestfs %s structure.
9784  *
9785  * @author rjones
9786  * @see GuestFS
9787  */
9788 public class %s {
9789 " jtyp jtyp;
9790
9791   List.iter (
9792     function
9793     | name, FString
9794     | name, FUUID
9795     | name, FBuffer -> pr "  public String %s;\n" name
9796     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9797     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9798     | name, FChar -> pr "  public char %s;\n" name
9799     | name, FOptPercent ->
9800         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9801         pr "  public float %s;\n" name
9802   ) cols;
9803
9804   pr "}\n"
9805
9806 and generate_java_c () =
9807   generate_header CStyle LGPLv2plus;
9808
9809   pr "\
9810 #include <stdio.h>
9811 #include <stdlib.h>
9812 #include <string.h>
9813
9814 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9815 #include \"guestfs.h\"
9816
9817 /* Note that this function returns.  The exception is not thrown
9818  * until after the wrapper function returns.
9819  */
9820 static void
9821 throw_exception (JNIEnv *env, const char *msg)
9822 {
9823   jclass cl;
9824   cl = (*env)->FindClass (env,
9825                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9826   (*env)->ThrowNew (env, cl, msg);
9827 }
9828
9829 JNIEXPORT jlong JNICALL
9830 Java_com_redhat_et_libguestfs_GuestFS__1create
9831   (JNIEnv *env, jobject obj)
9832 {
9833   guestfs_h *g;
9834
9835   g = guestfs_create ();
9836   if (g == NULL) {
9837     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9838     return 0;
9839   }
9840   guestfs_set_error_handler (g, NULL, NULL);
9841   return (jlong) (long) g;
9842 }
9843
9844 JNIEXPORT void JNICALL
9845 Java_com_redhat_et_libguestfs_GuestFS__1close
9846   (JNIEnv *env, jobject obj, jlong jg)
9847 {
9848   guestfs_h *g = (guestfs_h *) (long) jg;
9849   guestfs_close (g);
9850 }
9851
9852 ";
9853
9854   List.iter (
9855     fun (name, style, _, _, _, _, _) ->
9856       pr "JNIEXPORT ";
9857       (match fst style with
9858        | RErr -> pr "void ";
9859        | RInt _ -> pr "jint ";
9860        | RInt64 _ -> pr "jlong ";
9861        | RBool _ -> pr "jboolean ";
9862        | RConstString _ | RConstOptString _ | RString _
9863        | RBufferOut _ -> pr "jstring ";
9864        | RStruct _ | RHashtable _ ->
9865            pr "jobject ";
9866        | RStringList _ | RStructList _ ->
9867            pr "jobjectArray ";
9868       );
9869       pr "JNICALL\n";
9870       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9871       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9872       pr "\n";
9873       pr "  (JNIEnv *env, jobject obj, jlong jg";
9874       List.iter (
9875         function
9876         | Pathname n
9877         | Device n | Dev_or_Path n
9878         | String n
9879         | OptString n
9880         | FileIn n
9881         | FileOut n ->
9882             pr ", jstring j%s" n
9883         | StringList n | DeviceList n ->
9884             pr ", jobjectArray j%s" n
9885         | Bool n ->
9886             pr ", jboolean j%s" n
9887         | Int n ->
9888             pr ", jint j%s" n
9889         | Int64 n ->
9890             pr ", jlong j%s" n
9891       ) (snd style);
9892       pr ")\n";
9893       pr "{\n";
9894       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9895       let error_code, no_ret =
9896         match fst style with
9897         | RErr -> pr "  int r;\n"; "-1", ""
9898         | RBool _
9899         | RInt _ -> pr "  int r;\n"; "-1", "0"
9900         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9901         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9902         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9903         | RString _ ->
9904             pr "  jstring jr;\n";
9905             pr "  char *r;\n"; "NULL", "NULL"
9906         | RStringList _ ->
9907             pr "  jobjectArray jr;\n";
9908             pr "  int r_len;\n";
9909             pr "  jclass cl;\n";
9910             pr "  jstring jstr;\n";
9911             pr "  char **r;\n"; "NULL", "NULL"
9912         | RStruct (_, typ) ->
9913             pr "  jobject jr;\n";
9914             pr "  jclass cl;\n";
9915             pr "  jfieldID fl;\n";
9916             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9917         | RStructList (_, typ) ->
9918             pr "  jobjectArray jr;\n";
9919             pr "  jclass cl;\n";
9920             pr "  jfieldID fl;\n";
9921             pr "  jobject jfl;\n";
9922             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9923         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9924         | RBufferOut _ ->
9925             pr "  jstring jr;\n";
9926             pr "  char *r;\n";
9927             pr "  size_t size;\n";
9928             "NULL", "NULL" in
9929       List.iter (
9930         function
9931         | Pathname n
9932         | Device n | Dev_or_Path n
9933         | String n
9934         | OptString n
9935         | FileIn n
9936         | FileOut n ->
9937             pr "  const char *%s;\n" n
9938         | StringList n | DeviceList n ->
9939             pr "  int %s_len;\n" n;
9940             pr "  const char **%s;\n" n
9941         | Bool n
9942         | Int n ->
9943             pr "  int %s;\n" n
9944         | Int64 n ->
9945             pr "  int64_t %s;\n" n
9946       ) (snd style);
9947
9948       let needs_i =
9949         (match fst style with
9950          | RStringList _ | RStructList _ -> true
9951          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9952          | RConstOptString _
9953          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9954           List.exists (function
9955                        | StringList _ -> true
9956                        | DeviceList _ -> true
9957                        | _ -> false) (snd style) in
9958       if needs_i then
9959         pr "  int i;\n";
9960
9961       pr "\n";
9962
9963       (* Get the parameters. *)
9964       List.iter (
9965         function
9966         | Pathname n
9967         | Device n | Dev_or_Path n
9968         | String n
9969         | FileIn n
9970         | FileOut n ->
9971             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9972         | OptString n ->
9973             (* This is completely undocumented, but Java null becomes
9974              * a NULL parameter.
9975              *)
9976             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9977         | StringList n | DeviceList n ->
9978             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9979             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9980             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9981             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9982               n;
9983             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9984             pr "  }\n";
9985             pr "  %s[%s_len] = NULL;\n" n n;
9986         | Bool n
9987         | Int n
9988         | Int64 n ->
9989             pr "  %s = j%s;\n" n n
9990       ) (snd style);
9991
9992       (* Make the call. *)
9993       pr "  r = guestfs_%s " name;
9994       generate_c_call_args ~handle:"g" style;
9995       pr ";\n";
9996
9997       (* Release the parameters. *)
9998       List.iter (
9999         function
10000         | Pathname n
10001         | Device n | Dev_or_Path n
10002         | String n
10003         | FileIn n
10004         | FileOut n ->
10005             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10006         | OptString n ->
10007             pr "  if (j%s)\n" n;
10008             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10009         | StringList n | DeviceList n ->
10010             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10011             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10012               n;
10013             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10014             pr "  }\n";
10015             pr "  free (%s);\n" n
10016         | Bool n
10017         | Int n
10018         | Int64 n -> ()
10019       ) (snd style);
10020
10021       (* Check for errors. *)
10022       pr "  if (r == %s) {\n" error_code;
10023       pr "    throw_exception (env, guestfs_last_error (g));\n";
10024       pr "    return %s;\n" no_ret;
10025       pr "  }\n";
10026
10027       (* Return value. *)
10028       (match fst style with
10029        | RErr -> ()
10030        | RInt _ -> pr "  return (jint) r;\n"
10031        | RBool _ -> pr "  return (jboolean) r;\n"
10032        | RInt64 _ -> pr "  return (jlong) r;\n"
10033        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10034        | RConstOptString _ ->
10035            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10036        | RString _ ->
10037            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10038            pr "  free (r);\n";
10039            pr "  return jr;\n"
10040        | RStringList _ ->
10041            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10042            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10043            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10044            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10045            pr "  for (i = 0; i < r_len; ++i) {\n";
10046            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10047            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10048            pr "    free (r[i]);\n";
10049            pr "  }\n";
10050            pr "  free (r);\n";
10051            pr "  return jr;\n"
10052        | RStruct (_, typ) ->
10053            let jtyp = java_name_of_struct typ in
10054            let cols = cols_of_struct typ in
10055            generate_java_struct_return typ jtyp cols
10056        | RStructList (_, typ) ->
10057            let jtyp = java_name_of_struct typ in
10058            let cols = cols_of_struct typ in
10059            generate_java_struct_list_return typ jtyp cols
10060        | RHashtable _ ->
10061            (* XXX *)
10062            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10063            pr "  return NULL;\n"
10064        | RBufferOut _ ->
10065            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10066            pr "  free (r);\n";
10067            pr "  return jr;\n"
10068       );
10069
10070       pr "}\n";
10071       pr "\n"
10072   ) all_functions
10073
10074 and generate_java_struct_return typ jtyp cols =
10075   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10076   pr "  jr = (*env)->AllocObject (env, cl);\n";
10077   List.iter (
10078     function
10079     | name, FString ->
10080         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10081         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10082     | name, FUUID ->
10083         pr "  {\n";
10084         pr "    char s[33];\n";
10085         pr "    memcpy (s, r->%s, 32);\n" name;
10086         pr "    s[32] = 0;\n";
10087         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10088         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10089         pr "  }\n";
10090     | name, FBuffer ->
10091         pr "  {\n";
10092         pr "    int len = r->%s_len;\n" name;
10093         pr "    char s[len+1];\n";
10094         pr "    memcpy (s, r->%s, len);\n" name;
10095         pr "    s[len] = 0;\n";
10096         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10097         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10098         pr "  }\n";
10099     | name, (FBytes|FUInt64|FInt64) ->
10100         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10101         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10102     | name, (FUInt32|FInt32) ->
10103         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10104         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10105     | name, FOptPercent ->
10106         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10107         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10108     | name, FChar ->
10109         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10110         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10111   ) cols;
10112   pr "  free (r);\n";
10113   pr "  return jr;\n"
10114
10115 and generate_java_struct_list_return typ jtyp cols =
10116   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10117   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10118   pr "  for (i = 0; i < r->len; ++i) {\n";
10119   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10120   List.iter (
10121     function
10122     | name, FString ->
10123         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10124         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10125     | name, FUUID ->
10126         pr "    {\n";
10127         pr "      char s[33];\n";
10128         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10129         pr "      s[32] = 0;\n";
10130         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10131         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10132         pr "    }\n";
10133     | name, FBuffer ->
10134         pr "    {\n";
10135         pr "      int len = r->val[i].%s_len;\n" name;
10136         pr "      char s[len+1];\n";
10137         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10138         pr "      s[len] = 0;\n";
10139         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10140         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10141         pr "    }\n";
10142     | name, (FBytes|FUInt64|FInt64) ->
10143         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10144         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10145     | name, (FUInt32|FInt32) ->
10146         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10147         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10148     | name, FOptPercent ->
10149         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10150         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10151     | name, FChar ->
10152         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10153         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10154   ) cols;
10155   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10156   pr "  }\n";
10157   pr "  guestfs_free_%s_list (r);\n" typ;
10158   pr "  return jr;\n"
10159
10160 and generate_java_makefile_inc () =
10161   generate_header HashStyle GPLv2plus;
10162
10163   pr "java_built_sources = \\\n";
10164   List.iter (
10165     fun (typ, jtyp) ->
10166         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10167   ) java_structs;
10168   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10169
10170 and generate_haskell_hs () =
10171   generate_header HaskellStyle LGPLv2plus;
10172
10173   (* XXX We only know how to generate partial FFI for Haskell
10174    * at the moment.  Please help out!
10175    *)
10176   let can_generate style =
10177     match style with
10178     | RErr, _
10179     | RInt _, _
10180     | RInt64 _, _ -> true
10181     | RBool _, _
10182     | RConstString _, _
10183     | RConstOptString _, _
10184     | RString _, _
10185     | RStringList _, _
10186     | RStruct _, _
10187     | RStructList _, _
10188     | RHashtable _, _
10189     | RBufferOut _, _ -> false in
10190
10191   pr "\
10192 {-# INCLUDE <guestfs.h> #-}
10193 {-# LANGUAGE ForeignFunctionInterface #-}
10194
10195 module Guestfs (
10196   create";
10197
10198   (* List out the names of the actions we want to export. *)
10199   List.iter (
10200     fun (name, style, _, _, _, _, _) ->
10201       if can_generate style then pr ",\n  %s" name
10202   ) all_functions;
10203
10204   pr "
10205   ) where
10206
10207 -- Unfortunately some symbols duplicate ones already present
10208 -- in Prelude.  We don't know which, so we hard-code a list
10209 -- here.
10210 import Prelude hiding (truncate)
10211
10212 import Foreign
10213 import Foreign.C
10214 import Foreign.C.Types
10215 import IO
10216 import Control.Exception
10217 import Data.Typeable
10218
10219 data GuestfsS = GuestfsS            -- represents the opaque C struct
10220 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10221 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10222
10223 -- XXX define properly later XXX
10224 data PV = PV
10225 data VG = VG
10226 data LV = LV
10227 data IntBool = IntBool
10228 data Stat = Stat
10229 data StatVFS = StatVFS
10230 data Hashtable = Hashtable
10231
10232 foreign import ccall unsafe \"guestfs_create\" c_create
10233   :: IO GuestfsP
10234 foreign import ccall unsafe \"&guestfs_close\" c_close
10235   :: FunPtr (GuestfsP -> IO ())
10236 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10237   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10238
10239 create :: IO GuestfsH
10240 create = do
10241   p <- c_create
10242   c_set_error_handler p nullPtr nullPtr
10243   h <- newForeignPtr c_close p
10244   return h
10245
10246 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10247   :: GuestfsP -> IO CString
10248
10249 -- last_error :: GuestfsH -> IO (Maybe String)
10250 -- last_error h = do
10251 --   str <- withForeignPtr h (\\p -> c_last_error p)
10252 --   maybePeek peekCString str
10253
10254 last_error :: GuestfsH -> IO (String)
10255 last_error h = do
10256   str <- withForeignPtr h (\\p -> c_last_error p)
10257   if (str == nullPtr)
10258     then return \"no error\"
10259     else peekCString str
10260
10261 ";
10262
10263   (* Generate wrappers for each foreign function. *)
10264   List.iter (
10265     fun (name, style, _, _, _, _, _) ->
10266       if can_generate style then (
10267         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10268         pr "  :: ";
10269         generate_haskell_prototype ~handle:"GuestfsP" style;
10270         pr "\n";
10271         pr "\n";
10272         pr "%s :: " name;
10273         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10274         pr "\n";
10275         pr "%s %s = do\n" name
10276           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10277         pr "  r <- ";
10278         (* Convert pointer arguments using with* functions. *)
10279         List.iter (
10280           function
10281           | FileIn n
10282           | FileOut n
10283           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10284           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10285           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10286           | Bool _ | Int _ | Int64 _ -> ()
10287         ) (snd style);
10288         (* Convert integer arguments. *)
10289         let args =
10290           List.map (
10291             function
10292             | Bool n -> sprintf "(fromBool %s)" n
10293             | Int n -> sprintf "(fromIntegral %s)" n
10294             | Int64 n -> sprintf "(fromIntegral %s)" n
10295             | FileIn n | FileOut n
10296             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10297           ) (snd style) in
10298         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10299           (String.concat " " ("p" :: args));
10300         (match fst style with
10301          | RErr | RInt _ | RInt64 _ | RBool _ ->
10302              pr "  if (r == -1)\n";
10303              pr "    then do\n";
10304              pr "      err <- last_error h\n";
10305              pr "      fail err\n";
10306          | RConstString _ | RConstOptString _ | RString _
10307          | RStringList _ | RStruct _
10308          | RStructList _ | RHashtable _ | RBufferOut _ ->
10309              pr "  if (r == nullPtr)\n";
10310              pr "    then do\n";
10311              pr "      err <- last_error h\n";
10312              pr "      fail err\n";
10313         );
10314         (match fst style with
10315          | RErr ->
10316              pr "    else return ()\n"
10317          | RInt _ ->
10318              pr "    else return (fromIntegral r)\n"
10319          | RInt64 _ ->
10320              pr "    else return (fromIntegral r)\n"
10321          | RBool _ ->
10322              pr "    else return (toBool r)\n"
10323          | RConstString _
10324          | RConstOptString _
10325          | RString _
10326          | RStringList _
10327          | RStruct _
10328          | RStructList _
10329          | RHashtable _
10330          | RBufferOut _ ->
10331              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10332         );
10333         pr "\n";
10334       )
10335   ) all_functions
10336
10337 and generate_haskell_prototype ~handle ?(hs = false) style =
10338   pr "%s -> " handle;
10339   let string = if hs then "String" else "CString" in
10340   let int = if hs then "Int" else "CInt" in
10341   let bool = if hs then "Bool" else "CInt" in
10342   let int64 = if hs then "Integer" else "Int64" in
10343   List.iter (
10344     fun arg ->
10345       (match arg with
10346        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10347        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10348        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10349        | Bool _ -> pr "%s" bool
10350        | Int _ -> pr "%s" int
10351        | Int64 _ -> pr "%s" int
10352        | FileIn _ -> pr "%s" string
10353        | FileOut _ -> pr "%s" string
10354       );
10355       pr " -> ";
10356   ) (snd style);
10357   pr "IO (";
10358   (match fst style with
10359    | RErr -> if not hs then pr "CInt"
10360    | RInt _ -> pr "%s" int
10361    | RInt64 _ -> pr "%s" int64
10362    | RBool _ -> pr "%s" bool
10363    | RConstString _ -> pr "%s" string
10364    | RConstOptString _ -> pr "Maybe %s" string
10365    | RString _ -> pr "%s" string
10366    | RStringList _ -> pr "[%s]" string
10367    | RStruct (_, typ) ->
10368        let name = java_name_of_struct typ in
10369        pr "%s" name
10370    | RStructList (_, typ) ->
10371        let name = java_name_of_struct typ in
10372        pr "[%s]" name
10373    | RHashtable _ -> pr "Hashtable"
10374    | RBufferOut _ -> pr "%s" string
10375   );
10376   pr ")"
10377
10378 and generate_csharp () =
10379   generate_header CPlusPlusStyle LGPLv2plus;
10380
10381   (* XXX Make this configurable by the C# assembly users. *)
10382   let library = "libguestfs.so.0" in
10383
10384   pr "\
10385 // These C# bindings are highly experimental at present.
10386 //
10387 // Firstly they only work on Linux (ie. Mono).  In order to get them
10388 // to work on Windows (ie. .Net) you would need to port the library
10389 // itself to Windows first.
10390 //
10391 // The second issue is that some calls are known to be incorrect and
10392 // can cause Mono to segfault.  Particularly: calls which pass or
10393 // return string[], or return any structure value.  This is because
10394 // we haven't worked out the correct way to do this from C#.
10395 //
10396 // The third issue is that when compiling you get a lot of warnings.
10397 // We are not sure whether the warnings are important or not.
10398 //
10399 // Fourthly we do not routinely build or test these bindings as part
10400 // of the make && make check cycle, which means that regressions might
10401 // go unnoticed.
10402 //
10403 // Suggestions and patches are welcome.
10404
10405 // To compile:
10406 //
10407 // gmcs Libguestfs.cs
10408 // mono Libguestfs.exe
10409 //
10410 // (You'll probably want to add a Test class / static main function
10411 // otherwise this won't do anything useful).
10412
10413 using System;
10414 using System.IO;
10415 using System.Runtime.InteropServices;
10416 using System.Runtime.Serialization;
10417 using System.Collections;
10418
10419 namespace Guestfs
10420 {
10421   class Error : System.ApplicationException
10422   {
10423     public Error (string message) : base (message) {}
10424     protected Error (SerializationInfo info, StreamingContext context) {}
10425   }
10426
10427   class Guestfs
10428   {
10429     IntPtr _handle;
10430
10431     [DllImport (\"%s\")]
10432     static extern IntPtr guestfs_create ();
10433
10434     public Guestfs ()
10435     {
10436       _handle = guestfs_create ();
10437       if (_handle == IntPtr.Zero)
10438         throw new Error (\"could not create guestfs handle\");
10439     }
10440
10441     [DllImport (\"%s\")]
10442     static extern void guestfs_close (IntPtr h);
10443
10444     ~Guestfs ()
10445     {
10446       guestfs_close (_handle);
10447     }
10448
10449     [DllImport (\"%s\")]
10450     static extern string guestfs_last_error (IntPtr h);
10451
10452 " library library library;
10453
10454   (* Generate C# structure bindings.  We prefix struct names with
10455    * underscore because C# cannot have conflicting struct names and
10456    * method names (eg. "class stat" and "stat").
10457    *)
10458   List.iter (
10459     fun (typ, cols) ->
10460       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10461       pr "    public class _%s {\n" typ;
10462       List.iter (
10463         function
10464         | name, FChar -> pr "      char %s;\n" name
10465         | name, FString -> pr "      string %s;\n" name
10466         | name, FBuffer ->
10467             pr "      uint %s_len;\n" name;
10468             pr "      string %s;\n" name
10469         | name, FUUID ->
10470             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10471             pr "      string %s;\n" name
10472         | name, FUInt32 -> pr "      uint %s;\n" name
10473         | name, FInt32 -> pr "      int %s;\n" name
10474         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10475         | name, FInt64 -> pr "      long %s;\n" name
10476         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10477       ) cols;
10478       pr "    }\n";
10479       pr "\n"
10480   ) structs;
10481
10482   (* Generate C# function bindings. *)
10483   List.iter (
10484     fun (name, style, _, _, _, shortdesc, _) ->
10485       let rec csharp_return_type () =
10486         match fst style with
10487         | RErr -> "void"
10488         | RBool n -> "bool"
10489         | RInt n -> "int"
10490         | RInt64 n -> "long"
10491         | RConstString n
10492         | RConstOptString n
10493         | RString n
10494         | RBufferOut n -> "string"
10495         | RStruct (_,n) -> "_" ^ n
10496         | RHashtable n -> "Hashtable"
10497         | RStringList n -> "string[]"
10498         | RStructList (_,n) -> sprintf "_%s[]" n
10499
10500       and c_return_type () =
10501         match fst style with
10502         | RErr
10503         | RBool _
10504         | RInt _ -> "int"
10505         | RInt64 _ -> "long"
10506         | RConstString _
10507         | RConstOptString _
10508         | RString _
10509         | RBufferOut _ -> "string"
10510         | RStruct (_,n) -> "_" ^ n
10511         | RHashtable _
10512         | RStringList _ -> "string[]"
10513         | RStructList (_,n) -> sprintf "_%s[]" n
10514
10515       and c_error_comparison () =
10516         match fst style with
10517         | RErr
10518         | RBool _
10519         | RInt _
10520         | RInt64 _ -> "== -1"
10521         | RConstString _
10522         | RConstOptString _
10523         | RString _
10524         | RBufferOut _
10525         | RStruct (_,_)
10526         | RHashtable _
10527         | RStringList _
10528         | RStructList (_,_) -> "== null"
10529
10530       and generate_extern_prototype () =
10531         pr "    static extern %s guestfs_%s (IntPtr h"
10532           (c_return_type ()) name;
10533         List.iter (
10534           function
10535           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10536           | FileIn n | FileOut n ->
10537               pr ", [In] string %s" n
10538           | StringList n | DeviceList n ->
10539               pr ", [In] string[] %s" n
10540           | Bool n ->
10541               pr ", bool %s" n
10542           | Int n ->
10543               pr ", int %s" n
10544           | Int64 n ->
10545               pr ", long %s" n
10546         ) (snd style);
10547         pr ");\n"
10548
10549       and generate_public_prototype () =
10550         pr "    public %s %s (" (csharp_return_type ()) name;
10551         let comma = ref false in
10552         let next () =
10553           if !comma then pr ", ";
10554           comma := true
10555         in
10556         List.iter (
10557           function
10558           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10559           | FileIn n | FileOut n ->
10560               next (); pr "string %s" n
10561           | StringList n | DeviceList n ->
10562               next (); pr "string[] %s" n
10563           | Bool n ->
10564               next (); pr "bool %s" n
10565           | Int n ->
10566               next (); pr "int %s" n
10567           | Int64 n ->
10568               next (); pr "long %s" n
10569         ) (snd style);
10570         pr ")\n"
10571
10572       and generate_call () =
10573         pr "guestfs_%s (_handle" name;
10574         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10575         pr ");\n";
10576       in
10577
10578       pr "    [DllImport (\"%s\")]\n" library;
10579       generate_extern_prototype ();
10580       pr "\n";
10581       pr "    /// <summary>\n";
10582       pr "    /// %s\n" shortdesc;
10583       pr "    /// </summary>\n";
10584       generate_public_prototype ();
10585       pr "    {\n";
10586       pr "      %s r;\n" (c_return_type ());
10587       pr "      r = ";
10588       generate_call ();
10589       pr "      if (r %s)\n" (c_error_comparison ());
10590       pr "        throw new Error (guestfs_last_error (_handle));\n";
10591       (match fst style with
10592        | RErr -> ()
10593        | RBool _ ->
10594            pr "      return r != 0 ? true : false;\n"
10595        | RHashtable _ ->
10596            pr "      Hashtable rr = new Hashtable ();\n";
10597            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10598            pr "        rr.Add (r[i], r[i+1]);\n";
10599            pr "      return rr;\n"
10600        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10601        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10602        | RStructList _ ->
10603            pr "      return r;\n"
10604       );
10605       pr "    }\n";
10606       pr "\n";
10607   ) all_functions_sorted;
10608
10609   pr "  }
10610 }
10611 "
10612
10613 and generate_bindtests () =
10614   generate_header CStyle LGPLv2plus;
10615
10616   pr "\
10617 #include <stdio.h>
10618 #include <stdlib.h>
10619 #include <inttypes.h>
10620 #include <string.h>
10621
10622 #include \"guestfs.h\"
10623 #include \"guestfs-internal.h\"
10624 #include \"guestfs-internal-actions.h\"
10625 #include \"guestfs_protocol.h\"
10626
10627 #define error guestfs_error
10628 #define safe_calloc guestfs_safe_calloc
10629 #define safe_malloc guestfs_safe_malloc
10630
10631 static void
10632 print_strings (char *const *argv)
10633 {
10634   int argc;
10635
10636   printf (\"[\");
10637   for (argc = 0; argv[argc] != NULL; ++argc) {
10638     if (argc > 0) printf (\", \");
10639     printf (\"\\\"%%s\\\"\", argv[argc]);
10640   }
10641   printf (\"]\\n\");
10642 }
10643
10644 /* The test0 function prints its parameters to stdout. */
10645 ";
10646
10647   let test0, tests =
10648     match test_functions with
10649     | [] -> assert false
10650     | test0 :: tests -> test0, tests in
10651
10652   let () =
10653     let (name, style, _, _, _, _, _) = test0 in
10654     generate_prototype ~extern:false ~semicolon:false ~newline:true
10655       ~handle:"g" ~prefix:"guestfs__" name style;
10656     pr "{\n";
10657     List.iter (
10658       function
10659       | Pathname n
10660       | Device n | Dev_or_Path n
10661       | String n
10662       | FileIn n
10663       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10664       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10665       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10666       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10667       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10668       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10669     ) (snd style);
10670     pr "  /* Java changes stdout line buffering so we need this: */\n";
10671     pr "  fflush (stdout);\n";
10672     pr "  return 0;\n";
10673     pr "}\n";
10674     pr "\n" in
10675
10676   List.iter (
10677     fun (name, style, _, _, _, _, _) ->
10678       if String.sub name (String.length name - 3) 3 <> "err" then (
10679         pr "/* Test normal return. */\n";
10680         generate_prototype ~extern:false ~semicolon:false ~newline:true
10681           ~handle:"g" ~prefix:"guestfs__" name style;
10682         pr "{\n";
10683         (match fst style with
10684          | RErr ->
10685              pr "  return 0;\n"
10686          | RInt _ ->
10687              pr "  int r;\n";
10688              pr "  sscanf (val, \"%%d\", &r);\n";
10689              pr "  return r;\n"
10690          | RInt64 _ ->
10691              pr "  int64_t r;\n";
10692              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10693              pr "  return r;\n"
10694          | RBool _ ->
10695              pr "  return STREQ (val, \"true\");\n"
10696          | RConstString _
10697          | RConstOptString _ ->
10698              (* Can't return the input string here.  Return a static
10699               * string so we ensure we get a segfault if the caller
10700               * tries to free it.
10701               *)
10702              pr "  return \"static string\";\n"
10703          | RString _ ->
10704              pr "  return strdup (val);\n"
10705          | RStringList _ ->
10706              pr "  char **strs;\n";
10707              pr "  int n, i;\n";
10708              pr "  sscanf (val, \"%%d\", &n);\n";
10709              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10710              pr "  for (i = 0; i < n; ++i) {\n";
10711              pr "    strs[i] = safe_malloc (g, 16);\n";
10712              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10713              pr "  }\n";
10714              pr "  strs[n] = NULL;\n";
10715              pr "  return strs;\n"
10716          | RStruct (_, typ) ->
10717              pr "  struct guestfs_%s *r;\n" typ;
10718              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10719              pr "  return r;\n"
10720          | RStructList (_, typ) ->
10721              pr "  struct guestfs_%s_list *r;\n" typ;
10722              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10723              pr "  sscanf (val, \"%%d\", &r->len);\n";
10724              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10725              pr "  return r;\n"
10726          | RHashtable _ ->
10727              pr "  char **strs;\n";
10728              pr "  int n, i;\n";
10729              pr "  sscanf (val, \"%%d\", &n);\n";
10730              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10731              pr "  for (i = 0; i < n; ++i) {\n";
10732              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10733              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10734              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10735              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10736              pr "  }\n";
10737              pr "  strs[n*2] = NULL;\n";
10738              pr "  return strs;\n"
10739          | RBufferOut _ ->
10740              pr "  return strdup (val);\n"
10741         );
10742         pr "}\n";
10743         pr "\n"
10744       ) else (
10745         pr "/* Test error return. */\n";
10746         generate_prototype ~extern:false ~semicolon:false ~newline:true
10747           ~handle:"g" ~prefix:"guestfs__" name style;
10748         pr "{\n";
10749         pr "  error (g, \"error\");\n";
10750         (match fst style with
10751          | RErr | RInt _ | RInt64 _ | RBool _ ->
10752              pr "  return -1;\n"
10753          | RConstString _ | RConstOptString _
10754          | RString _ | RStringList _ | RStruct _
10755          | RStructList _
10756          | RHashtable _
10757          | RBufferOut _ ->
10758              pr "  return NULL;\n"
10759         );
10760         pr "}\n";
10761         pr "\n"
10762       )
10763   ) tests
10764
10765 and generate_ocaml_bindtests () =
10766   generate_header OCamlStyle GPLv2plus;
10767
10768   pr "\
10769 let () =
10770   let g = Guestfs.create () in
10771 ";
10772
10773   let mkargs args =
10774     String.concat " " (
10775       List.map (
10776         function
10777         | CallString s -> "\"" ^ s ^ "\""
10778         | CallOptString None -> "None"
10779         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10780         | CallStringList xs ->
10781             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10782         | CallInt i when i >= 0 -> string_of_int i
10783         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10784         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10785         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10786         | CallBool b -> string_of_bool b
10787       ) args
10788     )
10789   in
10790
10791   generate_lang_bindtests (
10792     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10793   );
10794
10795   pr "print_endline \"EOF\"\n"
10796
10797 and generate_perl_bindtests () =
10798   pr "#!/usr/bin/perl -w\n";
10799   generate_header HashStyle GPLv2plus;
10800
10801   pr "\
10802 use strict;
10803
10804 use Sys::Guestfs;
10805
10806 my $g = Sys::Guestfs->new ();
10807 ";
10808
10809   let mkargs args =
10810     String.concat ", " (
10811       List.map (
10812         function
10813         | CallString s -> "\"" ^ s ^ "\""
10814         | CallOptString None -> "undef"
10815         | CallOptString (Some s) -> sprintf "\"%s\"" s
10816         | CallStringList xs ->
10817             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10818         | CallInt i -> string_of_int i
10819         | CallInt64 i -> Int64.to_string i
10820         | CallBool b -> if b then "1" else "0"
10821       ) args
10822     )
10823   in
10824
10825   generate_lang_bindtests (
10826     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10827   );
10828
10829   pr "print \"EOF\\n\"\n"
10830
10831 and generate_python_bindtests () =
10832   generate_header HashStyle GPLv2plus;
10833
10834   pr "\
10835 import guestfs
10836
10837 g = guestfs.GuestFS ()
10838 ";
10839
10840   let mkargs args =
10841     String.concat ", " (
10842       List.map (
10843         function
10844         | CallString s -> "\"" ^ s ^ "\""
10845         | CallOptString None -> "None"
10846         | CallOptString (Some s) -> sprintf "\"%s\"" s
10847         | CallStringList xs ->
10848             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10849         | CallInt i -> string_of_int i
10850         | CallInt64 i -> Int64.to_string i
10851         | CallBool b -> if b then "1" else "0"
10852       ) args
10853     )
10854   in
10855
10856   generate_lang_bindtests (
10857     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10858   );
10859
10860   pr "print \"EOF\"\n"
10861
10862 and generate_ruby_bindtests () =
10863   generate_header HashStyle GPLv2plus;
10864
10865   pr "\
10866 require 'guestfs'
10867
10868 g = Guestfs::create()
10869 ";
10870
10871   let mkargs args =
10872     String.concat ", " (
10873       List.map (
10874         function
10875         | CallString s -> "\"" ^ s ^ "\""
10876         | CallOptString None -> "nil"
10877         | CallOptString (Some s) -> sprintf "\"%s\"" s
10878         | CallStringList xs ->
10879             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10880         | CallInt i -> string_of_int i
10881         | CallInt64 i -> Int64.to_string i
10882         | CallBool b -> string_of_bool b
10883       ) args
10884     )
10885   in
10886
10887   generate_lang_bindtests (
10888     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10889   );
10890
10891   pr "print \"EOF\\n\"\n"
10892
10893 and generate_java_bindtests () =
10894   generate_header CStyle GPLv2plus;
10895
10896   pr "\
10897 import com.redhat.et.libguestfs.*;
10898
10899 public class Bindtests {
10900     public static void main (String[] argv)
10901     {
10902         try {
10903             GuestFS g = new GuestFS ();
10904 ";
10905
10906   let mkargs args =
10907     String.concat ", " (
10908       List.map (
10909         function
10910         | CallString s -> "\"" ^ s ^ "\""
10911         | CallOptString None -> "null"
10912         | CallOptString (Some s) -> sprintf "\"%s\"" s
10913         | CallStringList xs ->
10914             "new String[]{" ^
10915               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10916         | CallInt i -> string_of_int i
10917         | CallInt64 i -> Int64.to_string i
10918         | CallBool b -> string_of_bool b
10919       ) args
10920     )
10921   in
10922
10923   generate_lang_bindtests (
10924     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10925   );
10926
10927   pr "
10928             System.out.println (\"EOF\");
10929         }
10930         catch (Exception exn) {
10931             System.err.println (exn);
10932             System.exit (1);
10933         }
10934     }
10935 }
10936 "
10937
10938 and generate_haskell_bindtests () =
10939   generate_header HaskellStyle GPLv2plus;
10940
10941   pr "\
10942 module Bindtests where
10943 import qualified Guestfs
10944
10945 main = do
10946   g <- Guestfs.create
10947 ";
10948
10949   let mkargs args =
10950     String.concat " " (
10951       List.map (
10952         function
10953         | CallString s -> "\"" ^ s ^ "\""
10954         | CallOptString None -> "Nothing"
10955         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10956         | CallStringList xs ->
10957             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10958         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10959         | CallInt i -> string_of_int i
10960         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10961         | CallInt64 i -> Int64.to_string i
10962         | CallBool true -> "True"
10963         | CallBool false -> "False"
10964       ) args
10965     )
10966   in
10967
10968   generate_lang_bindtests (
10969     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10970   );
10971
10972   pr "  putStrLn \"EOF\"\n"
10973
10974 (* Language-independent bindings tests - we do it this way to
10975  * ensure there is parity in testing bindings across all languages.
10976  *)
10977 and generate_lang_bindtests call =
10978   call "test0" [CallString "abc"; CallOptString (Some "def");
10979                 CallStringList []; CallBool false;
10980                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10981   call "test0" [CallString "abc"; CallOptString None;
10982                 CallStringList []; CallBool false;
10983                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10984   call "test0" [CallString ""; CallOptString (Some "def");
10985                 CallStringList []; CallBool false;
10986                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10987   call "test0" [CallString ""; CallOptString (Some "");
10988                 CallStringList []; CallBool false;
10989                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10990   call "test0" [CallString "abc"; CallOptString (Some "def");
10991                 CallStringList ["1"]; CallBool false;
10992                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10993   call "test0" [CallString "abc"; CallOptString (Some "def");
10994                 CallStringList ["1"; "2"]; CallBool false;
10995                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10996   call "test0" [CallString "abc"; CallOptString (Some "def");
10997                 CallStringList ["1"]; CallBool true;
10998                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10999   call "test0" [CallString "abc"; CallOptString (Some "def");
11000                 CallStringList ["1"]; CallBool false;
11001                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
11002   call "test0" [CallString "abc"; CallOptString (Some "def");
11003                 CallStringList ["1"]; CallBool false;
11004                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
11005   call "test0" [CallString "abc"; CallOptString (Some "def");
11006                 CallStringList ["1"]; CallBool false;
11007                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
11008   call "test0" [CallString "abc"; CallOptString (Some "def");
11009                 CallStringList ["1"]; CallBool false;
11010                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11011   call "test0" [CallString "abc"; CallOptString (Some "def");
11012                 CallStringList ["1"]; CallBool false;
11013                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11014   call "test0" [CallString "abc"; CallOptString (Some "def");
11015                 CallStringList ["1"]; CallBool false;
11016                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11017
11018 (* XXX Add here tests of the return and error functions. *)
11019
11020 (* Code to generator bindings for virt-inspector.  Currently only
11021  * implemented for OCaml code (for virt-p2v 2.0).
11022  *)
11023 let rng_input = "inspector/virt-inspector.rng"
11024
11025 (* Read the input file and parse it into internal structures.  This is
11026  * by no means a complete RELAX NG parser, but is just enough to be
11027  * able to parse the specific input file.
11028  *)
11029 type rng =
11030   | Element of string * rng list        (* <element name=name/> *)
11031   | Attribute of string * rng list        (* <attribute name=name/> *)
11032   | Interleave of rng list                (* <interleave/> *)
11033   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11034   | OneOrMore of rng                        (* <oneOrMore/> *)
11035   | Optional of rng                        (* <optional/> *)
11036   | Choice of string list                (* <choice><value/>*</choice> *)
11037   | Value of string                        (* <value>str</value> *)
11038   | Text                                (* <text/> *)
11039
11040 let rec string_of_rng = function
11041   | Element (name, xs) ->
11042       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11043   | Attribute (name, xs) ->
11044       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11045   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11046   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11047   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11048   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11049   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11050   | Value value -> "Value \"" ^ value ^ "\""
11051   | Text -> "Text"
11052
11053 and string_of_rng_list xs =
11054   String.concat ", " (List.map string_of_rng xs)
11055
11056 let rec parse_rng ?defines context = function
11057   | [] -> []
11058   | Xml.Element ("element", ["name", name], children) :: rest ->
11059       Element (name, parse_rng ?defines context children)
11060       :: parse_rng ?defines context rest
11061   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11062       Attribute (name, parse_rng ?defines context children)
11063       :: parse_rng ?defines context rest
11064   | Xml.Element ("interleave", [], children) :: rest ->
11065       Interleave (parse_rng ?defines context children)
11066       :: parse_rng ?defines context rest
11067   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11068       let rng = parse_rng ?defines context [child] in
11069       (match rng with
11070        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11071        | _ ->
11072            failwithf "%s: <zeroOrMore> contains more than one child element"
11073              context
11074       )
11075   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11076       let rng = parse_rng ?defines context [child] in
11077       (match rng with
11078        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11079        | _ ->
11080            failwithf "%s: <oneOrMore> contains more than one child element"
11081              context
11082       )
11083   | Xml.Element ("optional", [], [child]) :: rest ->
11084       let rng = parse_rng ?defines context [child] in
11085       (match rng with
11086        | [child] -> Optional child :: parse_rng ?defines context rest
11087        | _ ->
11088            failwithf "%s: <optional> contains more than one child element"
11089              context
11090       )
11091   | Xml.Element ("choice", [], children) :: rest ->
11092       let values = List.map (
11093         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11094         | _ ->
11095             failwithf "%s: can't handle anything except <value> in <choice>"
11096               context
11097       ) children in
11098       Choice values
11099       :: parse_rng ?defines context rest
11100   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11101       Value value :: parse_rng ?defines context rest
11102   | Xml.Element ("text", [], []) :: rest ->
11103       Text :: parse_rng ?defines context rest
11104   | Xml.Element ("ref", ["name", name], []) :: rest ->
11105       (* Look up the reference.  Because of limitations in this parser,
11106        * we can't handle arbitrarily nested <ref> yet.  You can only
11107        * use <ref> from inside <start>.
11108        *)
11109       (match defines with
11110        | None ->
11111            failwithf "%s: contains <ref>, but no refs are defined yet" context
11112        | Some map ->
11113            let rng = StringMap.find name map in
11114            rng @ parse_rng ?defines context rest
11115       )
11116   | x :: _ ->
11117       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11118
11119 let grammar =
11120   let xml = Xml.parse_file rng_input in
11121   match xml with
11122   | Xml.Element ("grammar", _,
11123                  Xml.Element ("start", _, gram) :: defines) ->
11124       (* The <define/> elements are referenced in the <start> section,
11125        * so build a map of those first.
11126        *)
11127       let defines = List.fold_left (
11128         fun map ->
11129           function Xml.Element ("define", ["name", name], defn) ->
11130             StringMap.add name defn map
11131           | _ ->
11132               failwithf "%s: expected <define name=name/>" rng_input
11133       ) StringMap.empty defines in
11134       let defines = StringMap.mapi parse_rng defines in
11135
11136       (* Parse the <start> clause, passing the defines. *)
11137       parse_rng ~defines "<start>" gram
11138   | _ ->
11139       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11140         rng_input
11141
11142 let name_of_field = function
11143   | Element (name, _) | Attribute (name, _)
11144   | ZeroOrMore (Element (name, _))
11145   | OneOrMore (Element (name, _))
11146   | Optional (Element (name, _)) -> name
11147   | Optional (Attribute (name, _)) -> name
11148   | Text -> (* an unnamed field in an element *)
11149       "data"
11150   | rng ->
11151       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11152
11153 (* At the moment this function only generates OCaml types.  However we
11154  * should parameterize it later so it can generate types/structs in a
11155  * variety of languages.
11156  *)
11157 let generate_types xs =
11158   (* A simple type is one that can be printed out directly, eg.
11159    * "string option".  A complex type is one which has a name and has
11160    * to be defined via another toplevel definition, eg. a struct.
11161    *
11162    * generate_type generates code for either simple or complex types.
11163    * In the simple case, it returns the string ("string option").  In
11164    * the complex case, it returns the name ("mountpoint").  In the
11165    * complex case it has to print out the definition before returning,
11166    * so it should only be called when we are at the beginning of a
11167    * new line (BOL context).
11168    *)
11169   let rec generate_type = function
11170     | Text ->                                (* string *)
11171         "string", true
11172     | Choice values ->                        (* [`val1|`val2|...] *)
11173         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11174     | ZeroOrMore rng ->                        (* <rng> list *)
11175         let t, is_simple = generate_type rng in
11176         t ^ " list (* 0 or more *)", is_simple
11177     | OneOrMore rng ->                        (* <rng> list *)
11178         let t, is_simple = generate_type rng in
11179         t ^ " list (* 1 or more *)", is_simple
11180                                         (* virt-inspector hack: bool *)
11181     | Optional (Attribute (name, [Value "1"])) ->
11182         "bool", true
11183     | Optional rng ->                        (* <rng> list *)
11184         let t, is_simple = generate_type rng in
11185         t ^ " option", is_simple
11186                                         (* type name = { fields ... } *)
11187     | Element (name, fields) when is_attrs_interleave fields ->
11188         generate_type_struct name (get_attrs_interleave fields)
11189     | Element (name, [field])                (* type name = field *)
11190     | Attribute (name, [field]) ->
11191         let t, is_simple = generate_type field in
11192         if is_simple then (t, true)
11193         else (
11194           pr "type %s = %s\n" name t;
11195           name, false
11196         )
11197     | Element (name, fields) ->              (* type name = { fields ... } *)
11198         generate_type_struct name fields
11199     | rng ->
11200         failwithf "generate_type failed at: %s" (string_of_rng rng)
11201
11202   and is_attrs_interleave = function
11203     | [Interleave _] -> true
11204     | Attribute _ :: fields -> is_attrs_interleave fields
11205     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11206     | _ -> false
11207
11208   and get_attrs_interleave = function
11209     | [Interleave fields] -> fields
11210     | ((Attribute _) as field) :: fields
11211     | ((Optional (Attribute _)) as field) :: fields ->
11212         field :: get_attrs_interleave fields
11213     | _ -> assert false
11214
11215   and generate_types xs =
11216     List.iter (fun x -> ignore (generate_type x)) xs
11217
11218   and generate_type_struct name fields =
11219     (* Calculate the types of the fields first.  We have to do this
11220      * before printing anything so we are still in BOL context.
11221      *)
11222     let types = List.map fst (List.map generate_type fields) in
11223
11224     (* Special case of a struct containing just a string and another
11225      * field.  Turn it into an assoc list.
11226      *)
11227     match types with
11228     | ["string"; other] ->
11229         let fname1, fname2 =
11230           match fields with
11231           | [f1; f2] -> name_of_field f1, name_of_field f2
11232           | _ -> assert false in
11233         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11234         name, false
11235
11236     | types ->
11237         pr "type %s = {\n" name;
11238         List.iter (
11239           fun (field, ftype) ->
11240             let fname = name_of_field field in
11241             pr "  %s_%s : %s;\n" name fname ftype
11242         ) (List.combine fields types);
11243         pr "}\n";
11244         (* Return the name of this type, and
11245          * false because it's not a simple type.
11246          *)
11247         name, false
11248   in
11249
11250   generate_types xs
11251
11252 let generate_parsers xs =
11253   (* As for generate_type above, generate_parser makes a parser for
11254    * some type, and returns the name of the parser it has generated.
11255    * Because it (may) need to print something, it should always be
11256    * called in BOL context.
11257    *)
11258   let rec generate_parser = function
11259     | Text ->                                (* string *)
11260         "string_child_or_empty"
11261     | Choice values ->                        (* [`val1|`val2|...] *)
11262         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11263           (String.concat "|"
11264              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11265     | ZeroOrMore rng ->                        (* <rng> list *)
11266         let pa = generate_parser rng in
11267         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11268     | OneOrMore rng ->                        (* <rng> list *)
11269         let pa = generate_parser rng in
11270         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11271                                         (* virt-inspector hack: bool *)
11272     | Optional (Attribute (name, [Value "1"])) ->
11273         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11274     | Optional rng ->                        (* <rng> list *)
11275         let pa = generate_parser rng in
11276         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11277                                         (* type name = { fields ... } *)
11278     | Element (name, fields) when is_attrs_interleave fields ->
11279         generate_parser_struct name (get_attrs_interleave fields)
11280     | Element (name, [field]) ->        (* type name = field *)
11281         let pa = generate_parser field in
11282         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11283         pr "let %s =\n" parser_name;
11284         pr "  %s\n" pa;
11285         pr "let parse_%s = %s\n" name parser_name;
11286         parser_name
11287     | Attribute (name, [field]) ->
11288         let pa = generate_parser field in
11289         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11290         pr "let %s =\n" parser_name;
11291         pr "  %s\n" pa;
11292         pr "let parse_%s = %s\n" name parser_name;
11293         parser_name
11294     | Element (name, fields) ->              (* type name = { fields ... } *)
11295         generate_parser_struct name ([], fields)
11296     | rng ->
11297         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11298
11299   and is_attrs_interleave = function
11300     | [Interleave _] -> true
11301     | Attribute _ :: fields -> is_attrs_interleave fields
11302     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11303     | _ -> false
11304
11305   and get_attrs_interleave = function
11306     | [Interleave fields] -> [], fields
11307     | ((Attribute _) as field) :: fields
11308     | ((Optional (Attribute _)) as field) :: fields ->
11309         let attrs, interleaves = get_attrs_interleave fields in
11310         (field :: attrs), interleaves
11311     | _ -> assert false
11312
11313   and generate_parsers xs =
11314     List.iter (fun x -> ignore (generate_parser x)) xs
11315
11316   and generate_parser_struct name (attrs, interleaves) =
11317     (* Generate parsers for the fields first.  We have to do this
11318      * before printing anything so we are still in BOL context.
11319      *)
11320     let fields = attrs @ interleaves in
11321     let pas = List.map generate_parser fields in
11322
11323     (* Generate an intermediate tuple from all the fields first.
11324      * If the type is just a string + another field, then we will
11325      * return this directly, otherwise it is turned into a record.
11326      *
11327      * RELAX NG note: This code treats <interleave> and plain lists of
11328      * fields the same.  In other words, it doesn't bother enforcing
11329      * any ordering of fields in the XML.
11330      *)
11331     pr "let parse_%s x =\n" name;
11332     pr "  let t = (\n    ";
11333     let comma = ref false in
11334     List.iter (
11335       fun x ->
11336         if !comma then pr ",\n    ";
11337         comma := true;
11338         match x with
11339         | Optional (Attribute (fname, [field])), pa ->
11340             pr "%s x" pa
11341         | Optional (Element (fname, [field])), pa ->
11342             pr "%s (optional_child %S x)" pa fname
11343         | Attribute (fname, [Text]), _ ->
11344             pr "attribute %S x" fname
11345         | (ZeroOrMore _ | OneOrMore _), pa ->
11346             pr "%s x" pa
11347         | Text, pa ->
11348             pr "%s x" pa
11349         | (field, pa) ->
11350             let fname = name_of_field field in
11351             pr "%s (child %S x)" pa fname
11352     ) (List.combine fields pas);
11353     pr "\n  ) in\n";
11354
11355     (match fields with
11356      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11357          pr "  t\n"
11358
11359      | _ ->
11360          pr "  (Obj.magic t : %s)\n" name
11361 (*
11362          List.iter (
11363            function
11364            | (Optional (Attribute (fname, [field])), pa) ->
11365                pr "  %s_%s =\n" name fname;
11366                pr "    %s x;\n" pa
11367            | (Optional (Element (fname, [field])), pa) ->
11368                pr "  %s_%s =\n" name fname;
11369                pr "    (let x = optional_child %S x in\n" fname;
11370                pr "     %s x);\n" pa
11371            | (field, pa) ->
11372                let fname = name_of_field field in
11373                pr "  %s_%s =\n" name fname;
11374                pr "    (let x = child %S x in\n" fname;
11375                pr "     %s x);\n" pa
11376          ) (List.combine fields pas);
11377          pr "}\n"
11378 *)
11379     );
11380     sprintf "parse_%s" name
11381   in
11382
11383   generate_parsers xs
11384
11385 (* Generate ocaml/guestfs_inspector.mli. *)
11386 let generate_ocaml_inspector_mli () =
11387   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11388
11389   pr "\
11390 (** This is an OCaml language binding to the external [virt-inspector]
11391     program.
11392
11393     For more information, please read the man page [virt-inspector(1)].
11394 *)
11395
11396 ";
11397
11398   generate_types grammar;
11399   pr "(** The nested information returned from the {!inspect} function. *)\n";
11400   pr "\n";
11401
11402   pr "\
11403 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11404 (** To inspect a libvirt domain called [name], pass a singleton
11405     list: [inspect [name]].  When using libvirt only, you may
11406     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11407
11408     To inspect a disk image or images, pass a list of the filenames
11409     of the disk images: [inspect filenames]
11410
11411     This function inspects the given guest or disk images and
11412     returns a list of operating system(s) found and a large amount
11413     of information about them.  In the vast majority of cases,
11414     a virtual machine only contains a single operating system.
11415
11416     If the optional [~xml] parameter is given, then this function
11417     skips running the external virt-inspector program and just
11418     parses the given XML directly (which is expected to be XML
11419     produced from a previous run of virt-inspector).  The list of
11420     names and connect URI are ignored in this case.
11421
11422     This function can throw a wide variety of exceptions, for example
11423     if the external virt-inspector program cannot be found, or if
11424     it doesn't generate valid XML.
11425 *)
11426 "
11427
11428 (* Generate ocaml/guestfs_inspector.ml. *)
11429 let generate_ocaml_inspector_ml () =
11430   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11431
11432   pr "open Unix\n";
11433   pr "\n";
11434
11435   generate_types grammar;
11436   pr "\n";
11437
11438   pr "\
11439 (* Misc functions which are used by the parser code below. *)
11440 let first_child = function
11441   | Xml.Element (_, _, c::_) -> c
11442   | Xml.Element (name, _, []) ->
11443       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11444   | Xml.PCData str ->
11445       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11446
11447 let string_child_or_empty = function
11448   | Xml.Element (_, _, [Xml.PCData s]) -> s
11449   | Xml.Element (_, _, []) -> \"\"
11450   | Xml.Element (x, _, _) ->
11451       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11452                 x ^ \" instead\")
11453   | Xml.PCData str ->
11454       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11455
11456 let optional_child name xml =
11457   let children = Xml.children xml in
11458   try
11459     Some (List.find (function
11460                      | Xml.Element (n, _, _) when n = name -> true
11461                      | _ -> false) children)
11462   with
11463     Not_found -> None
11464
11465 let child name xml =
11466   match optional_child name xml with
11467   | Some c -> c
11468   | None ->
11469       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11470
11471 let attribute name xml =
11472   try Xml.attrib xml name
11473   with Xml.No_attribute _ ->
11474     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11475
11476 ";
11477
11478   generate_parsers grammar;
11479   pr "\n";
11480
11481   pr "\
11482 (* Run external virt-inspector, then use parser to parse the XML. *)
11483 let inspect ?connect ?xml names =
11484   let xml =
11485     match xml with
11486     | None ->
11487         if names = [] then invalid_arg \"inspect: no names given\";
11488         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11489           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11490           names in
11491         let cmd = List.map Filename.quote cmd in
11492         let cmd = String.concat \" \" cmd in
11493         let chan = open_process_in cmd in
11494         let xml = Xml.parse_in chan in
11495         (match close_process_in chan with
11496          | WEXITED 0 -> ()
11497          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11498          | WSIGNALED i | WSTOPPED i ->
11499              failwith (\"external virt-inspector command died or stopped on sig \" ^
11500                        string_of_int i)
11501         );
11502         xml
11503     | Some doc ->
11504         Xml.parse_string doc in
11505   parse_operatingsystems xml
11506 "
11507
11508 (* This is used to generate the src/MAX_PROC_NR file which
11509  * contains the maximum procedure number, a surrogate for the
11510  * ABI version number.  See src/Makefile.am for the details.
11511  *)
11512 and generate_max_proc_nr () =
11513   let proc_nrs = List.map (
11514     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11515   ) daemon_functions in
11516
11517   let max_proc_nr = List.fold_left max 0 proc_nrs in
11518
11519   pr "%d\n" max_proc_nr
11520
11521 let output_to filename k =
11522   let filename_new = filename ^ ".new" in
11523   chan := open_out filename_new;
11524   k ();
11525   close_out !chan;
11526   chan := Pervasives.stdout;
11527
11528   (* Is the new file different from the current file? *)
11529   if Sys.file_exists filename && files_equal filename filename_new then
11530     unlink filename_new                 (* same, so skip it *)
11531   else (
11532     (* different, overwrite old one *)
11533     (try chmod filename 0o644 with Unix_error _ -> ());
11534     rename filename_new filename;
11535     chmod filename 0o444;
11536     printf "written %s\n%!" filename;
11537   )
11538
11539 let perror msg = function
11540   | Unix_error (err, _, _) ->
11541       eprintf "%s: %s\n" msg (error_message err)
11542   | exn ->
11543       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11544
11545 (* Main program. *)
11546 let () =
11547   let lock_fd =
11548     try openfile "HACKING" [O_RDWR] 0
11549     with
11550     | Unix_error (ENOENT, _, _) ->
11551         eprintf "\
11552 You are probably running this from the wrong directory.
11553 Run it from the top source directory using the command
11554   src/generator.ml
11555 ";
11556         exit 1
11557     | exn ->
11558         perror "open: HACKING" exn;
11559         exit 1 in
11560
11561   (* Acquire a lock so parallel builds won't try to run the generator
11562    * twice at the same time.  Subsequent builds will wait for the first
11563    * one to finish.  Note the lock is released implicitly when the
11564    * program exits.
11565    *)
11566   (try lockf lock_fd F_LOCK 1
11567    with exn ->
11568      perror "lock: HACKING" exn;
11569      exit 1);
11570
11571   check_functions ();
11572
11573   output_to "src/guestfs_protocol.x" generate_xdr;
11574   output_to "src/guestfs-structs.h" generate_structs_h;
11575   output_to "src/guestfs-actions.h" generate_actions_h;
11576   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11577   output_to "src/guestfs-actions.c" generate_client_actions;
11578   output_to "src/guestfs-bindtests.c" generate_bindtests;
11579   output_to "src/guestfs-structs.pod" generate_structs_pod;
11580   output_to "src/guestfs-actions.pod" generate_actions_pod;
11581   output_to "src/guestfs-availability.pod" generate_availability_pod;
11582   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11583   output_to "src/libguestfs.syms" generate_linker_script;
11584   output_to "daemon/actions.h" generate_daemon_actions_h;
11585   output_to "daemon/stubs.c" generate_daemon_actions;
11586   output_to "daemon/names.c" generate_daemon_names;
11587   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11588   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11589   output_to "capitests/tests.c" generate_tests;
11590   output_to "fish/cmds.c" generate_fish_cmds;
11591   output_to "fish/completion.c" generate_fish_completion;
11592   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11593   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11594   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11595   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11596   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11597   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11598   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11599   output_to "perl/Guestfs.xs" generate_perl_xs;
11600   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11601   output_to "perl/bindtests.pl" generate_perl_bindtests;
11602   output_to "python/guestfs-py.c" generate_python_c;
11603   output_to "python/guestfs.py" generate_python_py;
11604   output_to "python/bindtests.py" generate_python_bindtests;
11605   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11606   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11607   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11608
11609   List.iter (
11610     fun (typ, jtyp) ->
11611       let cols = cols_of_struct typ in
11612       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11613       output_to filename (generate_java_struct jtyp cols);
11614   ) java_structs;
11615
11616   output_to "java/Makefile.inc" generate_java_makefile_inc;
11617   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11618   output_to "java/Bindtests.java" generate_java_bindtests;
11619   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11620   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11621   output_to "csharp/Libguestfs.cs" generate_csharp;
11622
11623   (* Always generate this file last, and unconditionally.  It's used
11624    * by the Makefile to know when we must re-run the generator.
11625    *)
11626   let chan = open_out "src/stamp-generator" in
11627   fprintf chan "1\n";
11628   close_out chan;
11629
11630   printf "generated %d lines of code\n" !lines