ocaml: Fix thread safety of strings in bindings (RHBZ#604691).
[libguestfs.git] / src / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009-2010 Red Hat Inc.
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18  *)
19
20 (* This script generates a large amount of code and documentation for
21  * all the daemon actions.
22  *
23  * To add a new action there are only two files you need to change,
24  * this one to describe the interface (see the big table of
25  * 'daemon_functions' below), and daemon/<somefile>.c to write the
26  * implementation.
27  *
28  * After editing this file, run it (./src/generator.ml) to regenerate
29  * all the output files.  'make' will rerun this automatically when
30  * necessary.  Note that if you are using a separate build directory
31  * you must run generator.ml from the _source_ directory.
32  *
33  * IMPORTANT: This script should NOT print any warnings.  If it prints
34  * warnings, you should treat them as errors.
35  *
36  * OCaml tips:
37  * (1) In emacs, install tuareg-mode to display and format OCaml code
38  * correctly.  'vim' comes with a good OCaml editing mode by default.
39  * (2) Read the resources at http://ocaml-tutorial.org/
40  *)
41
42 #load "unix.cma";;
43 #load "str.cma";;
44 #directory "+xml-light";;
45 #directory "+../pkg-lib/xml-light";; (* for GODI users *)
46 #load "xml-light.cma";;
47
48 open Unix
49 open Printf
50
51 type style = ret * args
52 and ret =
53     (* "RErr" as a return value means an int used as a simple error
54      * indication, ie. 0 or -1.
55      *)
56   | RErr
57
58     (* "RInt" as a return value means an int which is -1 for error
59      * or any value >= 0 on success.  Only use this for smallish
60      * positive ints (0 <= i < 2^30).
61      *)
62   | RInt of string
63
64     (* "RInt64" is the same as RInt, but is guaranteed to be able
65      * to return a full 64 bit value, _except_ that -1 means error
66      * (so -1 cannot be a valid, non-error return value).
67      *)
68   | RInt64 of string
69
70     (* "RBool" is a bool return value which can be true/false or
71      * -1 for error.
72      *)
73   | RBool of string
74
75     (* "RConstString" is a string that refers to a constant value.
76      * The return value must NOT be NULL (since NULL indicates
77      * an error).
78      *
79      * Try to avoid using this.  In particular you cannot use this
80      * for values returned from the daemon, because there is no
81      * thread-safe way to return them in the C API.
82      *)
83   | RConstString of string
84
85     (* "RConstOptString" is an even more broken version of
86      * "RConstString".  The returned string may be NULL and there
87      * is no way to return an error indication.  Avoid using this!
88      *)
89   | RConstOptString of string
90
91     (* "RString" is a returned string.  It must NOT be NULL, since
92      * a NULL return indicates an error.  The caller frees this.
93      *)
94   | RString of string
95
96     (* "RStringList" is a list of strings.  No string in the list
97      * can be NULL.  The caller frees the strings and the array.
98      *)
99   | RStringList of string
100
101     (* "RStruct" is a function which returns a single named structure
102      * or an error indication (in C, a struct, and in other languages
103      * with varying representations, but usually very efficient).  See
104      * after the function list below for the structures.
105      *)
106   | RStruct of string * string          (* name of retval, name of struct *)
107
108     (* "RStructList" is a function which returns either a list/array
109      * of structures (could be zero-length), or an error indication.
110      *)
111   | RStructList of string * string      (* name of retval, name of struct *)
112
113     (* Key-value pairs of untyped strings.  Turns into a hashtable or
114      * dictionary in languages which support it.  DON'T use this as a
115      * general "bucket" for results.  Prefer a stronger typed return
116      * value if one is available, or write a custom struct.  Don't use
117      * this if the list could potentially be very long, since it is
118      * inefficient.  Keys should be unique.  NULLs are not permitted.
119      *)
120   | RHashtable of string
121
122     (* "RBufferOut" is handled almost exactly like RString, but
123      * it allows the string to contain arbitrary 8 bit data including
124      * ASCII NUL.  In the C API this causes an implicit extra parameter
125      * to be added of type <size_t *size_r>.  The extra parameter
126      * returns the actual size of the return buffer in bytes.
127      *
128      * Other programming languages support strings with arbitrary 8 bit
129      * data.
130      *
131      * At the RPC layer we have to use the opaque<> type instead of
132      * string<>.  Returned data is still limited to the max message
133      * size (ie. ~ 2 MB).
134      *)
135   | RBufferOut of string
136
137 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
138
139     (* Note in future we should allow a "variable args" parameter as
140      * the final parameter, to allow commands like
141      *   chmod mode file [file(s)...]
142      * This is not implemented yet, but many commands (such as chmod)
143      * are currently defined with the argument order keeping this future
144      * possibility in mind.
145      *)
146 and argt =
147   | String of string    (* const char *name, cannot be NULL *)
148   | Device of string    (* /dev device name, cannot be NULL *)
149   | Pathname of string  (* file name, cannot be NULL *)
150   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
151   | OptString of string (* const char *name, may be NULL *)
152   | StringList of string(* list of strings (each string cannot be NULL) *)
153   | DeviceList of string(* list of Device names (each cannot be NULL) *)
154   | Bool of string      (* boolean *)
155   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
156   | Int64 of string     (* any 64 bit int *)
157     (* These are treated as filenames (simple string parameters) in
158      * the C API and bindings.  But in the RPC protocol, we transfer
159      * the actual file content up to or down from the daemon.
160      * FileIn: local machine -> daemon (in request)
161      * FileOut: daemon -> local machine (in reply)
162      * In guestfish (only), the special name "-" means read from
163      * stdin or write to stdout.
164      *)
165   | FileIn of string
166   | FileOut of string
167 (* Not implemented:
168     (* Opaque buffer which can contain arbitrary 8 bit data.
169      * In the C API, this is expressed as <char *, int> pair.
170      * Most other languages have a string type which can contain
171      * ASCII NUL.  We use whatever type is appropriate for each
172      * language.
173      * Buffers are limited by the total message size.  To transfer
174      * large blocks of data, use FileIn/FileOut parameters instead.
175      * To return an arbitrary buffer, use RBufferOut.
176      *)
177   | BufferIn of string
178 *)
179
180 type flags =
181   | ProtocolLimitWarning  (* display warning about protocol size limits *)
182   | DangerWillRobinson    (* flags particularly dangerous commands *)
183   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
184   | FishAction of string  (* call this function in guestfish *)
185   | NotInFish             (* do not export via guestfish *)
186   | NotInDocs             (* do not add this function to documentation *)
187   | DeprecatedBy of string (* function is deprecated, use .. instead *)
188   | Optional of string    (* function is part of an optional group *)
189
190 (* You can supply zero or as many tests as you want per API call.
191  *
192  * Note that the test environment has 3 block devices, of size 500MB,
193  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
194  * a fourth ISO block device with some known files on it (/dev/sdd).
195  *
196  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
197  * Number of cylinders was 63 for IDE emulated disks with precisely
198  * the same size.  How exactly this is calculated is a mystery.
199  *
200  * The ISO block device (/dev/sdd) comes from images/test.iso.
201  *
202  * To be able to run the tests in a reasonable amount of time,
203  * the virtual machine and block devices are reused between tests.
204  * So don't try testing kill_subprocess :-x
205  *
206  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
207  *
208  * Don't assume anything about the previous contents of the block
209  * devices.  Use 'Init*' to create some initial scenarios.
210  *
211  * You can add a prerequisite clause to any individual test.  This
212  * is a run-time check, which, if it fails, causes the test to be
213  * skipped.  Useful if testing a command which might not work on
214  * all variations of libguestfs builds.  A test that has prerequisite
215  * of 'Always' is run unconditionally.
216  *
217  * In addition, packagers can skip individual tests by setting the
218  * environment variables:     eg:
219  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
220  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
221  *)
222 type tests = (test_init * test_prereq * test) list
223 and test =
224     (* Run the command sequence and just expect nothing to fail. *)
225   | TestRun of seq
226
227     (* Run the command sequence and expect the output of the final
228      * command to be the string.
229      *)
230   | TestOutput of seq * string
231
232     (* Run the command sequence and expect the output of the final
233      * command to be the list of strings.
234      *)
235   | TestOutputList of seq * string list
236
237     (* Run the command sequence and expect the output of the final
238      * command to be the list of block devices (could be either
239      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
240      * character of each string).
241      *)
242   | TestOutputListOfDevices of seq * string list
243
244     (* Run the command sequence and expect the output of the final
245      * command to be the integer.
246      *)
247   | TestOutputInt of seq * int
248
249     (* Run the command sequence and expect the output of the final
250      * command to be <op> <int>, eg. ">=", "1".
251      *)
252   | TestOutputIntOp of seq * string * int
253
254     (* Run the command sequence and expect the output of the final
255      * command to be a true value (!= 0 or != NULL).
256      *)
257   | TestOutputTrue of seq
258
259     (* Run the command sequence and expect the output of the final
260      * command to be a false value (== 0 or == NULL, but not an error).
261      *)
262   | TestOutputFalse of seq
263
264     (* Run the command sequence and expect the output of the final
265      * command to be a list of the given length (but don't care about
266      * content).
267      *)
268   | TestOutputLength of seq * int
269
270     (* Run the command sequence and expect the output of the final
271      * command to be a buffer (RBufferOut), ie. string + size.
272      *)
273   | TestOutputBuffer of seq * string
274
275     (* Run the command sequence and expect the output of the final
276      * command to be a structure.
277      *)
278   | TestOutputStruct of seq * test_field_compare list
279
280     (* Run the command sequence and expect the final command (only)
281      * to fail.
282      *)
283   | TestLastFail of seq
284
285 and test_field_compare =
286   | CompareWithInt of string * int
287   | CompareWithIntOp of string * string * int
288   | CompareWithString of string * string
289   | CompareFieldsIntEq of string * string
290   | CompareFieldsStrEq of string * string
291
292 (* Test prerequisites. *)
293 and test_prereq =
294     (* Test always runs. *)
295   | Always
296
297     (* Test is currently disabled - eg. it fails, or it tests some
298      * unimplemented feature.
299      *)
300   | Disabled
301
302     (* 'string' is some C code (a function body) that should return
303      * true or false.  The test will run if the code returns true.
304      *)
305   | If of string
306
307     (* As for 'If' but the test runs _unless_ the code returns true. *)
308   | Unless of string
309
310     (* Run the test only if 'string' is available in the daemon. *)
311   | IfAvailable of string
312
313 (* Some initial scenarios for testing. *)
314 and test_init =
315     (* Do nothing, block devices could contain random stuff including
316      * LVM PVs, and some filesystems might be mounted.  This is usually
317      * a bad idea.
318      *)
319   | InitNone
320
321     (* Block devices are empty and no filesystems are mounted. *)
322   | InitEmpty
323
324     (* /dev/sda contains a single partition /dev/sda1, with random
325      * content.  /dev/sdb and /dev/sdc may have random content.
326      * No LVM.
327      *)
328   | InitPartition
329
330     (* /dev/sda contains a single partition /dev/sda1, which is formatted
331      * as ext2, empty [except for lost+found] and mounted on /.
332      * /dev/sdb and /dev/sdc may have random content.
333      * No LVM.
334      *)
335   | InitBasicFS
336
337     (* /dev/sda:
338      *   /dev/sda1 (is a PV):
339      *     /dev/VG/LV (size 8MB):
340      *       formatted as ext2, empty [except for lost+found], mounted on /
341      * /dev/sdb and /dev/sdc may have random content.
342      *)
343   | InitBasicFSonLVM
344
345     (* /dev/sdd (the ISO, see images/ directory in source)
346      * is mounted on /
347      *)
348   | InitISOFS
349
350 (* Sequence of commands for testing. *)
351 and seq = cmd list
352 and cmd = string list
353
354 (* Note about long descriptions: When referring to another
355  * action, use the format C<guestfs_other> (ie. the full name of
356  * the C function).  This will be replaced as appropriate in other
357  * language bindings.
358  *
359  * Apart from that, long descriptions are just perldoc paragraphs.
360  *)
361
362 (* Generate a random UUID (used in tests). *)
363 let uuidgen () =
364   let chan = open_process_in "uuidgen" in
365   let uuid = input_line chan in
366   (match close_process_in chan with
367    | WEXITED 0 -> ()
368    | WEXITED _ ->
369        failwith "uuidgen: process exited with non-zero status"
370    | WSIGNALED _ | WSTOPPED _ ->
371        failwith "uuidgen: process signalled or stopped by signal"
372   );
373   uuid
374
375 (* These test functions are used in the language binding tests. *)
376
377 let test_all_args = [
378   String "str";
379   OptString "optstr";
380   StringList "strlist";
381   Bool "b";
382   Int "integer";
383   Int64 "integer64";
384   FileIn "filein";
385   FileOut "fileout";
386 ]
387
388 let test_all_rets = [
389   (* except for RErr, which is tested thoroughly elsewhere *)
390   "test0rint",         RInt "valout";
391   "test0rint64",       RInt64 "valout";
392   "test0rbool",        RBool "valout";
393   "test0rconststring", RConstString "valout";
394   "test0rconstoptstring", RConstOptString "valout";
395   "test0rstring",      RString "valout";
396   "test0rstringlist",  RStringList "valout";
397   "test0rstruct",      RStruct ("valout", "lvm_pv");
398   "test0rstructlist",  RStructList ("valout", "lvm_pv");
399   "test0rhashtable",   RHashtable "valout";
400 ]
401
402 let test_functions = [
403   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
404    [],
405    "internal test function - do not use",
406    "\
407 This is an internal test function which is used to test whether
408 the automatically generated bindings can handle every possible
409 parameter type correctly.
410
411 It echos the contents of each parameter to stdout.
412
413 You probably don't want to call this function.");
414 ] @ List.flatten (
415   List.map (
416     fun (name, ret) ->
417       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
418         [],
419         "internal test function - do not use",
420         "\
421 This is an internal test function which is used to test whether
422 the automatically generated bindings can handle every possible
423 return type correctly.
424
425 It converts string C<val> to the return type.
426
427 You probably don't want to call this function.");
428        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
429         [],
430         "internal test function - do not use",
431         "\
432 This is an internal test function which is used to test whether
433 the automatically generated bindings can handle every possible
434 return type correctly.
435
436 This function always returns an error.
437
438 You probably don't want to call this function.")]
439   ) test_all_rets
440 )
441
442 (* non_daemon_functions are any functions which don't get processed
443  * in the daemon, eg. functions for setting and getting local
444  * configuration values.
445  *)
446
447 let non_daemon_functions = test_functions @ [
448   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
449    [],
450    "launch the qemu subprocess",
451    "\
452 Internally libguestfs is implemented by running a virtual machine
453 using L<qemu(1)>.
454
455 You should call this after configuring the handle
456 (eg. adding drives) but before performing any actions.");
457
458   ("wait_ready", (RErr, []), -1, [NotInFish],
459    [],
460    "wait until the qemu subprocess launches (no op)",
461    "\
462 This function is a no op.
463
464 In versions of the API E<lt> 1.0.71 you had to call this function
465 just after calling C<guestfs_launch> to wait for the launch
466 to complete.  However this is no longer necessary because
467 C<guestfs_launch> now does the waiting.
468
469 If you see any calls to this function in code then you can just
470 remove them, unless you want to retain compatibility with older
471 versions of the API.");
472
473   ("kill_subprocess", (RErr, []), -1, [],
474    [],
475    "kill the qemu subprocess",
476    "\
477 This kills the qemu subprocess.  You should never need to call this.");
478
479   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
480    [],
481    "add an image to examine or modify",
482    "\
483 This function adds a virtual machine disk image C<filename> to the
484 guest.  The first time you call this function, the disk appears as IDE
485 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
486 so on.
487
488 You don't necessarily need to be root when using libguestfs.  However
489 you obviously do need sufficient permissions to access the filename
490 for whatever operations you want to perform (ie. read access if you
491 just want to read the image or write access if you want to modify the
492 image).
493
494 This is equivalent to the qemu parameter
495 C<-drive file=filename,cache=off,if=...>.
496
497 C<cache=off> is omitted in cases where it is not supported by
498 the underlying filesystem.
499
500 C<if=...> is set at compile time by the configuration option
501 C<./configure --with-drive-if=...>.  In the rare case where you
502 might need to change this at run time, use C<guestfs_add_drive_with_if>
503 or C<guestfs_add_drive_ro_with_if>.
504
505 Note that this call checks for the existence of C<filename>.  This
506 stops you from specifying other types of drive which are supported
507 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
508 the general C<guestfs_config> call instead.");
509
510   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
511    [],
512    "add a CD-ROM disk image to examine",
513    "\
514 This function adds a virtual CD-ROM disk image to the guest.
515
516 This is equivalent to the qemu parameter C<-cdrom filename>.
517
518 Notes:
519
520 =over 4
521
522 =item *
523
524 This call checks for the existence of C<filename>.  This
525 stops you from specifying other types of drive which are supported
526 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
527 the general C<guestfs_config> call instead.
528
529 =item *
530
531 If you just want to add an ISO file (often you use this as an
532 efficient way to transfer large files into the guest), then you
533 should probably use C<guestfs_add_drive_ro> instead.
534
535 =back");
536
537   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
538    [],
539    "add a drive in snapshot mode (read-only)",
540    "\
541 This adds a drive in snapshot mode, making it effectively
542 read-only.
543
544 Note that writes to the device are allowed, and will be seen for
545 the duration of the guestfs handle, but they are written
546 to a temporary file which is discarded as soon as the guestfs
547 handle is closed.  We don't currently have any method to enable
548 changes to be committed, although qemu can support this.
549
550 This is equivalent to the qemu parameter
551 C<-drive file=filename,snapshot=on,readonly=on,if=...>.
552
553 C<if=...> is set at compile time by the configuration option
554 C<./configure --with-drive-if=...>.  In the rare case where you
555 might need to change this at run time, use C<guestfs_add_drive_with_if>
556 or C<guestfs_add_drive_ro_with_if>.
557
558 C<readonly=on> is only added where qemu supports this option.
559
560 Note that this call checks for the existence of C<filename>.  This
561 stops you from specifying other types of drive which are supported
562 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
563 the general C<guestfs_config> call instead.");
564
565   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
566    [],
567    "add qemu parameters",
568    "\
569 This can be used to add arbitrary qemu command line parameters
570 of the form C<-param value>.  Actually it's not quite arbitrary - we
571 prevent you from setting some parameters which would interfere with
572 parameters that we use.
573
574 The first character of C<param> string must be a C<-> (dash).
575
576 C<value> can be NULL.");
577
578   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
579    [],
580    "set the qemu binary",
581    "\
582 Set the qemu binary that we will use.
583
584 The default is chosen when the library was compiled by the
585 configure script.
586
587 You can also override this by setting the C<LIBGUESTFS_QEMU>
588 environment variable.
589
590 Setting C<qemu> to C<NULL> restores the default qemu binary.
591
592 Note that you should call this function as early as possible
593 after creating the handle.  This is because some pre-launch
594 operations depend on testing qemu features (by running C<qemu -help>).
595 If the qemu binary changes, we don't retest features, and
596 so you might see inconsistent results.  Using the environment
597 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
598 the qemu binary at the same time as the handle is created.");
599
600   ("get_qemu", (RConstString "qemu", []), -1, [],
601    [InitNone, Always, TestRun (
602       [["get_qemu"]])],
603    "get the qemu binary",
604    "\
605 Return the current qemu binary.
606
607 This is always non-NULL.  If it wasn't set already, then this will
608 return the default qemu binary name.");
609
610   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
611    [],
612    "set the search path",
613    "\
614 Set the path that libguestfs searches for kernel and initrd.img.
615
616 The default is C<$libdir/guestfs> unless overridden by setting
617 C<LIBGUESTFS_PATH> environment variable.
618
619 Setting C<path> to C<NULL> restores the default path.");
620
621   ("get_path", (RConstString "path", []), -1, [],
622    [InitNone, Always, TestRun (
623       [["get_path"]])],
624    "get the search path",
625    "\
626 Return the current search path.
627
628 This is always non-NULL.  If it wasn't set already, then this will
629 return the default path.");
630
631   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
632    [],
633    "add options to kernel command line",
634    "\
635 This function is used to add additional options to the
636 guest kernel command line.
637
638 The default is C<NULL> unless overridden by setting
639 C<LIBGUESTFS_APPEND> environment variable.
640
641 Setting C<append> to C<NULL> means I<no> additional options
642 are passed (libguestfs always adds a few of its own).");
643
644   ("get_append", (RConstOptString "append", []), -1, [],
645    (* This cannot be tested with the current framework.  The
646     * function can return NULL in normal operations, which the
647     * test framework interprets as an error.
648     *)
649    [],
650    "get the additional kernel options",
651    "\
652 Return the additional kernel options which are added to the
653 guest kernel command line.
654
655 If C<NULL> then no options are added.");
656
657   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
658    [],
659    "set autosync mode",
660    "\
661 If C<autosync> is true, this enables autosync.  Libguestfs will make a
662 best effort attempt to run C<guestfs_umount_all> followed by
663 C<guestfs_sync> when the handle is closed
664 (also if the program exits without closing handles).
665
666 This is disabled by default (except in guestfish where it is
667 enabled by default).");
668
669   ("get_autosync", (RBool "autosync", []), -1, [],
670    [InitNone, Always, TestRun (
671       [["get_autosync"]])],
672    "get autosync mode",
673    "\
674 Get the autosync flag.");
675
676   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
677    [],
678    "set verbose mode",
679    "\
680 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
681
682 Verbose messages are disabled unless the environment variable
683 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
684
685   ("get_verbose", (RBool "verbose", []), -1, [],
686    [],
687    "get verbose mode",
688    "\
689 This returns the verbose messages flag.");
690
691   ("is_ready", (RBool "ready", []), -1, [],
692    [InitNone, Always, TestOutputTrue (
693       [["is_ready"]])],
694    "is ready to accept commands",
695    "\
696 This returns true iff this handle is ready to accept commands
697 (in the C<READY> state).
698
699 For more information on states, see L<guestfs(3)>.");
700
701   ("is_config", (RBool "config", []), -1, [],
702    [InitNone, Always, TestOutputFalse (
703       [["is_config"]])],
704    "is in configuration state",
705    "\
706 This returns true iff this handle is being configured
707 (in the C<CONFIG> state).
708
709 For more information on states, see L<guestfs(3)>.");
710
711   ("is_launching", (RBool "launching", []), -1, [],
712    [InitNone, Always, TestOutputFalse (
713       [["is_launching"]])],
714    "is launching subprocess",
715    "\
716 This returns true iff this handle is launching the subprocess
717 (in the C<LAUNCHING> state).
718
719 For more information on states, see L<guestfs(3)>.");
720
721   ("is_busy", (RBool "busy", []), -1, [],
722    [InitNone, Always, TestOutputFalse (
723       [["is_busy"]])],
724    "is busy processing a command",
725    "\
726 This returns true iff this handle is busy processing a command
727 (in the C<BUSY> state).
728
729 For more information on states, see L<guestfs(3)>.");
730
731   ("get_state", (RInt "state", []), -1, [],
732    [],
733    "get the current state",
734    "\
735 This returns the current state as an opaque integer.  This is
736 only useful for printing debug and internal error messages.
737
738 For more information on states, see L<guestfs(3)>.");
739
740   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
741    [InitNone, Always, TestOutputInt (
742       [["set_memsize"; "500"];
743        ["get_memsize"]], 500)],
744    "set memory allocated to the qemu subprocess",
745    "\
746 This sets the memory size in megabytes allocated to the
747 qemu subprocess.  This only has any effect if called before
748 C<guestfs_launch>.
749
750 You can also change this by setting the environment
751 variable C<LIBGUESTFS_MEMSIZE> before the handle is
752 created.
753
754 For more information on the architecture of libguestfs,
755 see L<guestfs(3)>.");
756
757   ("get_memsize", (RInt "memsize", []), -1, [],
758    [InitNone, Always, TestOutputIntOp (
759       [["get_memsize"]], ">=", 256)],
760    "get memory allocated to the qemu subprocess",
761    "\
762 This gets the memory size in megabytes allocated to the
763 qemu subprocess.
764
765 If C<guestfs_set_memsize> was not called
766 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
767 then this returns the compiled-in default value for memsize.
768
769 For more information on the architecture of libguestfs,
770 see L<guestfs(3)>.");
771
772   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
773    [InitNone, Always, TestOutputIntOp (
774       [["get_pid"]], ">=", 1)],
775    "get PID of qemu subprocess",
776    "\
777 Return the process ID of the qemu subprocess.  If there is no
778 qemu subprocess, then this will return an error.
779
780 This is an internal call used for debugging and testing.");
781
782   ("version", (RStruct ("version", "version"), []), -1, [],
783    [InitNone, Always, TestOutputStruct (
784       [["version"]], [CompareWithInt ("major", 1)])],
785    "get the library version number",
786    "\
787 Return the libguestfs version number that the program is linked
788 against.
789
790 Note that because of dynamic linking this is not necessarily
791 the version of libguestfs that you compiled against.  You can
792 compile the program, and then at runtime dynamically link
793 against a completely different C<libguestfs.so> library.
794
795 This call was added in version C<1.0.58>.  In previous
796 versions of libguestfs there was no way to get the version
797 number.  From C code you can use dynamic linker functions
798 to find out if this symbol exists (if it doesn't, then
799 it's an earlier version).
800
801 The call returns a structure with four elements.  The first
802 three (C<major>, C<minor> and C<release>) are numbers and
803 correspond to the usual version triplet.  The fourth element
804 (C<extra>) is a string and is normally empty, but may be
805 used for distro-specific information.
806
807 To construct the original version string:
808 C<$major.$minor.$release$extra>
809
810 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
811
812 I<Note:> Don't use this call to test for availability
813 of features.  In enterprise distributions we backport
814 features from later versions into earlier versions,
815 making this an unreliable way to test for features.
816 Use C<guestfs_available> instead.");
817
818   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
819    [InitNone, Always, TestOutputTrue (
820       [["set_selinux"; "true"];
821        ["get_selinux"]])],
822    "set SELinux enabled or disabled at appliance boot",
823    "\
824 This sets the selinux flag that is passed to the appliance
825 at boot time.  The default is C<selinux=0> (disabled).
826
827 Note that if SELinux is enabled, it is always in
828 Permissive mode (C<enforcing=0>).
829
830 For more information on the architecture of libguestfs,
831 see L<guestfs(3)>.");
832
833   ("get_selinux", (RBool "selinux", []), -1, [],
834    [],
835    "get SELinux enabled flag",
836    "\
837 This returns the current setting of the selinux flag which
838 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
839
840 For more information on the architecture of libguestfs,
841 see L<guestfs(3)>.");
842
843   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
844    [InitNone, Always, TestOutputFalse (
845       [["set_trace"; "false"];
846        ["get_trace"]])],
847    "enable or disable command traces",
848    "\
849 If the command trace flag is set to 1, then commands are
850 printed on stdout before they are executed in a format
851 which is very similar to the one used by guestfish.  In
852 other words, you can run a program with this enabled, and
853 you will get out a script which you can feed to guestfish
854 to perform the same set of actions.
855
856 If you want to trace C API calls into libguestfs (and
857 other libraries) then possibly a better way is to use
858 the external ltrace(1) command.
859
860 Command traces are disabled unless the environment variable
861 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
862
863   ("get_trace", (RBool "trace", []), -1, [],
864    [],
865    "get command trace enabled flag",
866    "\
867 Return the command trace flag.");
868
869   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
870    [InitNone, Always, TestOutputFalse (
871       [["set_direct"; "false"];
872        ["get_direct"]])],
873    "enable or disable direct appliance mode",
874    "\
875 If the direct appliance mode flag is enabled, then stdin and
876 stdout are passed directly through to the appliance once it
877 is launched.
878
879 One consequence of this is that log messages aren't caught
880 by the library and handled by C<guestfs_set_log_message_callback>,
881 but go straight to stdout.
882
883 You probably don't want to use this unless you know what you
884 are doing.
885
886 The default is disabled.");
887
888   ("get_direct", (RBool "direct", []), -1, [],
889    [],
890    "get direct appliance mode flag",
891    "\
892 Return the direct appliance mode flag.");
893
894   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
895    [InitNone, Always, TestOutputTrue (
896       [["set_recovery_proc"; "true"];
897        ["get_recovery_proc"]])],
898    "enable or disable the recovery process",
899    "\
900 If this is called with the parameter C<false> then
901 C<guestfs_launch> does not create a recovery process.  The
902 purpose of the recovery process is to stop runaway qemu
903 processes in the case where the main program aborts abruptly.
904
905 This only has any effect if called before C<guestfs_launch>,
906 and the default is true.
907
908 About the only time when you would want to disable this is
909 if the main process will fork itself into the background
910 (\"daemonize\" itself).  In this case the recovery process
911 thinks that the main program has disappeared and so kills
912 qemu, which is not very helpful.");
913
914   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
915    [],
916    "get recovery process enabled flag",
917    "\
918 Return the recovery process enabled flag.");
919
920   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
921    [],
922    "add a drive specifying the QEMU block emulation to use",
923    "\
924 This is the same as C<guestfs_add_drive> but it allows you
925 to specify the QEMU interface emulation to use at run time.");
926
927   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
928    [],
929    "add a drive read-only specifying the QEMU block emulation to use",
930    "\
931 This is the same as C<guestfs_add_drive_ro> but it allows you
932 to specify the QEMU interface emulation to use at run time.");
933
934 ]
935
936 (* daemon_functions are any functions which cause some action
937  * to take place in the daemon.
938  *)
939
940 let daemon_functions = [
941   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
942    [InitEmpty, Always, TestOutput (
943       [["part_disk"; "/dev/sda"; "mbr"];
944        ["mkfs"; "ext2"; "/dev/sda1"];
945        ["mount"; "/dev/sda1"; "/"];
946        ["write_file"; "/new"; "new file contents"; "0"];
947        ["cat"; "/new"]], "new file contents")],
948    "mount a guest disk at a position in the filesystem",
949    "\
950 Mount a guest disk at a position in the filesystem.  Block devices
951 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
952 the guest.  If those block devices contain partitions, they will have
953 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
954 names can be used.
955
956 The rules are the same as for L<mount(2)>:  A filesystem must
957 first be mounted on C</> before others can be mounted.  Other
958 filesystems can only be mounted on directories which already
959 exist.
960
961 The mounted filesystem is writable, if we have sufficient permissions
962 on the underlying device.
963
964 B<Important note:>
965 When you use this call, the filesystem options C<sync> and C<noatime>
966 are set implicitly.  This was originally done because we thought it
967 would improve reliability, but it turns out that I<-o sync> has a
968 very large negative performance impact and negligible effect on
969 reliability.  Therefore we recommend that you avoid using
970 C<guestfs_mount> in any code that needs performance, and instead
971 use C<guestfs_mount_options> (use an empty string for the first
972 parameter if you don't want any options).");
973
974   ("sync", (RErr, []), 2, [],
975    [ InitEmpty, Always, TestRun [["sync"]]],
976    "sync disks, writes are flushed through to the disk image",
977    "\
978 This syncs the disk, so that any writes are flushed through to the
979 underlying disk image.
980
981 You should always call this if you have modified a disk image, before
982 closing the handle.");
983
984   ("touch", (RErr, [Pathname "path"]), 3, [],
985    [InitBasicFS, Always, TestOutputTrue (
986       [["touch"; "/new"];
987        ["exists"; "/new"]])],
988    "update file timestamps or create a new file",
989    "\
990 Touch acts like the L<touch(1)> command.  It can be used to
991 update the timestamps on a file, or, if the file does not exist,
992 to create a new zero-length file.");
993
994   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
995    [InitISOFS, Always, TestOutput (
996       [["cat"; "/known-2"]], "abcdef\n")],
997    "list the contents of a file",
998    "\
999 Return the contents of the file named C<path>.
1000
1001 Note that this function cannot correctly handle binary files
1002 (specifically, files containing C<\\0> character which is treated
1003 as end of string).  For those you need to use the C<guestfs_read_file>
1004 or C<guestfs_download> functions which have a more complex interface.");
1005
1006   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1007    [], (* XXX Tricky to test because it depends on the exact format
1008         * of the 'ls -l' command, which changes between F10 and F11.
1009         *)
1010    "list the files in a directory (long format)",
1011    "\
1012 List the files in C<directory> (relative to the root directory,
1013 there is no cwd) in the format of 'ls -la'.
1014
1015 This command is mostly useful for interactive sessions.  It
1016 is I<not> intended that you try to parse the output string.");
1017
1018   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1019    [InitBasicFS, Always, TestOutputList (
1020       [["touch"; "/new"];
1021        ["touch"; "/newer"];
1022        ["touch"; "/newest"];
1023        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1024    "list the files in a directory",
1025    "\
1026 List the files in C<directory> (relative to the root directory,
1027 there is no cwd).  The '.' and '..' entries are not returned, but
1028 hidden files are shown.
1029
1030 This command is mostly useful for interactive sessions.  Programs
1031 should probably use C<guestfs_readdir> instead.");
1032
1033   ("list_devices", (RStringList "devices", []), 7, [],
1034    [InitEmpty, Always, TestOutputListOfDevices (
1035       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1036    "list the block devices",
1037    "\
1038 List all the block devices.
1039
1040 The full block device names are returned, eg. C</dev/sda>");
1041
1042   ("list_partitions", (RStringList "partitions", []), 8, [],
1043    [InitBasicFS, Always, TestOutputListOfDevices (
1044       [["list_partitions"]], ["/dev/sda1"]);
1045     InitEmpty, Always, TestOutputListOfDevices (
1046       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1047        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1048    "list the partitions",
1049    "\
1050 List all the partitions detected on all block devices.
1051
1052 The full partition device names are returned, eg. C</dev/sda1>
1053
1054 This does not return logical volumes.  For that you will need to
1055 call C<guestfs_lvs>.");
1056
1057   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1058    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1059       [["pvs"]], ["/dev/sda1"]);
1060     InitEmpty, Always, TestOutputListOfDevices (
1061       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1062        ["pvcreate"; "/dev/sda1"];
1063        ["pvcreate"; "/dev/sda2"];
1064        ["pvcreate"; "/dev/sda3"];
1065        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1066    "list the LVM physical volumes (PVs)",
1067    "\
1068 List all the physical volumes detected.  This is the equivalent
1069 of the L<pvs(8)> command.
1070
1071 This returns a list of just the device names that contain
1072 PVs (eg. C</dev/sda2>).
1073
1074 See also C<guestfs_pvs_full>.");
1075
1076   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1077    [InitBasicFSonLVM, Always, TestOutputList (
1078       [["vgs"]], ["VG"]);
1079     InitEmpty, Always, TestOutputList (
1080       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1081        ["pvcreate"; "/dev/sda1"];
1082        ["pvcreate"; "/dev/sda2"];
1083        ["pvcreate"; "/dev/sda3"];
1084        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1085        ["vgcreate"; "VG2"; "/dev/sda3"];
1086        ["vgs"]], ["VG1"; "VG2"])],
1087    "list the LVM volume groups (VGs)",
1088    "\
1089 List all the volumes groups detected.  This is the equivalent
1090 of the L<vgs(8)> command.
1091
1092 This returns a list of just the volume group names that were
1093 detected (eg. C<VolGroup00>).
1094
1095 See also C<guestfs_vgs_full>.");
1096
1097   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1098    [InitBasicFSonLVM, Always, TestOutputList (
1099       [["lvs"]], ["/dev/VG/LV"]);
1100     InitEmpty, Always, TestOutputList (
1101       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1102        ["pvcreate"; "/dev/sda1"];
1103        ["pvcreate"; "/dev/sda2"];
1104        ["pvcreate"; "/dev/sda3"];
1105        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1106        ["vgcreate"; "VG2"; "/dev/sda3"];
1107        ["lvcreate"; "LV1"; "VG1"; "50"];
1108        ["lvcreate"; "LV2"; "VG1"; "50"];
1109        ["lvcreate"; "LV3"; "VG2"; "50"];
1110        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1111    "list the LVM logical volumes (LVs)",
1112    "\
1113 List all the logical volumes detected.  This is the equivalent
1114 of the L<lvs(8)> command.
1115
1116 This returns a list of the logical volume device names
1117 (eg. C</dev/VolGroup00/LogVol00>).
1118
1119 See also C<guestfs_lvs_full>.");
1120
1121   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1122    [], (* XXX how to test? *)
1123    "list the LVM physical volumes (PVs)",
1124    "\
1125 List all the physical volumes detected.  This is the equivalent
1126 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1127
1128   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1129    [], (* XXX how to test? *)
1130    "list the LVM volume groups (VGs)",
1131    "\
1132 List all the volumes groups detected.  This is the equivalent
1133 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1134
1135   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1136    [], (* XXX how to test? *)
1137    "list the LVM logical volumes (LVs)",
1138    "\
1139 List all the logical volumes detected.  This is the equivalent
1140 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1141
1142   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1143    [InitISOFS, Always, TestOutputList (
1144       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1145     InitISOFS, Always, TestOutputList (
1146       [["read_lines"; "/empty"]], [])],
1147    "read file as lines",
1148    "\
1149 Return the contents of the file named C<path>.
1150
1151 The file contents are returned as a list of lines.  Trailing
1152 C<LF> and C<CRLF> character sequences are I<not> returned.
1153
1154 Note that this function cannot correctly handle binary files
1155 (specifically, files containing C<\\0> character which is treated
1156 as end of line).  For those you need to use the C<guestfs_read_file>
1157 function which has a more complex interface.");
1158
1159   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1160    [], (* XXX Augeas code needs tests. *)
1161    "create a new Augeas handle",
1162    "\
1163 Create a new Augeas handle for editing configuration files.
1164 If there was any previous Augeas handle associated with this
1165 guestfs session, then it is closed.
1166
1167 You must call this before using any other C<guestfs_aug_*>
1168 commands.
1169
1170 C<root> is the filesystem root.  C<root> must not be NULL,
1171 use C</> instead.
1172
1173 The flags are the same as the flags defined in
1174 E<lt>augeas.hE<gt>, the logical I<or> of the following
1175 integers:
1176
1177 =over 4
1178
1179 =item C<AUG_SAVE_BACKUP> = 1
1180
1181 Keep the original file with a C<.augsave> extension.
1182
1183 =item C<AUG_SAVE_NEWFILE> = 2
1184
1185 Save changes into a file with extension C<.augnew>, and
1186 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1187
1188 =item C<AUG_TYPE_CHECK> = 4
1189
1190 Typecheck lenses (can be expensive).
1191
1192 =item C<AUG_NO_STDINC> = 8
1193
1194 Do not use standard load path for modules.
1195
1196 =item C<AUG_SAVE_NOOP> = 16
1197
1198 Make save a no-op, just record what would have been changed.
1199
1200 =item C<AUG_NO_LOAD> = 32
1201
1202 Do not load the tree in C<guestfs_aug_init>.
1203
1204 =back
1205
1206 To close the handle, you can call C<guestfs_aug_close>.
1207
1208 To find out more about Augeas, see L<http://augeas.net/>.");
1209
1210   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1211    [], (* XXX Augeas code needs tests. *)
1212    "close the current Augeas handle",
1213    "\
1214 Close the current Augeas handle and free up any resources
1215 used by it.  After calling this, you have to call
1216 C<guestfs_aug_init> again before you can use any other
1217 Augeas functions.");
1218
1219   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1220    [], (* XXX Augeas code needs tests. *)
1221    "define an Augeas variable",
1222    "\
1223 Defines an Augeas variable C<name> whose value is the result
1224 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1225 undefined.
1226
1227 On success this returns the number of nodes in C<expr>, or
1228 C<0> if C<expr> evaluates to something which is not a nodeset.");
1229
1230   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1231    [], (* XXX Augeas code needs tests. *)
1232    "define an Augeas node",
1233    "\
1234 Defines a variable C<name> whose value is the result of
1235 evaluating C<expr>.
1236
1237 If C<expr> evaluates to an empty nodeset, a node is created,
1238 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1239 C<name> will be the nodeset containing that single node.
1240
1241 On success this returns a pair containing the
1242 number of nodes in the nodeset, and a boolean flag
1243 if a node was created.");
1244
1245   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1246    [], (* XXX Augeas code needs tests. *)
1247    "look up the value of an Augeas path",
1248    "\
1249 Look up the value associated with C<path>.  If C<path>
1250 matches exactly one node, the C<value> is returned.");
1251
1252   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1253    [], (* XXX Augeas code needs tests. *)
1254    "set Augeas path to value",
1255    "\
1256 Set the value associated with C<path> to C<value>.");
1257
1258   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1259    [], (* XXX Augeas code needs tests. *)
1260    "insert a sibling Augeas node",
1261    "\
1262 Create a new sibling C<label> for C<path>, inserting it into
1263 the tree before or after C<path> (depending on the boolean
1264 flag C<before>).
1265
1266 C<path> must match exactly one existing node in the tree, and
1267 C<label> must be a label, ie. not contain C</>, C<*> or end
1268 with a bracketed index C<[N]>.");
1269
1270   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1271    [], (* XXX Augeas code needs tests. *)
1272    "remove an Augeas path",
1273    "\
1274 Remove C<path> and all of its children.
1275
1276 On success this returns the number of entries which were removed.");
1277
1278   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1279    [], (* XXX Augeas code needs tests. *)
1280    "move Augeas node",
1281    "\
1282 Move the node C<src> to C<dest>.  C<src> must match exactly
1283 one node.  C<dest> is overwritten if it exists.");
1284
1285   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1286    [], (* XXX Augeas code needs tests. *)
1287    "return Augeas nodes which match augpath",
1288    "\
1289 Returns a list of paths which match the path expression C<path>.
1290 The returned paths are sufficiently qualified so that they match
1291 exactly one node in the current tree.");
1292
1293   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1294    [], (* XXX Augeas code needs tests. *)
1295    "write all pending Augeas changes to disk",
1296    "\
1297 This writes all pending changes to disk.
1298
1299 The flags which were passed to C<guestfs_aug_init> affect exactly
1300 how files are saved.");
1301
1302   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1303    [], (* XXX Augeas code needs tests. *)
1304    "load files into the tree",
1305    "\
1306 Load files into the tree.
1307
1308 See C<aug_load> in the Augeas documentation for the full gory
1309 details.");
1310
1311   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1312    [], (* XXX Augeas code needs tests. *)
1313    "list Augeas nodes under augpath",
1314    "\
1315 This is just a shortcut for listing C<guestfs_aug_match>
1316 C<path/*> and sorting the resulting nodes into alphabetical order.");
1317
1318   ("rm", (RErr, [Pathname "path"]), 29, [],
1319    [InitBasicFS, Always, TestRun
1320       [["touch"; "/new"];
1321        ["rm"; "/new"]];
1322     InitBasicFS, Always, TestLastFail
1323       [["rm"; "/new"]];
1324     InitBasicFS, Always, TestLastFail
1325       [["mkdir"; "/new"];
1326        ["rm"; "/new"]]],
1327    "remove a file",
1328    "\
1329 Remove the single file C<path>.");
1330
1331   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1332    [InitBasicFS, Always, TestRun
1333       [["mkdir"; "/new"];
1334        ["rmdir"; "/new"]];
1335     InitBasicFS, Always, TestLastFail
1336       [["rmdir"; "/new"]];
1337     InitBasicFS, Always, TestLastFail
1338       [["touch"; "/new"];
1339        ["rmdir"; "/new"]]],
1340    "remove a directory",
1341    "\
1342 Remove the single directory C<path>.");
1343
1344   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1345    [InitBasicFS, Always, TestOutputFalse
1346       [["mkdir"; "/new"];
1347        ["mkdir"; "/new/foo"];
1348        ["touch"; "/new/foo/bar"];
1349        ["rm_rf"; "/new"];
1350        ["exists"; "/new"]]],
1351    "remove a file or directory recursively",
1352    "\
1353 Remove the file or directory C<path>, recursively removing the
1354 contents if its a directory.  This is like the C<rm -rf> shell
1355 command.");
1356
1357   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1358    [InitBasicFS, Always, TestOutputTrue
1359       [["mkdir"; "/new"];
1360        ["is_dir"; "/new"]];
1361     InitBasicFS, Always, TestLastFail
1362       [["mkdir"; "/new/foo/bar"]]],
1363    "create a directory",
1364    "\
1365 Create a directory named C<path>.");
1366
1367   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1368    [InitBasicFS, Always, TestOutputTrue
1369       [["mkdir_p"; "/new/foo/bar"];
1370        ["is_dir"; "/new/foo/bar"]];
1371     InitBasicFS, Always, TestOutputTrue
1372       [["mkdir_p"; "/new/foo/bar"];
1373        ["is_dir"; "/new/foo"]];
1374     InitBasicFS, Always, TestOutputTrue
1375       [["mkdir_p"; "/new/foo/bar"];
1376        ["is_dir"; "/new"]];
1377     (* Regression tests for RHBZ#503133: *)
1378     InitBasicFS, Always, TestRun
1379       [["mkdir"; "/new"];
1380        ["mkdir_p"; "/new"]];
1381     InitBasicFS, Always, TestLastFail
1382       [["touch"; "/new"];
1383        ["mkdir_p"; "/new"]]],
1384    "create a directory and parents",
1385    "\
1386 Create a directory named C<path>, creating any parent directories
1387 as necessary.  This is like the C<mkdir -p> shell command.");
1388
1389   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1390    [], (* XXX Need stat command to test *)
1391    "change file mode",
1392    "\
1393 Change the mode (permissions) of C<path> to C<mode>.  Only
1394 numeric modes are supported.
1395
1396 I<Note>: When using this command from guestfish, C<mode>
1397 by default would be decimal, unless you prefix it with
1398 C<0> to get octal, ie. use C<0700> not C<700>.
1399
1400 The mode actually set is affected by the umask.");
1401
1402   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1403    [], (* XXX Need stat command to test *)
1404    "change file owner and group",
1405    "\
1406 Change the file owner to C<owner> and group to C<group>.
1407
1408 Only numeric uid and gid are supported.  If you want to use
1409 names, you will need to locate and parse the password file
1410 yourself (Augeas support makes this relatively easy).");
1411
1412   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1413    [InitISOFS, Always, TestOutputTrue (
1414       [["exists"; "/empty"]]);
1415     InitISOFS, Always, TestOutputTrue (
1416       [["exists"; "/directory"]])],
1417    "test if file or directory exists",
1418    "\
1419 This returns C<true> if and only if there is a file, directory
1420 (or anything) with the given C<path> name.
1421
1422 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1423
1424   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1425    [InitISOFS, Always, TestOutputTrue (
1426       [["is_file"; "/known-1"]]);
1427     InitISOFS, Always, TestOutputFalse (
1428       [["is_file"; "/directory"]])],
1429    "test if file exists",
1430    "\
1431 This returns C<true> if and only if there is a file
1432 with the given C<path> name.  Note that it returns false for
1433 other objects like directories.
1434
1435 See also C<guestfs_stat>.");
1436
1437   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1438    [InitISOFS, Always, TestOutputFalse (
1439       [["is_dir"; "/known-3"]]);
1440     InitISOFS, Always, TestOutputTrue (
1441       [["is_dir"; "/directory"]])],
1442    "test if file exists",
1443    "\
1444 This returns C<true> if and only if there is a directory
1445 with the given C<path> name.  Note that it returns false for
1446 other objects like files.
1447
1448 See also C<guestfs_stat>.");
1449
1450   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1451    [InitEmpty, Always, TestOutputListOfDevices (
1452       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1453        ["pvcreate"; "/dev/sda1"];
1454        ["pvcreate"; "/dev/sda2"];
1455        ["pvcreate"; "/dev/sda3"];
1456        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1457    "create an LVM physical volume",
1458    "\
1459 This creates an LVM physical volume on the named C<device>,
1460 where C<device> should usually be a partition name such
1461 as C</dev/sda1>.");
1462
1463   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1464    [InitEmpty, Always, TestOutputList (
1465       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1466        ["pvcreate"; "/dev/sda1"];
1467        ["pvcreate"; "/dev/sda2"];
1468        ["pvcreate"; "/dev/sda3"];
1469        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1470        ["vgcreate"; "VG2"; "/dev/sda3"];
1471        ["vgs"]], ["VG1"; "VG2"])],
1472    "create an LVM volume group",
1473    "\
1474 This creates an LVM volume group called C<volgroup>
1475 from the non-empty list of physical volumes C<physvols>.");
1476
1477   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1478    [InitEmpty, Always, TestOutputList (
1479       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1480        ["pvcreate"; "/dev/sda1"];
1481        ["pvcreate"; "/dev/sda2"];
1482        ["pvcreate"; "/dev/sda3"];
1483        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1484        ["vgcreate"; "VG2"; "/dev/sda3"];
1485        ["lvcreate"; "LV1"; "VG1"; "50"];
1486        ["lvcreate"; "LV2"; "VG1"; "50"];
1487        ["lvcreate"; "LV3"; "VG2"; "50"];
1488        ["lvcreate"; "LV4"; "VG2"; "50"];
1489        ["lvcreate"; "LV5"; "VG2"; "50"];
1490        ["lvs"]],
1491       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1492        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1493    "create an LVM logical volume",
1494    "\
1495 This creates an LVM logical volume called C<logvol>
1496 on the volume group C<volgroup>, with C<size> megabytes.");
1497
1498   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1499    [InitEmpty, Always, TestOutput (
1500       [["part_disk"; "/dev/sda"; "mbr"];
1501        ["mkfs"; "ext2"; "/dev/sda1"];
1502        ["mount_options"; ""; "/dev/sda1"; "/"];
1503        ["write_file"; "/new"; "new file contents"; "0"];
1504        ["cat"; "/new"]], "new file contents")],
1505    "make a filesystem",
1506    "\
1507 This creates a filesystem on C<device> (usually a partition
1508 or LVM logical volume).  The filesystem type is C<fstype>, for
1509 example C<ext3>.");
1510
1511   ("sfdisk", (RErr, [Device "device";
1512                      Int "cyls"; Int "heads"; Int "sectors";
1513                      StringList "lines"]), 43, [DangerWillRobinson],
1514    [],
1515    "create partitions on a block device",
1516    "\
1517 This is a direct interface to the L<sfdisk(8)> program for creating
1518 partitions on block devices.
1519
1520 C<device> should be a block device, for example C</dev/sda>.
1521
1522 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1523 and sectors on the device, which are passed directly to sfdisk as
1524 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1525 of these, then the corresponding parameter is omitted.  Usually for
1526 'large' disks, you can just pass C<0> for these, but for small
1527 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1528 out the right geometry and you will need to tell it.
1529
1530 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1531 information refer to the L<sfdisk(8)> manpage.
1532
1533 To create a single partition occupying the whole disk, you would
1534 pass C<lines> as a single element list, when the single element being
1535 the string C<,> (comma).
1536
1537 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1538 C<guestfs_part_init>");
1539
1540   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1541    [InitBasicFS, Always, TestOutput (
1542       [["write_file"; "/new"; "new file contents"; "0"];
1543        ["cat"; "/new"]], "new file contents");
1544     InitBasicFS, Always, TestOutput (
1545       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1546        ["cat"; "/new"]], "\nnew file contents\n");
1547     InitBasicFS, Always, TestOutput (
1548       [["write_file"; "/new"; "\n\n"; "0"];
1549        ["cat"; "/new"]], "\n\n");
1550     InitBasicFS, Always, TestOutput (
1551       [["write_file"; "/new"; ""; "0"];
1552        ["cat"; "/new"]], "");
1553     InitBasicFS, Always, TestOutput (
1554       [["write_file"; "/new"; "\n\n\n"; "0"];
1555        ["cat"; "/new"]], "\n\n\n");
1556     InitBasicFS, Always, TestOutput (
1557       [["write_file"; "/new"; "\n"; "0"];
1558        ["cat"; "/new"]], "\n");
1559     (* Regression test for RHBZ#597135. *)
1560     InitBasicFS, Always, TestLastFail
1561       [["write_file"; "/new"; "abc"; "10000"]]],
1562    "create a file",
1563    "\
1564 This call creates a file called C<path>.  The contents of the
1565 file is the string C<content> (which can contain any 8 bit data),
1566 with length C<size>.
1567
1568 As a special case, if C<size> is C<0>
1569 then the length is calculated using C<strlen> (so in this case
1570 the content cannot contain embedded ASCII NULs).
1571
1572 I<NB.> Owing to a bug, writing content containing ASCII NUL
1573 characters does I<not> work, even if the length is specified.
1574 We hope to resolve this bug in a future version.  In the meantime
1575 use C<guestfs_upload>.");
1576
1577   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1578    [InitEmpty, Always, TestOutputListOfDevices (
1579       [["part_disk"; "/dev/sda"; "mbr"];
1580        ["mkfs"; "ext2"; "/dev/sda1"];
1581        ["mount_options"; ""; "/dev/sda1"; "/"];
1582        ["mounts"]], ["/dev/sda1"]);
1583     InitEmpty, Always, TestOutputList (
1584       [["part_disk"; "/dev/sda"; "mbr"];
1585        ["mkfs"; "ext2"; "/dev/sda1"];
1586        ["mount_options"; ""; "/dev/sda1"; "/"];
1587        ["umount"; "/"];
1588        ["mounts"]], [])],
1589    "unmount a filesystem",
1590    "\
1591 This unmounts the given filesystem.  The filesystem may be
1592 specified either by its mountpoint (path) or the device which
1593 contains the filesystem.");
1594
1595   ("mounts", (RStringList "devices", []), 46, [],
1596    [InitBasicFS, Always, TestOutputListOfDevices (
1597       [["mounts"]], ["/dev/sda1"])],
1598    "show mounted filesystems",
1599    "\
1600 This returns the list of currently mounted filesystems.  It returns
1601 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1602
1603 Some internal mounts are not shown.
1604
1605 See also: C<guestfs_mountpoints>");
1606
1607   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1608    [InitBasicFS, Always, TestOutputList (
1609       [["umount_all"];
1610        ["mounts"]], []);
1611     (* check that umount_all can unmount nested mounts correctly: *)
1612     InitEmpty, Always, TestOutputList (
1613       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1614        ["mkfs"; "ext2"; "/dev/sda1"];
1615        ["mkfs"; "ext2"; "/dev/sda2"];
1616        ["mkfs"; "ext2"; "/dev/sda3"];
1617        ["mount_options"; ""; "/dev/sda1"; "/"];
1618        ["mkdir"; "/mp1"];
1619        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1620        ["mkdir"; "/mp1/mp2"];
1621        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1622        ["mkdir"; "/mp1/mp2/mp3"];
1623        ["umount_all"];
1624        ["mounts"]], [])],
1625    "unmount all filesystems",
1626    "\
1627 This unmounts all mounted filesystems.
1628
1629 Some internal mounts are not unmounted by this call.");
1630
1631   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1632    [],
1633    "remove all LVM LVs, VGs and PVs",
1634    "\
1635 This command removes all LVM logical volumes, volume groups
1636 and physical volumes.");
1637
1638   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1639    [InitISOFS, Always, TestOutput (
1640       [["file"; "/empty"]], "empty");
1641     InitISOFS, Always, TestOutput (
1642       [["file"; "/known-1"]], "ASCII text");
1643     InitISOFS, Always, TestLastFail (
1644       [["file"; "/notexists"]])],
1645    "determine file type",
1646    "\
1647 This call uses the standard L<file(1)> command to determine
1648 the type or contents of the file.  This also works on devices,
1649 for example to find out whether a partition contains a filesystem.
1650
1651 This call will also transparently look inside various types
1652 of compressed file.
1653
1654 The exact command which runs is C<file -zbsL path>.  Note in
1655 particular that the filename is not prepended to the output
1656 (the C<-b> option).");
1657
1658   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1659    [InitBasicFS, Always, TestOutput (
1660       [["upload"; "test-command"; "/test-command"];
1661        ["chmod"; "0o755"; "/test-command"];
1662        ["command"; "/test-command 1"]], "Result1");
1663     InitBasicFS, Always, TestOutput (
1664       [["upload"; "test-command"; "/test-command"];
1665        ["chmod"; "0o755"; "/test-command"];
1666        ["command"; "/test-command 2"]], "Result2\n");
1667     InitBasicFS, Always, TestOutput (
1668       [["upload"; "test-command"; "/test-command"];
1669        ["chmod"; "0o755"; "/test-command"];
1670        ["command"; "/test-command 3"]], "\nResult3");
1671     InitBasicFS, Always, TestOutput (
1672       [["upload"; "test-command"; "/test-command"];
1673        ["chmod"; "0o755"; "/test-command"];
1674        ["command"; "/test-command 4"]], "\nResult4\n");
1675     InitBasicFS, Always, TestOutput (
1676       [["upload"; "test-command"; "/test-command"];
1677        ["chmod"; "0o755"; "/test-command"];
1678        ["command"; "/test-command 5"]], "\nResult5\n\n");
1679     InitBasicFS, Always, TestOutput (
1680       [["upload"; "test-command"; "/test-command"];
1681        ["chmod"; "0o755"; "/test-command"];
1682        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1683     InitBasicFS, Always, TestOutput (
1684       [["upload"; "test-command"; "/test-command"];
1685        ["chmod"; "0o755"; "/test-command"];
1686        ["command"; "/test-command 7"]], "");
1687     InitBasicFS, Always, TestOutput (
1688       [["upload"; "test-command"; "/test-command"];
1689        ["chmod"; "0o755"; "/test-command"];
1690        ["command"; "/test-command 8"]], "\n");
1691     InitBasicFS, Always, TestOutput (
1692       [["upload"; "test-command"; "/test-command"];
1693        ["chmod"; "0o755"; "/test-command"];
1694        ["command"; "/test-command 9"]], "\n\n");
1695     InitBasicFS, Always, TestOutput (
1696       [["upload"; "test-command"; "/test-command"];
1697        ["chmod"; "0o755"; "/test-command"];
1698        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1699     InitBasicFS, Always, TestOutput (
1700       [["upload"; "test-command"; "/test-command"];
1701        ["chmod"; "0o755"; "/test-command"];
1702        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1703     InitBasicFS, Always, TestLastFail (
1704       [["upload"; "test-command"; "/test-command"];
1705        ["chmod"; "0o755"; "/test-command"];
1706        ["command"; "/test-command"]])],
1707    "run a command from the guest filesystem",
1708    "\
1709 This call runs a command from the guest filesystem.  The
1710 filesystem must be mounted, and must contain a compatible
1711 operating system (ie. something Linux, with the same
1712 or compatible processor architecture).
1713
1714 The single parameter is an argv-style list of arguments.
1715 The first element is the name of the program to run.
1716 Subsequent elements are parameters.  The list must be
1717 non-empty (ie. must contain a program name).  Note that
1718 the command runs directly, and is I<not> invoked via
1719 the shell (see C<guestfs_sh>).
1720
1721 The return value is anything printed to I<stdout> by
1722 the command.
1723
1724 If the command returns a non-zero exit status, then
1725 this function returns an error message.  The error message
1726 string is the content of I<stderr> from the command.
1727
1728 The C<$PATH> environment variable will contain at least
1729 C</usr/bin> and C</bin>.  If you require a program from
1730 another location, you should provide the full path in the
1731 first parameter.
1732
1733 Shared libraries and data files required by the program
1734 must be available on filesystems which are mounted in the
1735 correct places.  It is the caller's responsibility to ensure
1736 all filesystems that are needed are mounted at the right
1737 locations.");
1738
1739   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1740    [InitBasicFS, Always, TestOutputList (
1741       [["upload"; "test-command"; "/test-command"];
1742        ["chmod"; "0o755"; "/test-command"];
1743        ["command_lines"; "/test-command 1"]], ["Result1"]);
1744     InitBasicFS, Always, TestOutputList (
1745       [["upload"; "test-command"; "/test-command"];
1746        ["chmod"; "0o755"; "/test-command"];
1747        ["command_lines"; "/test-command 2"]], ["Result2"]);
1748     InitBasicFS, Always, TestOutputList (
1749       [["upload"; "test-command"; "/test-command"];
1750        ["chmod"; "0o755"; "/test-command"];
1751        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1752     InitBasicFS, Always, TestOutputList (
1753       [["upload"; "test-command"; "/test-command"];
1754        ["chmod"; "0o755"; "/test-command"];
1755        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1756     InitBasicFS, Always, TestOutputList (
1757       [["upload"; "test-command"; "/test-command"];
1758        ["chmod"; "0o755"; "/test-command"];
1759        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1760     InitBasicFS, Always, TestOutputList (
1761       [["upload"; "test-command"; "/test-command"];
1762        ["chmod"; "0o755"; "/test-command"];
1763        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1764     InitBasicFS, Always, TestOutputList (
1765       [["upload"; "test-command"; "/test-command"];
1766        ["chmod"; "0o755"; "/test-command"];
1767        ["command_lines"; "/test-command 7"]], []);
1768     InitBasicFS, Always, TestOutputList (
1769       [["upload"; "test-command"; "/test-command"];
1770        ["chmod"; "0o755"; "/test-command"];
1771        ["command_lines"; "/test-command 8"]], [""]);
1772     InitBasicFS, Always, TestOutputList (
1773       [["upload"; "test-command"; "/test-command"];
1774        ["chmod"; "0o755"; "/test-command"];
1775        ["command_lines"; "/test-command 9"]], ["";""]);
1776     InitBasicFS, Always, TestOutputList (
1777       [["upload"; "test-command"; "/test-command"];
1778        ["chmod"; "0o755"; "/test-command"];
1779        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1780     InitBasicFS, Always, TestOutputList (
1781       [["upload"; "test-command"; "/test-command"];
1782        ["chmod"; "0o755"; "/test-command"];
1783        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1784    "run a command, returning lines",
1785    "\
1786 This is the same as C<guestfs_command>, but splits the
1787 result into a list of lines.
1788
1789 See also: C<guestfs_sh_lines>");
1790
1791   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1792    [InitISOFS, Always, TestOutputStruct (
1793       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1794    "get file information",
1795    "\
1796 Returns file information for the given C<path>.
1797
1798 This is the same as the C<stat(2)> system call.");
1799
1800   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1801    [InitISOFS, Always, TestOutputStruct (
1802       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1803    "get file information for a symbolic link",
1804    "\
1805 Returns file information for the given C<path>.
1806
1807 This is the same as C<guestfs_stat> except that if C<path>
1808 is a symbolic link, then the link is stat-ed, not the file it
1809 refers to.
1810
1811 This is the same as the C<lstat(2)> system call.");
1812
1813   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1814    [InitISOFS, Always, TestOutputStruct (
1815       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1816    "get file system statistics",
1817    "\
1818 Returns file system statistics for any mounted file system.
1819 C<path> should be a file or directory in the mounted file system
1820 (typically it is the mount point itself, but it doesn't need to be).
1821
1822 This is the same as the C<statvfs(2)> system call.");
1823
1824   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1825    [], (* XXX test *)
1826    "get ext2/ext3/ext4 superblock details",
1827    "\
1828 This returns the contents of the ext2, ext3 or ext4 filesystem
1829 superblock on C<device>.
1830
1831 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1832 manpage for more details.  The list of fields returned isn't
1833 clearly defined, and depends on both the version of C<tune2fs>
1834 that libguestfs was built against, and the filesystem itself.");
1835
1836   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1837    [InitEmpty, Always, TestOutputTrue (
1838       [["blockdev_setro"; "/dev/sda"];
1839        ["blockdev_getro"; "/dev/sda"]])],
1840    "set block device to read-only",
1841    "\
1842 Sets the block device named C<device> to read-only.
1843
1844 This uses the L<blockdev(8)> command.");
1845
1846   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1847    [InitEmpty, Always, TestOutputFalse (
1848       [["blockdev_setrw"; "/dev/sda"];
1849        ["blockdev_getro"; "/dev/sda"]])],
1850    "set block device to read-write",
1851    "\
1852 Sets the block device named C<device> to read-write.
1853
1854 This uses the L<blockdev(8)> command.");
1855
1856   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1857    [InitEmpty, Always, TestOutputTrue (
1858       [["blockdev_setro"; "/dev/sda"];
1859        ["blockdev_getro"; "/dev/sda"]])],
1860    "is block device set to read-only",
1861    "\
1862 Returns a boolean indicating if the block device is read-only
1863 (true if read-only, false if not).
1864
1865 This uses the L<blockdev(8)> command.");
1866
1867   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1868    [InitEmpty, Always, TestOutputInt (
1869       [["blockdev_getss"; "/dev/sda"]], 512)],
1870    "get sectorsize of block device",
1871    "\
1872 This returns the size of sectors on a block device.
1873 Usually 512, but can be larger for modern devices.
1874
1875 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1876 for that).
1877
1878 This uses the L<blockdev(8)> command.");
1879
1880   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1881    [InitEmpty, Always, TestOutputInt (
1882       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1883    "get blocksize of block device",
1884    "\
1885 This returns the block size of a device.
1886
1887 (Note this is different from both I<size in blocks> and
1888 I<filesystem block size>).
1889
1890 This uses the L<blockdev(8)> command.");
1891
1892   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1893    [], (* XXX test *)
1894    "set blocksize of block device",
1895    "\
1896 This sets the block size of a device.
1897
1898 (Note this is different from both I<size in blocks> and
1899 I<filesystem block size>).
1900
1901 This uses the L<blockdev(8)> command.");
1902
1903   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1904    [InitEmpty, Always, TestOutputInt (
1905       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1906    "get total size of device in 512-byte sectors",
1907    "\
1908 This returns the size of the device in units of 512-byte sectors
1909 (even if the sectorsize isn't 512 bytes ... weird).
1910
1911 See also C<guestfs_blockdev_getss> for the real sector size of
1912 the device, and C<guestfs_blockdev_getsize64> for the more
1913 useful I<size in bytes>.
1914
1915 This uses the L<blockdev(8)> command.");
1916
1917   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1918    [InitEmpty, Always, TestOutputInt (
1919       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1920    "get total size of device in bytes",
1921    "\
1922 This returns the size of the device in bytes.
1923
1924 See also C<guestfs_blockdev_getsz>.
1925
1926 This uses the L<blockdev(8)> command.");
1927
1928   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1929    [InitEmpty, Always, TestRun
1930       [["blockdev_flushbufs"; "/dev/sda"]]],
1931    "flush device buffers",
1932    "\
1933 This tells the kernel to flush internal buffers associated
1934 with C<device>.
1935
1936 This uses the L<blockdev(8)> command.");
1937
1938   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1939    [InitEmpty, Always, TestRun
1940       [["blockdev_rereadpt"; "/dev/sda"]]],
1941    "reread partition table",
1942    "\
1943 Reread the partition table on C<device>.
1944
1945 This uses the L<blockdev(8)> command.");
1946
1947   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1948    [InitBasicFS, Always, TestOutput (
1949       (* Pick a file from cwd which isn't likely to change. *)
1950       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1951        ["checksum"; "md5"; "/COPYING.LIB"]],
1952       Digest.to_hex (Digest.file "COPYING.LIB"))],
1953    "upload a file from the local machine",
1954    "\
1955 Upload local file C<filename> to C<remotefilename> on the
1956 filesystem.
1957
1958 C<filename> can also be a named pipe.
1959
1960 See also C<guestfs_download>.");
1961
1962   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1963    [InitBasicFS, Always, TestOutput (
1964       (* Pick a file from cwd which isn't likely to change. *)
1965       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1966        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1967        ["upload"; "testdownload.tmp"; "/upload"];
1968        ["checksum"; "md5"; "/upload"]],
1969       Digest.to_hex (Digest.file "COPYING.LIB"))],
1970    "download a file to the local machine",
1971    "\
1972 Download file C<remotefilename> and save it as C<filename>
1973 on the local machine.
1974
1975 C<filename> can also be a named pipe.
1976
1977 See also C<guestfs_upload>, C<guestfs_cat>.");
1978
1979   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1980    [InitISOFS, Always, TestOutput (
1981       [["checksum"; "crc"; "/known-3"]], "2891671662");
1982     InitISOFS, Always, TestLastFail (
1983       [["checksum"; "crc"; "/notexists"]]);
1984     InitISOFS, Always, TestOutput (
1985       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1986     InitISOFS, Always, TestOutput (
1987       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1988     InitISOFS, Always, TestOutput (
1989       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1990     InitISOFS, Always, TestOutput (
1991       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1992     InitISOFS, Always, TestOutput (
1993       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1994     InitISOFS, Always, TestOutput (
1995       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1996    "compute MD5, SHAx or CRC checksum of file",
1997    "\
1998 This call computes the MD5, SHAx or CRC checksum of the
1999 file named C<path>.
2000
2001 The type of checksum to compute is given by the C<csumtype>
2002 parameter which must have one of the following values:
2003
2004 =over 4
2005
2006 =item C<crc>
2007
2008 Compute the cyclic redundancy check (CRC) specified by POSIX
2009 for the C<cksum> command.
2010
2011 =item C<md5>
2012
2013 Compute the MD5 hash (using the C<md5sum> program).
2014
2015 =item C<sha1>
2016
2017 Compute the SHA1 hash (using the C<sha1sum> program).
2018
2019 =item C<sha224>
2020
2021 Compute the SHA224 hash (using the C<sha224sum> program).
2022
2023 =item C<sha256>
2024
2025 Compute the SHA256 hash (using the C<sha256sum> program).
2026
2027 =item C<sha384>
2028
2029 Compute the SHA384 hash (using the C<sha384sum> program).
2030
2031 =item C<sha512>
2032
2033 Compute the SHA512 hash (using the C<sha512sum> program).
2034
2035 =back
2036
2037 The checksum is returned as a printable string.");
2038
2039   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2040    [InitBasicFS, Always, TestOutput (
2041       [["tar_in"; "../images/helloworld.tar"; "/"];
2042        ["cat"; "/hello"]], "hello\n")],
2043    "unpack tarfile to directory",
2044    "\
2045 This command uploads and unpacks local file C<tarfile> (an
2046 I<uncompressed> tar file) into C<directory>.
2047
2048 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2049
2050   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2051    [],
2052    "pack directory into tarfile",
2053    "\
2054 This command packs the contents of C<directory> and downloads
2055 it to local file C<tarfile>.
2056
2057 To download a compressed tarball, use C<guestfs_tgz_out>.");
2058
2059   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2060    [InitBasicFS, Always, TestOutput (
2061       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2062        ["cat"; "/hello"]], "hello\n")],
2063    "unpack compressed tarball to directory",
2064    "\
2065 This command uploads and unpacks local file C<tarball> (a
2066 I<gzip compressed> tar file) into C<directory>.
2067
2068 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2069
2070   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2071    [],
2072    "pack directory into compressed tarball",
2073    "\
2074 This command packs the contents of C<directory> and downloads
2075 it to local file C<tarball>.
2076
2077 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2078
2079   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2080    [InitBasicFS, Always, TestLastFail (
2081       [["umount"; "/"];
2082        ["mount_ro"; "/dev/sda1"; "/"];
2083        ["touch"; "/new"]]);
2084     InitBasicFS, Always, TestOutput (
2085       [["write_file"; "/new"; "data"; "0"];
2086        ["umount"; "/"];
2087        ["mount_ro"; "/dev/sda1"; "/"];
2088        ["cat"; "/new"]], "data")],
2089    "mount a guest disk, read-only",
2090    "\
2091 This is the same as the C<guestfs_mount> command, but it
2092 mounts the filesystem with the read-only (I<-o ro>) flag.");
2093
2094   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2095    [],
2096    "mount a guest disk with mount options",
2097    "\
2098 This is the same as the C<guestfs_mount> command, but it
2099 allows you to set the mount options as for the
2100 L<mount(8)> I<-o> flag.
2101
2102 If the C<options> parameter is an empty string, then
2103 no options are passed (all options default to whatever
2104 the filesystem uses).");
2105
2106   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2107    [],
2108    "mount a guest disk with mount options and vfstype",
2109    "\
2110 This is the same as the C<guestfs_mount> command, but it
2111 allows you to set both the mount options and the vfstype
2112 as for the L<mount(8)> I<-o> and I<-t> flags.");
2113
2114   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2115    [],
2116    "debugging and internals",
2117    "\
2118 The C<guestfs_debug> command exposes some internals of
2119 C<guestfsd> (the guestfs daemon) that runs inside the
2120 qemu subprocess.
2121
2122 There is no comprehensive help for this command.  You have
2123 to look at the file C<daemon/debug.c> in the libguestfs source
2124 to find out what you can do.");
2125
2126   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2127    [InitEmpty, Always, TestOutputList (
2128       [["part_disk"; "/dev/sda"; "mbr"];
2129        ["pvcreate"; "/dev/sda1"];
2130        ["vgcreate"; "VG"; "/dev/sda1"];
2131        ["lvcreate"; "LV1"; "VG"; "50"];
2132        ["lvcreate"; "LV2"; "VG"; "50"];
2133        ["lvremove"; "/dev/VG/LV1"];
2134        ["lvs"]], ["/dev/VG/LV2"]);
2135     InitEmpty, Always, TestOutputList (
2136       [["part_disk"; "/dev/sda"; "mbr"];
2137        ["pvcreate"; "/dev/sda1"];
2138        ["vgcreate"; "VG"; "/dev/sda1"];
2139        ["lvcreate"; "LV1"; "VG"; "50"];
2140        ["lvcreate"; "LV2"; "VG"; "50"];
2141        ["lvremove"; "/dev/VG"];
2142        ["lvs"]], []);
2143     InitEmpty, Always, TestOutputList (
2144       [["part_disk"; "/dev/sda"; "mbr"];
2145        ["pvcreate"; "/dev/sda1"];
2146        ["vgcreate"; "VG"; "/dev/sda1"];
2147        ["lvcreate"; "LV1"; "VG"; "50"];
2148        ["lvcreate"; "LV2"; "VG"; "50"];
2149        ["lvremove"; "/dev/VG"];
2150        ["vgs"]], ["VG"])],
2151    "remove an LVM logical volume",
2152    "\
2153 Remove an LVM logical volume C<device>, where C<device> is
2154 the path to the LV, such as C</dev/VG/LV>.
2155
2156 You can also remove all LVs in a volume group by specifying
2157 the VG name, C</dev/VG>.");
2158
2159   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2160    [InitEmpty, Always, TestOutputList (
2161       [["part_disk"; "/dev/sda"; "mbr"];
2162        ["pvcreate"; "/dev/sda1"];
2163        ["vgcreate"; "VG"; "/dev/sda1"];
2164        ["lvcreate"; "LV1"; "VG"; "50"];
2165        ["lvcreate"; "LV2"; "VG"; "50"];
2166        ["vgremove"; "VG"];
2167        ["lvs"]], []);
2168     InitEmpty, Always, TestOutputList (
2169       [["part_disk"; "/dev/sda"; "mbr"];
2170        ["pvcreate"; "/dev/sda1"];
2171        ["vgcreate"; "VG"; "/dev/sda1"];
2172        ["lvcreate"; "LV1"; "VG"; "50"];
2173        ["lvcreate"; "LV2"; "VG"; "50"];
2174        ["vgremove"; "VG"];
2175        ["vgs"]], [])],
2176    "remove an LVM volume group",
2177    "\
2178 Remove an LVM volume group C<vgname>, (for example C<VG>).
2179
2180 This also forcibly removes all logical volumes in the volume
2181 group (if any).");
2182
2183   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2184    [InitEmpty, Always, TestOutputListOfDevices (
2185       [["part_disk"; "/dev/sda"; "mbr"];
2186        ["pvcreate"; "/dev/sda1"];
2187        ["vgcreate"; "VG"; "/dev/sda1"];
2188        ["lvcreate"; "LV1"; "VG"; "50"];
2189        ["lvcreate"; "LV2"; "VG"; "50"];
2190        ["vgremove"; "VG"];
2191        ["pvremove"; "/dev/sda1"];
2192        ["lvs"]], []);
2193     InitEmpty, Always, TestOutputListOfDevices (
2194       [["part_disk"; "/dev/sda"; "mbr"];
2195        ["pvcreate"; "/dev/sda1"];
2196        ["vgcreate"; "VG"; "/dev/sda1"];
2197        ["lvcreate"; "LV1"; "VG"; "50"];
2198        ["lvcreate"; "LV2"; "VG"; "50"];
2199        ["vgremove"; "VG"];
2200        ["pvremove"; "/dev/sda1"];
2201        ["vgs"]], []);
2202     InitEmpty, Always, TestOutputListOfDevices (
2203       [["part_disk"; "/dev/sda"; "mbr"];
2204        ["pvcreate"; "/dev/sda1"];
2205        ["vgcreate"; "VG"; "/dev/sda1"];
2206        ["lvcreate"; "LV1"; "VG"; "50"];
2207        ["lvcreate"; "LV2"; "VG"; "50"];
2208        ["vgremove"; "VG"];
2209        ["pvremove"; "/dev/sda1"];
2210        ["pvs"]], [])],
2211    "remove an LVM physical volume",
2212    "\
2213 This wipes a physical volume C<device> so that LVM will no longer
2214 recognise it.
2215
2216 The implementation uses the C<pvremove> command which refuses to
2217 wipe physical volumes that contain any volume groups, so you have
2218 to remove those first.");
2219
2220   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2221    [InitBasicFS, Always, TestOutput (
2222       [["set_e2label"; "/dev/sda1"; "testlabel"];
2223        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2224    "set the ext2/3/4 filesystem label",
2225    "\
2226 This sets the ext2/3/4 filesystem label of the filesystem on
2227 C<device> to C<label>.  Filesystem labels are limited to
2228 16 characters.
2229
2230 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2231 to return the existing label on a filesystem.");
2232
2233   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2234    [],
2235    "get the ext2/3/4 filesystem label",
2236    "\
2237 This returns the ext2/3/4 filesystem label of the filesystem on
2238 C<device>.");
2239
2240   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2241    (let uuid = uuidgen () in
2242     [InitBasicFS, Always, TestOutput (
2243        [["set_e2uuid"; "/dev/sda1"; uuid];
2244         ["get_e2uuid"; "/dev/sda1"]], uuid);
2245      InitBasicFS, Always, TestOutput (
2246        [["set_e2uuid"; "/dev/sda1"; "clear"];
2247         ["get_e2uuid"; "/dev/sda1"]], "");
2248      (* We can't predict what UUIDs will be, so just check the commands run. *)
2249      InitBasicFS, Always, TestRun (
2250        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2251      InitBasicFS, Always, TestRun (
2252        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2253    "set the ext2/3/4 filesystem UUID",
2254    "\
2255 This sets the ext2/3/4 filesystem UUID of the filesystem on
2256 C<device> to C<uuid>.  The format of the UUID and alternatives
2257 such as C<clear>, C<random> and C<time> are described in the
2258 L<tune2fs(8)> manpage.
2259
2260 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2261 to return the existing UUID of a filesystem.");
2262
2263   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2264    [],
2265    "get the ext2/3/4 filesystem UUID",
2266    "\
2267 This returns the ext2/3/4 filesystem UUID of the filesystem on
2268 C<device>.");
2269
2270   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2271    [InitBasicFS, Always, TestOutputInt (
2272       [["umount"; "/dev/sda1"];
2273        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2274     InitBasicFS, Always, TestOutputInt (
2275       [["umount"; "/dev/sda1"];
2276        ["zero"; "/dev/sda1"];
2277        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2278    "run the filesystem checker",
2279    "\
2280 This runs the filesystem checker (fsck) on C<device> which
2281 should have filesystem type C<fstype>.
2282
2283 The returned integer is the status.  See L<fsck(8)> for the
2284 list of status codes from C<fsck>.
2285
2286 Notes:
2287
2288 =over 4
2289
2290 =item *
2291
2292 Multiple status codes can be summed together.
2293
2294 =item *
2295
2296 A non-zero return code can mean \"success\", for example if
2297 errors have been corrected on the filesystem.
2298
2299 =item *
2300
2301 Checking or repairing NTFS volumes is not supported
2302 (by linux-ntfs).
2303
2304 =back
2305
2306 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2307
2308   ("zero", (RErr, [Device "device"]), 85, [],
2309    [InitBasicFS, Always, TestOutput (
2310       [["umount"; "/dev/sda1"];
2311        ["zero"; "/dev/sda1"];
2312        ["file"; "/dev/sda1"]], "data")],
2313    "write zeroes to the device",
2314    "\
2315 This command writes zeroes over the first few blocks of C<device>.
2316
2317 How many blocks are zeroed isn't specified (but it's I<not> enough
2318 to securely wipe the device).  It should be sufficient to remove
2319 any partition tables, filesystem superblocks and so on.
2320
2321 See also: C<guestfs_scrub_device>.");
2322
2323   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2324    (* Test disabled because grub-install incompatible with virtio-blk driver.
2325     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2326     *)
2327    [InitBasicFS, Disabled, TestOutputTrue (
2328       [["grub_install"; "/"; "/dev/sda1"];
2329        ["is_dir"; "/boot"]])],
2330    "install GRUB",
2331    "\
2332 This command installs GRUB (the Grand Unified Bootloader) on
2333 C<device>, with the root directory being C<root>.
2334
2335 Note: If grub-install reports the error
2336 \"No suitable drive was found in the generated device map.\"
2337 it may be that you need to create a C</boot/grub/device.map>
2338 file first that contains the mapping between grub device names
2339 and Linux device names.  It is usually sufficient to create
2340 a file containing:
2341
2342  (hd0) /dev/vda
2343
2344 replacing C</dev/vda> with the name of the installation device.");
2345
2346   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2347    [InitBasicFS, Always, TestOutput (
2348       [["write_file"; "/old"; "file content"; "0"];
2349        ["cp"; "/old"; "/new"];
2350        ["cat"; "/new"]], "file content");
2351     InitBasicFS, Always, TestOutputTrue (
2352       [["write_file"; "/old"; "file content"; "0"];
2353        ["cp"; "/old"; "/new"];
2354        ["is_file"; "/old"]]);
2355     InitBasicFS, Always, TestOutput (
2356       [["write_file"; "/old"; "file content"; "0"];
2357        ["mkdir"; "/dir"];
2358        ["cp"; "/old"; "/dir/new"];
2359        ["cat"; "/dir/new"]], "file content")],
2360    "copy a file",
2361    "\
2362 This copies a file from C<src> to C<dest> where C<dest> is
2363 either a destination filename or destination directory.");
2364
2365   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2366    [InitBasicFS, Always, TestOutput (
2367       [["mkdir"; "/olddir"];
2368        ["mkdir"; "/newdir"];
2369        ["write_file"; "/olddir/file"; "file content"; "0"];
2370        ["cp_a"; "/olddir"; "/newdir"];
2371        ["cat"; "/newdir/olddir/file"]], "file content")],
2372    "copy a file or directory recursively",
2373    "\
2374 This copies a file or directory from C<src> to C<dest>
2375 recursively using the C<cp -a> command.");
2376
2377   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2378    [InitBasicFS, Always, TestOutput (
2379       [["write_file"; "/old"; "file content"; "0"];
2380        ["mv"; "/old"; "/new"];
2381        ["cat"; "/new"]], "file content");
2382     InitBasicFS, Always, TestOutputFalse (
2383       [["write_file"; "/old"; "file content"; "0"];
2384        ["mv"; "/old"; "/new"];
2385        ["is_file"; "/old"]])],
2386    "move a file",
2387    "\
2388 This moves a file from C<src> to C<dest> where C<dest> is
2389 either a destination filename or destination directory.");
2390
2391   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2392    [InitEmpty, Always, TestRun (
2393       [["drop_caches"; "3"]])],
2394    "drop kernel page cache, dentries and inodes",
2395    "\
2396 This instructs the guest kernel to drop its page cache,
2397 and/or dentries and inode caches.  The parameter C<whattodrop>
2398 tells the kernel what precisely to drop, see
2399 L<http://linux-mm.org/Drop_Caches>
2400
2401 Setting C<whattodrop> to 3 should drop everything.
2402
2403 This automatically calls L<sync(2)> before the operation,
2404 so that the maximum guest memory is freed.");
2405
2406   ("dmesg", (RString "kmsgs", []), 91, [],
2407    [InitEmpty, Always, TestRun (
2408       [["dmesg"]])],
2409    "return kernel messages",
2410    "\
2411 This returns the kernel messages (C<dmesg> output) from
2412 the guest kernel.  This is sometimes useful for extended
2413 debugging of problems.
2414
2415 Another way to get the same information is to enable
2416 verbose messages with C<guestfs_set_verbose> or by setting
2417 the environment variable C<LIBGUESTFS_DEBUG=1> before
2418 running the program.");
2419
2420   ("ping_daemon", (RErr, []), 92, [],
2421    [InitEmpty, Always, TestRun (
2422       [["ping_daemon"]])],
2423    "ping the guest daemon",
2424    "\
2425 This is a test probe into the guestfs daemon running inside
2426 the qemu subprocess.  Calling this function checks that the
2427 daemon responds to the ping message, without affecting the daemon
2428 or attached block device(s) in any other way.");
2429
2430   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2431    [InitBasicFS, Always, TestOutputTrue (
2432       [["write_file"; "/file1"; "contents of a file"; "0"];
2433        ["cp"; "/file1"; "/file2"];
2434        ["equal"; "/file1"; "/file2"]]);
2435     InitBasicFS, Always, TestOutputFalse (
2436       [["write_file"; "/file1"; "contents of a file"; "0"];
2437        ["write_file"; "/file2"; "contents of another file"; "0"];
2438        ["equal"; "/file1"; "/file2"]]);
2439     InitBasicFS, Always, TestLastFail (
2440       [["equal"; "/file1"; "/file2"]])],
2441    "test if two files have equal contents",
2442    "\
2443 This compares the two files C<file1> and C<file2> and returns
2444 true if their content is exactly equal, or false otherwise.
2445
2446 The external L<cmp(1)> program is used for the comparison.");
2447
2448   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2449    [InitISOFS, Always, TestOutputList (
2450       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2451     InitISOFS, Always, TestOutputList (
2452       [["strings"; "/empty"]], [])],
2453    "print the printable strings in a file",
2454    "\
2455 This runs the L<strings(1)> command on a file and returns
2456 the list of printable strings found.");
2457
2458   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2459    [InitISOFS, Always, TestOutputList (
2460       [["strings_e"; "b"; "/known-5"]], []);
2461     InitBasicFS, Disabled, TestOutputList (
2462       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2463        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2464    "print the printable strings in a file",
2465    "\
2466 This is like the C<guestfs_strings> command, but allows you to
2467 specify the encoding of strings that are looked for in
2468 the source file C<path>.
2469
2470 Allowed encodings are:
2471
2472 =over 4
2473
2474 =item s
2475
2476 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2477 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2478
2479 =item S
2480
2481 Single 8-bit-byte characters.
2482
2483 =item b
2484
2485 16-bit big endian strings such as those encoded in
2486 UTF-16BE or UCS-2BE.
2487
2488 =item l (lower case letter L)
2489
2490 16-bit little endian such as UTF-16LE and UCS-2LE.
2491 This is useful for examining binaries in Windows guests.
2492
2493 =item B
2494
2495 32-bit big endian such as UCS-4BE.
2496
2497 =item L
2498
2499 32-bit little endian such as UCS-4LE.
2500
2501 =back
2502
2503 The returned strings are transcoded to UTF-8.");
2504
2505   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2506    [InitISOFS, Always, TestOutput (
2507       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2508     (* Test for RHBZ#501888c2 regression which caused large hexdump
2509      * commands to segfault.
2510      *)
2511     InitISOFS, Always, TestRun (
2512       [["hexdump"; "/100krandom"]])],
2513    "dump a file in hexadecimal",
2514    "\
2515 This runs C<hexdump -C> on the given C<path>.  The result is
2516 the human-readable, canonical hex dump of the file.");
2517
2518   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2519    [InitNone, Always, TestOutput (
2520       [["part_disk"; "/dev/sda"; "mbr"];
2521        ["mkfs"; "ext3"; "/dev/sda1"];
2522        ["mount_options"; ""; "/dev/sda1"; "/"];
2523        ["write_file"; "/new"; "test file"; "0"];
2524        ["umount"; "/dev/sda1"];
2525        ["zerofree"; "/dev/sda1"];
2526        ["mount_options"; ""; "/dev/sda1"; "/"];
2527        ["cat"; "/new"]], "test file")],
2528    "zero unused inodes and disk blocks on ext2/3 filesystem",
2529    "\
2530 This runs the I<zerofree> program on C<device>.  This program
2531 claims to zero unused inodes and disk blocks on an ext2/3
2532 filesystem, thus making it possible to compress the filesystem
2533 more effectively.
2534
2535 You should B<not> run this program if the filesystem is
2536 mounted.
2537
2538 It is possible that using this program can damage the filesystem
2539 or data on the filesystem.");
2540
2541   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2542    [],
2543    "resize an LVM physical volume",
2544    "\
2545 This resizes (expands or shrinks) an existing LVM physical
2546 volume to match the new size of the underlying device.");
2547
2548   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2549                        Int "cyls"; Int "heads"; Int "sectors";
2550                        String "line"]), 99, [DangerWillRobinson],
2551    [],
2552    "modify a single partition on a block device",
2553    "\
2554 This runs L<sfdisk(8)> option to modify just the single
2555 partition C<n> (note: C<n> counts from 1).
2556
2557 For other parameters, see C<guestfs_sfdisk>.  You should usually
2558 pass C<0> for the cyls/heads/sectors parameters.
2559
2560 See also: C<guestfs_part_add>");
2561
2562   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2563    [],
2564    "display the partition table",
2565    "\
2566 This displays the partition table on C<device>, in the
2567 human-readable output of the L<sfdisk(8)> command.  It is
2568 not intended to be parsed.
2569
2570 See also: C<guestfs_part_list>");
2571
2572   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2573    [],
2574    "display the kernel geometry",
2575    "\
2576 This displays the kernel's idea of the geometry of C<device>.
2577
2578 The result is in human-readable format, and not designed to
2579 be parsed.");
2580
2581   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2582    [],
2583    "display the disk geometry from the partition table",
2584    "\
2585 This displays the disk geometry of C<device> read from the
2586 partition table.  Especially in the case where the underlying
2587 block device has been resized, this can be different from the
2588 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2589
2590 The result is in human-readable format, and not designed to
2591 be parsed.");
2592
2593   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2594    [],
2595    "activate or deactivate all volume groups",
2596    "\
2597 This command activates or (if C<activate> is false) deactivates
2598 all logical volumes in all volume groups.
2599 If activated, then they are made known to the
2600 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2601 then those devices disappear.
2602
2603 This command is the same as running C<vgchange -a y|n>");
2604
2605   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2606    [],
2607    "activate or deactivate some volume groups",
2608    "\
2609 This command activates or (if C<activate> is false) deactivates
2610 all logical volumes in the listed volume groups C<volgroups>.
2611 If activated, then they are made known to the
2612 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2613 then those devices disappear.
2614
2615 This command is the same as running C<vgchange -a y|n volgroups...>
2616
2617 Note that if C<volgroups> is an empty list then B<all> volume groups
2618 are activated or deactivated.");
2619
2620   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2621    [InitNone, Always, TestOutput (
2622       [["part_disk"; "/dev/sda"; "mbr"];
2623        ["pvcreate"; "/dev/sda1"];
2624        ["vgcreate"; "VG"; "/dev/sda1"];
2625        ["lvcreate"; "LV"; "VG"; "10"];
2626        ["mkfs"; "ext2"; "/dev/VG/LV"];
2627        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2628        ["write_file"; "/new"; "test content"; "0"];
2629        ["umount"; "/"];
2630        ["lvresize"; "/dev/VG/LV"; "20"];
2631        ["e2fsck_f"; "/dev/VG/LV"];
2632        ["resize2fs"; "/dev/VG/LV"];
2633        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2634        ["cat"; "/new"]], "test content");
2635     InitNone, Always, TestRun (
2636       (* Make an LV smaller to test RHBZ#587484. *)
2637       [["part_disk"; "/dev/sda"; "mbr"];
2638        ["pvcreate"; "/dev/sda1"];
2639        ["vgcreate"; "VG"; "/dev/sda1"];
2640        ["lvcreate"; "LV"; "VG"; "20"];
2641        ["lvresize"; "/dev/VG/LV"; "10"]])],
2642    "resize an LVM logical volume",
2643    "\
2644 This resizes (expands or shrinks) an existing LVM logical
2645 volume to C<mbytes>.  When reducing, data in the reduced part
2646 is lost.");
2647
2648   ("resize2fs", (RErr, [Device "device"]), 106, [],
2649    [], (* lvresize tests this *)
2650    "resize an ext2, ext3 or ext4 filesystem",
2651    "\
2652 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2653 the underlying device.
2654
2655 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2656 on the C<device> before calling this command.  For unknown reasons
2657 C<resize2fs> sometimes gives an error about this and sometimes not.
2658 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2659 calling this function.");
2660
2661   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2662    [InitBasicFS, Always, TestOutputList (
2663       [["find"; "/"]], ["lost+found"]);
2664     InitBasicFS, Always, TestOutputList (
2665       [["touch"; "/a"];
2666        ["mkdir"; "/b"];
2667        ["touch"; "/b/c"];
2668        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2669     InitBasicFS, Always, TestOutputList (
2670       [["mkdir_p"; "/a/b/c"];
2671        ["touch"; "/a/b/c/d"];
2672        ["find"; "/a/b/"]], ["c"; "c/d"])],
2673    "find all files and directories",
2674    "\
2675 This command lists out all files and directories, recursively,
2676 starting at C<directory>.  It is essentially equivalent to
2677 running the shell command C<find directory -print> but some
2678 post-processing happens on the output, described below.
2679
2680 This returns a list of strings I<without any prefix>.  Thus
2681 if the directory structure was:
2682
2683  /tmp/a
2684  /tmp/b
2685  /tmp/c/d
2686
2687 then the returned list from C<guestfs_find> C</tmp> would be
2688 4 elements:
2689
2690  a
2691  b
2692  c
2693  c/d
2694
2695 If C<directory> is not a directory, then this command returns
2696 an error.
2697
2698 The returned list is sorted.
2699
2700 See also C<guestfs_find0>.");
2701
2702   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2703    [], (* lvresize tests this *)
2704    "check an ext2/ext3 filesystem",
2705    "\
2706 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2707 filesystem checker on C<device>, noninteractively (C<-p>),
2708 even if the filesystem appears to be clean (C<-f>).
2709
2710 This command is only needed because of C<guestfs_resize2fs>
2711 (q.v.).  Normally you should use C<guestfs_fsck>.");
2712
2713   ("sleep", (RErr, [Int "secs"]), 109, [],
2714    [InitNone, Always, TestRun (
2715       [["sleep"; "1"]])],
2716    "sleep for some seconds",
2717    "\
2718 Sleep for C<secs> seconds.");
2719
2720   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2721    [InitNone, Always, TestOutputInt (
2722       [["part_disk"; "/dev/sda"; "mbr"];
2723        ["mkfs"; "ntfs"; "/dev/sda1"];
2724        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2725     InitNone, Always, TestOutputInt (
2726       [["part_disk"; "/dev/sda"; "mbr"];
2727        ["mkfs"; "ext2"; "/dev/sda1"];
2728        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2729    "probe NTFS volume",
2730    "\
2731 This command runs the L<ntfs-3g.probe(8)> command which probes
2732 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2733 be mounted read-write, and some cannot be mounted at all).
2734
2735 C<rw> is a boolean flag.  Set it to true if you want to test
2736 if the volume can be mounted read-write.  Set it to false if
2737 you want to test if the volume can be mounted read-only.
2738
2739 The return value is an integer which C<0> if the operation
2740 would succeed, or some non-zero value documented in the
2741 L<ntfs-3g.probe(8)> manual page.");
2742
2743   ("sh", (RString "output", [String "command"]), 111, [],
2744    [], (* XXX needs tests *)
2745    "run a command via the shell",
2746    "\
2747 This call runs a command from the guest filesystem via the
2748 guest's C</bin/sh>.
2749
2750 This is like C<guestfs_command>, but passes the command to:
2751
2752  /bin/sh -c \"command\"
2753
2754 Depending on the guest's shell, this usually results in
2755 wildcards being expanded, shell expressions being interpolated
2756 and so on.
2757
2758 All the provisos about C<guestfs_command> apply to this call.");
2759
2760   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2761    [], (* XXX needs tests *)
2762    "run a command via the shell returning lines",
2763    "\
2764 This is the same as C<guestfs_sh>, but splits the result
2765 into a list of lines.
2766
2767 See also: C<guestfs_command_lines>");
2768
2769   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2770    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2771     * code in stubs.c, since all valid glob patterns must start with "/".
2772     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2773     *)
2774    [InitBasicFS, Always, TestOutputList (
2775       [["mkdir_p"; "/a/b/c"];
2776        ["touch"; "/a/b/c/d"];
2777        ["touch"; "/a/b/c/e"];
2778        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2779     InitBasicFS, Always, TestOutputList (
2780       [["mkdir_p"; "/a/b/c"];
2781        ["touch"; "/a/b/c/d"];
2782        ["touch"; "/a/b/c/e"];
2783        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2784     InitBasicFS, Always, TestOutputList (
2785       [["mkdir_p"; "/a/b/c"];
2786        ["touch"; "/a/b/c/d"];
2787        ["touch"; "/a/b/c/e"];
2788        ["glob_expand"; "/a/*/x/*"]], [])],
2789    "expand a wildcard path",
2790    "\
2791 This command searches for all the pathnames matching
2792 C<pattern> according to the wildcard expansion rules
2793 used by the shell.
2794
2795 If no paths match, then this returns an empty list
2796 (note: not an error).
2797
2798 It is just a wrapper around the C L<glob(3)> function
2799 with flags C<GLOB_MARK|GLOB_BRACE>.
2800 See that manual page for more details.");
2801
2802   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2803    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2804       [["scrub_device"; "/dev/sdc"]])],
2805    "scrub (securely wipe) a device",
2806    "\
2807 This command writes patterns over C<device> to make data retrieval
2808 more difficult.
2809
2810 It is an interface to the L<scrub(1)> program.  See that
2811 manual page for more details.");
2812
2813   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2814    [InitBasicFS, Always, TestRun (
2815       [["write_file"; "/file"; "content"; "0"];
2816        ["scrub_file"; "/file"]])],
2817    "scrub (securely wipe) a file",
2818    "\
2819 This command writes patterns over a file to make data retrieval
2820 more difficult.
2821
2822 The file is I<removed> after scrubbing.
2823
2824 It is an interface to the L<scrub(1)> program.  See that
2825 manual page for more details.");
2826
2827   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2828    [], (* XXX needs testing *)
2829    "scrub (securely wipe) free space",
2830    "\
2831 This command creates the directory C<dir> and then fills it
2832 with files until the filesystem is full, and scrubs the files
2833 as for C<guestfs_scrub_file>, and deletes them.
2834 The intention is to scrub any free space on the partition
2835 containing C<dir>.
2836
2837 It is an interface to the L<scrub(1)> program.  See that
2838 manual page for more details.");
2839
2840   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2841    [InitBasicFS, Always, TestRun (
2842       [["mkdir"; "/tmp"];
2843        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2844    "create a temporary directory",
2845    "\
2846 This command creates a temporary directory.  The
2847 C<template> parameter should be a full pathname for the
2848 temporary directory name with the final six characters being
2849 \"XXXXXX\".
2850
2851 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2852 the second one being suitable for Windows filesystems.
2853
2854 The name of the temporary directory that was created
2855 is returned.
2856
2857 The temporary directory is created with mode 0700
2858 and is owned by root.
2859
2860 The caller is responsible for deleting the temporary
2861 directory and its contents after use.
2862
2863 See also: L<mkdtemp(3)>");
2864
2865   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2866    [InitISOFS, Always, TestOutputInt (
2867       [["wc_l"; "/10klines"]], 10000)],
2868    "count lines in a file",
2869    "\
2870 This command counts the lines in a file, using the
2871 C<wc -l> external command.");
2872
2873   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2874    [InitISOFS, Always, TestOutputInt (
2875       [["wc_w"; "/10klines"]], 10000)],
2876    "count words in a file",
2877    "\
2878 This command counts the words in a file, using the
2879 C<wc -w> external command.");
2880
2881   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2882    [InitISOFS, Always, TestOutputInt (
2883       [["wc_c"; "/100kallspaces"]], 102400)],
2884    "count characters in a file",
2885    "\
2886 This command counts the characters in a file, using the
2887 C<wc -c> external command.");
2888
2889   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2890    [InitISOFS, Always, TestOutputList (
2891       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2892    "return first 10 lines of a file",
2893    "\
2894 This command returns up to the first 10 lines of a file as
2895 a list of strings.");
2896
2897   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2898    [InitISOFS, Always, TestOutputList (
2899       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2900     InitISOFS, Always, TestOutputList (
2901       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2902     InitISOFS, Always, TestOutputList (
2903       [["head_n"; "0"; "/10klines"]], [])],
2904    "return first N lines of a file",
2905    "\
2906 If the parameter C<nrlines> is a positive number, this returns the first
2907 C<nrlines> lines of the file C<path>.
2908
2909 If the parameter C<nrlines> is a negative number, this returns lines
2910 from the file C<path>, excluding the last C<nrlines> lines.
2911
2912 If the parameter C<nrlines> is zero, this returns an empty list.");
2913
2914   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2915    [InitISOFS, Always, TestOutputList (
2916       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2917    "return last 10 lines of a file",
2918    "\
2919 This command returns up to the last 10 lines of a file as
2920 a list of strings.");
2921
2922   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2923    [InitISOFS, Always, TestOutputList (
2924       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2925     InitISOFS, Always, TestOutputList (
2926       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2927     InitISOFS, Always, TestOutputList (
2928       [["tail_n"; "0"; "/10klines"]], [])],
2929    "return last N lines of a file",
2930    "\
2931 If the parameter C<nrlines> is a positive number, this returns the last
2932 C<nrlines> lines of the file C<path>.
2933
2934 If the parameter C<nrlines> is a negative number, this returns lines
2935 from the file C<path>, starting with the C<-nrlines>th line.
2936
2937 If the parameter C<nrlines> is zero, this returns an empty list.");
2938
2939   ("df", (RString "output", []), 125, [],
2940    [], (* XXX Tricky to test because it depends on the exact format
2941         * of the 'df' command and other imponderables.
2942         *)
2943    "report file system disk space usage",
2944    "\
2945 This command runs the C<df> command to report disk space used.
2946
2947 This command is mostly useful for interactive sessions.  It
2948 is I<not> intended that you try to parse the output string.
2949 Use C<statvfs> from programs.");
2950
2951   ("df_h", (RString "output", []), 126, [],
2952    [], (* XXX Tricky to test because it depends on the exact format
2953         * of the 'df' command and other imponderables.
2954         *)
2955    "report file system disk space usage (human readable)",
2956    "\
2957 This command runs the C<df -h> command to report disk space used
2958 in human-readable format.
2959
2960 This command is mostly useful for interactive sessions.  It
2961 is I<not> intended that you try to parse the output string.
2962 Use C<statvfs> from programs.");
2963
2964   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2965    [InitISOFS, Always, TestOutputInt (
2966       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2967    "estimate file space usage",
2968    "\
2969 This command runs the C<du -s> command to estimate file space
2970 usage for C<path>.
2971
2972 C<path> can be a file or a directory.  If C<path> is a directory
2973 then the estimate includes the contents of the directory and all
2974 subdirectories (recursively).
2975
2976 The result is the estimated size in I<kilobytes>
2977 (ie. units of 1024 bytes).");
2978
2979   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2980    [InitISOFS, Always, TestOutputList (
2981       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2982    "list files in an initrd",
2983    "\
2984 This command lists out files contained in an initrd.
2985
2986 The files are listed without any initial C</> character.  The
2987 files are listed in the order they appear (not necessarily
2988 alphabetical).  Directory names are listed as separate items.
2989
2990 Old Linux kernels (2.4 and earlier) used a compressed ext2
2991 filesystem as initrd.  We I<only> support the newer initramfs
2992 format (compressed cpio files).");
2993
2994   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2995    [],
2996    "mount a file using the loop device",
2997    "\
2998 This command lets you mount C<file> (a filesystem image
2999 in a file) on a mount point.  It is entirely equivalent to
3000 the command C<mount -o loop file mountpoint>.");
3001
3002   ("mkswap", (RErr, [Device "device"]), 130, [],
3003    [InitEmpty, Always, TestRun (
3004       [["part_disk"; "/dev/sda"; "mbr"];
3005        ["mkswap"; "/dev/sda1"]])],
3006    "create a swap partition",
3007    "\
3008 Create a swap partition on C<device>.");
3009
3010   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3011    [InitEmpty, Always, TestRun (
3012       [["part_disk"; "/dev/sda"; "mbr"];
3013        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3014    "create a swap partition with a label",
3015    "\
3016 Create a swap partition on C<device> with label C<label>.
3017
3018 Note that you cannot attach a swap label to a block device
3019 (eg. C</dev/sda>), just to a partition.  This appears to be
3020 a limitation of the kernel or swap tools.");
3021
3022   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3023    (let uuid = uuidgen () in
3024     [InitEmpty, Always, TestRun (
3025        [["part_disk"; "/dev/sda"; "mbr"];
3026         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3027    "create a swap partition with an explicit UUID",
3028    "\
3029 Create a swap partition on C<device> with UUID C<uuid>.");
3030
3031   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3032    [InitBasicFS, Always, TestOutputStruct (
3033       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3034        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3035        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3036     InitBasicFS, Always, TestOutputStruct (
3037       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3038        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3039    "make block, character or FIFO devices",
3040    "\
3041 This call creates block or character special devices, or
3042 named pipes (FIFOs).
3043
3044 The C<mode> parameter should be the mode, using the standard
3045 constants.  C<devmajor> and C<devminor> are the
3046 device major and minor numbers, only used when creating block
3047 and character special devices.
3048
3049 Note that, just like L<mknod(2)>, the mode must be bitwise
3050 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3051 just creates a regular file).  These constants are
3052 available in the standard Linux header files, or you can use
3053 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3054 which are wrappers around this command which bitwise OR
3055 in the appropriate constant for you.
3056
3057 The mode actually set is affected by the umask.");
3058
3059   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3060    [InitBasicFS, Always, TestOutputStruct (
3061       [["mkfifo"; "0o777"; "/node"];
3062        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3063    "make FIFO (named pipe)",
3064    "\
3065 This call creates a FIFO (named pipe) called C<path> with
3066 mode C<mode>.  It is just a convenient wrapper around
3067 C<guestfs_mknod>.
3068
3069 The mode actually set is affected by the umask.");
3070
3071   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3072    [InitBasicFS, Always, TestOutputStruct (
3073       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3074        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3075    "make block device node",
3076    "\
3077 This call creates a block device node called C<path> with
3078 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3079 It is just a convenient wrapper around C<guestfs_mknod>.
3080
3081 The mode actually set is affected by the umask.");
3082
3083   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3084    [InitBasicFS, Always, TestOutputStruct (
3085       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3086        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3087    "make char device node",
3088    "\
3089 This call creates a char device node called C<path> with
3090 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3091 It is just a convenient wrapper around C<guestfs_mknod>.
3092
3093 The mode actually set is affected by the umask.");
3094
3095   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3096    [InitEmpty, Always, TestOutputInt (
3097       [["umask"; "0o22"]], 0o22)],
3098    "set file mode creation mask (umask)",
3099    "\
3100 This function sets the mask used for creating new files and
3101 device nodes to C<mask & 0777>.
3102
3103 Typical umask values would be C<022> which creates new files
3104 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3105 C<002> which creates new files with permissions like
3106 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3107
3108 The default umask is C<022>.  This is important because it
3109 means that directories and device nodes will be created with
3110 C<0644> or C<0755> mode even if you specify C<0777>.
3111
3112 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3113
3114 This call returns the previous umask.");
3115
3116   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3117    [],
3118    "read directories entries",
3119    "\
3120 This returns the list of directory entries in directory C<dir>.
3121
3122 All entries in the directory are returned, including C<.> and
3123 C<..>.  The entries are I<not> sorted, but returned in the same
3124 order as the underlying filesystem.
3125
3126 Also this call returns basic file type information about each
3127 file.  The C<ftyp> field will contain one of the following characters:
3128
3129 =over 4
3130
3131 =item 'b'
3132
3133 Block special
3134
3135 =item 'c'
3136
3137 Char special
3138
3139 =item 'd'
3140
3141 Directory
3142
3143 =item 'f'
3144
3145 FIFO (named pipe)
3146
3147 =item 'l'
3148
3149 Symbolic link
3150
3151 =item 'r'
3152
3153 Regular file
3154
3155 =item 's'
3156
3157 Socket
3158
3159 =item 'u'
3160
3161 Unknown file type
3162
3163 =item '?'
3164
3165 The L<readdir(3)> call returned a C<d_type> field with an
3166 unexpected value
3167
3168 =back
3169
3170 This function is primarily intended for use by programs.  To
3171 get a simple list of names, use C<guestfs_ls>.  To get a printable
3172 directory for human consumption, use C<guestfs_ll>.");
3173
3174   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3175    [],
3176    "create partitions on a block device",
3177    "\
3178 This is a simplified interface to the C<guestfs_sfdisk>
3179 command, where partition sizes are specified in megabytes
3180 only (rounded to the nearest cylinder) and you don't need
3181 to specify the cyls, heads and sectors parameters which
3182 were rarely if ever used anyway.
3183
3184 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3185 and C<guestfs_part_disk>");
3186
3187   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3188    [],
3189    "determine file type inside a compressed file",
3190    "\
3191 This command runs C<file> after first decompressing C<path>
3192 using C<method>.
3193
3194 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3195
3196 Since 1.0.63, use C<guestfs_file> instead which can now
3197 process compressed files.");
3198
3199   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3200    [],
3201    "list extended attributes of a file or directory",
3202    "\
3203 This call lists the extended attributes of the file or directory
3204 C<path>.
3205
3206 At the system call level, this is a combination of the
3207 L<listxattr(2)> and L<getxattr(2)> calls.
3208
3209 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3210
3211   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3212    [],
3213    "list extended attributes of a file or directory",
3214    "\
3215 This is the same as C<guestfs_getxattrs>, but if C<path>
3216 is a symbolic link, then it returns the extended attributes
3217 of the link itself.");
3218
3219   ("setxattr", (RErr, [String "xattr";
3220                        String "val"; Int "vallen"; (* will be BufferIn *)
3221                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3222    [],
3223    "set extended attribute of a file or directory",
3224    "\
3225 This call sets the extended attribute named C<xattr>
3226 of the file C<path> to the value C<val> (of length C<vallen>).
3227 The value is arbitrary 8 bit data.
3228
3229 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3230
3231   ("lsetxattr", (RErr, [String "xattr";
3232                         String "val"; Int "vallen"; (* will be BufferIn *)
3233                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3234    [],
3235    "set extended attribute of a file or directory",
3236    "\
3237 This is the same as C<guestfs_setxattr>, but if C<path>
3238 is a symbolic link, then it sets an extended attribute
3239 of the link itself.");
3240
3241   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3242    [],
3243    "remove extended attribute of a file or directory",
3244    "\
3245 This call removes the extended attribute named C<xattr>
3246 of the file C<path>.
3247
3248 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3249
3250   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3251    [],
3252    "remove extended attribute of a file or directory",
3253    "\
3254 This is the same as C<guestfs_removexattr>, but if C<path>
3255 is a symbolic link, then it removes an extended attribute
3256 of the link itself.");
3257
3258   ("mountpoints", (RHashtable "mps", []), 147, [],
3259    [],
3260    "show mountpoints",
3261    "\
3262 This call is similar to C<guestfs_mounts>.  That call returns
3263 a list of devices.  This one returns a hash table (map) of
3264 device name to directory where the device is mounted.");
3265
3266   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3267    (* This is a special case: while you would expect a parameter
3268     * of type "Pathname", that doesn't work, because it implies
3269     * NEED_ROOT in the generated calling code in stubs.c, and
3270     * this function cannot use NEED_ROOT.
3271     *)
3272    [],
3273    "create a mountpoint",
3274    "\
3275 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3276 specialized calls that can be used to create extra mountpoints
3277 before mounting the first filesystem.
3278
3279 These calls are I<only> necessary in some very limited circumstances,
3280 mainly the case where you want to mount a mix of unrelated and/or
3281 read-only filesystems together.
3282
3283 For example, live CDs often contain a \"Russian doll\" nest of
3284 filesystems, an ISO outer layer, with a squashfs image inside, with
3285 an ext2/3 image inside that.  You can unpack this as follows
3286 in guestfish:
3287
3288  add-ro Fedora-11-i686-Live.iso
3289  run
3290  mkmountpoint /cd
3291  mkmountpoint /squash
3292  mkmountpoint /ext3
3293  mount /dev/sda /cd
3294  mount-loop /cd/LiveOS/squashfs.img /squash
3295  mount-loop /squash/LiveOS/ext3fs.img /ext3
3296
3297 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3298
3299   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3300    [],
3301    "remove a mountpoint",
3302    "\
3303 This calls removes a mountpoint that was previously created
3304 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3305 for full details.");
3306
3307   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3308    [InitISOFS, Always, TestOutputBuffer (
3309       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3310     (* Test various near large, large and too large files (RHBZ#589039). *)
3311     InitBasicFS, Always, TestLastFail (
3312       [["touch"; "/a"];
3313        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3314        ["read_file"; "/a"]]);
3315     InitBasicFS, Always, TestLastFail (
3316       [["touch"; "/a"];
3317        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3318        ["read_file"; "/a"]]);
3319     InitBasicFS, Always, TestLastFail (
3320       [["touch"; "/a"];
3321        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3322        ["read_file"; "/a"]])],
3323    "read a file",
3324    "\
3325 This calls returns the contents of the file C<path> as a
3326 buffer.
3327
3328 Unlike C<guestfs_cat>, this function can correctly
3329 handle files that contain embedded ASCII NUL characters.
3330 However unlike C<guestfs_download>, this function is limited
3331 in the total size of file that can be handled.");
3332
3333   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3334    [InitISOFS, Always, TestOutputList (
3335       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3336     InitISOFS, Always, TestOutputList (
3337       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3338    "return lines matching a pattern",
3339    "\
3340 This calls the external C<grep> program and returns the
3341 matching lines.");
3342
3343   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3344    [InitISOFS, Always, TestOutputList (
3345       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3346    "return lines matching a pattern",
3347    "\
3348 This calls the external C<egrep> program and returns the
3349 matching lines.");
3350
3351   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3352    [InitISOFS, Always, TestOutputList (
3353       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3354    "return lines matching a pattern",
3355    "\
3356 This calls the external C<fgrep> program and returns the
3357 matching lines.");
3358
3359   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3360    [InitISOFS, Always, TestOutputList (
3361       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3362    "return lines matching a pattern",
3363    "\
3364 This calls the external C<grep -i> program and returns the
3365 matching lines.");
3366
3367   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3368    [InitISOFS, Always, TestOutputList (
3369       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3370    "return lines matching a pattern",
3371    "\
3372 This calls the external C<egrep -i> program and returns the
3373 matching lines.");
3374
3375   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3376    [InitISOFS, Always, TestOutputList (
3377       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3378    "return lines matching a pattern",
3379    "\
3380 This calls the external C<fgrep -i> program and returns the
3381 matching lines.");
3382
3383   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3384    [InitISOFS, Always, TestOutputList (
3385       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3386    "return lines matching a pattern",
3387    "\
3388 This calls the external C<zgrep> program and returns the
3389 matching lines.");
3390
3391   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3392    [InitISOFS, Always, TestOutputList (
3393       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3394    "return lines matching a pattern",
3395    "\
3396 This calls the external C<zegrep> program and returns the
3397 matching lines.");
3398
3399   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3400    [InitISOFS, Always, TestOutputList (
3401       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3402    "return lines matching a pattern",
3403    "\
3404 This calls the external C<zfgrep> program and returns the
3405 matching lines.");
3406
3407   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3408    [InitISOFS, Always, TestOutputList (
3409       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3410    "return lines matching a pattern",
3411    "\
3412 This calls the external C<zgrep -i> program and returns the
3413 matching lines.");
3414
3415   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3416    [InitISOFS, Always, TestOutputList (
3417       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3418    "return lines matching a pattern",
3419    "\
3420 This calls the external C<zegrep -i> program and returns the
3421 matching lines.");
3422
3423   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3424    [InitISOFS, Always, TestOutputList (
3425       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3426    "return lines matching a pattern",
3427    "\
3428 This calls the external C<zfgrep -i> program and returns the
3429 matching lines.");
3430
3431   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3432    [InitISOFS, Always, TestOutput (
3433       [["realpath"; "/../directory"]], "/directory")],
3434    "canonicalized absolute pathname",
3435    "\
3436 Return the canonicalized absolute pathname of C<path>.  The
3437 returned path has no C<.>, C<..> or symbolic link path elements.");
3438
3439   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3440    [InitBasicFS, Always, TestOutputStruct (
3441       [["touch"; "/a"];
3442        ["ln"; "/a"; "/b"];
3443        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3444    "create a hard link",
3445    "\
3446 This command creates a hard link using the C<ln> command.");
3447
3448   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3449    [InitBasicFS, Always, TestOutputStruct (
3450       [["touch"; "/a"];
3451        ["touch"; "/b"];
3452        ["ln_f"; "/a"; "/b"];
3453        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3454    "create a hard link",
3455    "\
3456 This command creates a hard link using the C<ln -f> command.
3457 The C<-f> option removes the link (C<linkname>) if it exists already.");
3458
3459   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3460    [InitBasicFS, Always, TestOutputStruct (
3461       [["touch"; "/a"];
3462        ["ln_s"; "a"; "/b"];
3463        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3464    "create a symbolic link",
3465    "\
3466 This command creates a symbolic link using the C<ln -s> command.");
3467
3468   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3469    [InitBasicFS, Always, TestOutput (
3470       [["mkdir_p"; "/a/b"];
3471        ["touch"; "/a/b/c"];
3472        ["ln_sf"; "../d"; "/a/b/c"];
3473        ["readlink"; "/a/b/c"]], "../d")],
3474    "create a symbolic link",
3475    "\
3476 This command creates a symbolic link using the C<ln -sf> command,
3477 The C<-f> option removes the link (C<linkname>) if it exists already.");
3478
3479   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3480    [] (* XXX tested above *),
3481    "read the target of a symbolic link",
3482    "\
3483 This command reads the target of a symbolic link.");
3484
3485   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3486    [InitBasicFS, Always, TestOutputStruct (
3487       [["fallocate"; "/a"; "1000000"];
3488        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3489    "preallocate a file in the guest filesystem",
3490    "\
3491 This command preallocates a file (containing zero bytes) named
3492 C<path> of size C<len> bytes.  If the file exists already, it
3493 is overwritten.
3494
3495 Do not confuse this with the guestfish-specific
3496 C<alloc> command which allocates a file in the host and
3497 attaches it as a device.");
3498
3499   ("swapon_device", (RErr, [Device "device"]), 170, [],
3500    [InitPartition, Always, TestRun (
3501       [["mkswap"; "/dev/sda1"];
3502        ["swapon_device"; "/dev/sda1"];
3503        ["swapoff_device"; "/dev/sda1"]])],
3504    "enable swap on device",
3505    "\
3506 This command enables the libguestfs appliance to use the
3507 swap device or partition named C<device>.  The increased
3508 memory is made available for all commands, for example
3509 those run using C<guestfs_command> or C<guestfs_sh>.
3510
3511 Note that you should not swap to existing guest swap
3512 partitions unless you know what you are doing.  They may
3513 contain hibernation information, or other information that
3514 the guest doesn't want you to trash.  You also risk leaking
3515 information about the host to the guest this way.  Instead,
3516 attach a new host device to the guest and swap on that.");
3517
3518   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3519    [], (* XXX tested by swapon_device *)
3520    "disable swap on device",
3521    "\
3522 This command disables the libguestfs appliance swap
3523 device or partition named C<device>.
3524 See C<guestfs_swapon_device>.");
3525
3526   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3527    [InitBasicFS, Always, TestRun (
3528       [["fallocate"; "/swap"; "8388608"];
3529        ["mkswap_file"; "/swap"];
3530        ["swapon_file"; "/swap"];
3531        ["swapoff_file"; "/swap"]])],
3532    "enable swap on file",
3533    "\
3534 This command enables swap to a file.
3535 See C<guestfs_swapon_device> for other notes.");
3536
3537   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3538    [], (* XXX tested by swapon_file *)
3539    "disable swap on file",
3540    "\
3541 This command disables the libguestfs appliance swap on file.");
3542
3543   ("swapon_label", (RErr, [String "label"]), 174, [],
3544    [InitEmpty, Always, TestRun (
3545       [["part_disk"; "/dev/sdb"; "mbr"];
3546        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3547        ["swapon_label"; "swapit"];
3548        ["swapoff_label"; "swapit"];
3549        ["zero"; "/dev/sdb"];
3550        ["blockdev_rereadpt"; "/dev/sdb"]])],
3551    "enable swap on labeled swap partition",
3552    "\
3553 This command enables swap to a labeled swap partition.
3554 See C<guestfs_swapon_device> for other notes.");
3555
3556   ("swapoff_label", (RErr, [String "label"]), 175, [],
3557    [], (* XXX tested by swapon_label *)
3558    "disable swap on labeled swap partition",
3559    "\
3560 This command disables the libguestfs appliance swap on
3561 labeled swap partition.");
3562
3563   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3564    (let uuid = uuidgen () in
3565     [InitEmpty, Always, TestRun (
3566        [["mkswap_U"; uuid; "/dev/sdb"];
3567         ["swapon_uuid"; uuid];
3568         ["swapoff_uuid"; uuid]])]),
3569    "enable swap on swap partition by UUID",
3570    "\
3571 This command enables swap to a swap partition with the given UUID.
3572 See C<guestfs_swapon_device> for other notes.");
3573
3574   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3575    [], (* XXX tested by swapon_uuid *)
3576    "disable swap on swap partition by UUID",
3577    "\
3578 This command disables the libguestfs appliance swap partition
3579 with the given UUID.");
3580
3581   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3582    [InitBasicFS, Always, TestRun (
3583       [["fallocate"; "/swap"; "8388608"];
3584        ["mkswap_file"; "/swap"]])],
3585    "create a swap file",
3586    "\
3587 Create a swap file.
3588
3589 This command just writes a swap file signature to an existing
3590 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3591
3592   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3593    [InitISOFS, Always, TestRun (
3594       [["inotify_init"; "0"]])],
3595    "create an inotify handle",
3596    "\
3597 This command creates a new inotify handle.
3598 The inotify subsystem can be used to notify events which happen to
3599 objects in the guest filesystem.
3600
3601 C<maxevents> is the maximum number of events which will be
3602 queued up between calls to C<guestfs_inotify_read> or
3603 C<guestfs_inotify_files>.
3604 If this is passed as C<0>, then the kernel (or previously set)
3605 default is used.  For Linux 2.6.29 the default was 16384 events.
3606 Beyond this limit, the kernel throws away events, but records
3607 the fact that it threw them away by setting a flag
3608 C<IN_Q_OVERFLOW> in the returned structure list (see
3609 C<guestfs_inotify_read>).
3610
3611 Before any events are generated, you have to add some
3612 watches to the internal watch list.  See:
3613 C<guestfs_inotify_add_watch>,
3614 C<guestfs_inotify_rm_watch> and
3615 C<guestfs_inotify_watch_all>.
3616
3617 Queued up events should be read periodically by calling
3618 C<guestfs_inotify_read>
3619 (or C<guestfs_inotify_files> which is just a helpful
3620 wrapper around C<guestfs_inotify_read>).  If you don't
3621 read the events out often enough then you risk the internal
3622 queue overflowing.
3623
3624 The handle should be closed after use by calling
3625 C<guestfs_inotify_close>.  This also removes any
3626 watches automatically.
3627
3628 See also L<inotify(7)> for an overview of the inotify interface
3629 as exposed by the Linux kernel, which is roughly what we expose
3630 via libguestfs.  Note that there is one global inotify handle
3631 per libguestfs instance.");
3632
3633   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3634    [InitBasicFS, Always, TestOutputList (
3635       [["inotify_init"; "0"];
3636        ["inotify_add_watch"; "/"; "1073741823"];
3637        ["touch"; "/a"];
3638        ["touch"; "/b"];
3639        ["inotify_files"]], ["a"; "b"])],
3640    "add an inotify watch",
3641    "\
3642 Watch C<path> for the events listed in C<mask>.
3643
3644 Note that if C<path> is a directory then events within that
3645 directory are watched, but this does I<not> happen recursively
3646 (in subdirectories).
3647
3648 Note for non-C or non-Linux callers: the inotify events are
3649 defined by the Linux kernel ABI and are listed in
3650 C</usr/include/sys/inotify.h>.");
3651
3652   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3653    [],
3654    "remove an inotify watch",
3655    "\
3656 Remove a previously defined inotify watch.
3657 See C<guestfs_inotify_add_watch>.");
3658
3659   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3660    [],
3661    "return list of inotify events",
3662    "\
3663 Return the complete queue of events that have happened
3664 since the previous read call.
3665
3666 If no events have happened, this returns an empty list.
3667
3668 I<Note>: In order to make sure that all events have been
3669 read, you must call this function repeatedly until it
3670 returns an empty list.  The reason is that the call will
3671 read events up to the maximum appliance-to-host message
3672 size and leave remaining events in the queue.");
3673
3674   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3675    [],
3676    "return list of watched files that had events",
3677    "\
3678 This function is a helpful wrapper around C<guestfs_inotify_read>
3679 which just returns a list of pathnames of objects that were
3680 touched.  The returned pathnames are sorted and deduplicated.");
3681
3682   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3683    [],
3684    "close the inotify handle",
3685    "\
3686 This closes the inotify handle which was previously
3687 opened by inotify_init.  It removes all watches, throws
3688 away any pending events, and deallocates all resources.");
3689
3690   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3691    [],
3692    "set SELinux security context",
3693    "\
3694 This sets the SELinux security context of the daemon
3695 to the string C<context>.
3696
3697 See the documentation about SELINUX in L<guestfs(3)>.");
3698
3699   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3700    [],
3701    "get SELinux security context",
3702    "\
3703 This gets the SELinux security context of the daemon.
3704
3705 See the documentation about SELINUX in L<guestfs(3)>,
3706 and C<guestfs_setcon>");
3707
3708   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3709    [InitEmpty, Always, TestOutput (
3710       [["part_disk"; "/dev/sda"; "mbr"];
3711        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3712        ["mount_options"; ""; "/dev/sda1"; "/"];
3713        ["write_file"; "/new"; "new file contents"; "0"];
3714        ["cat"; "/new"]], "new file contents")],
3715    "make a filesystem with block size",
3716    "\
3717 This call is similar to C<guestfs_mkfs>, but it allows you to
3718 control the block size of the resulting filesystem.  Supported
3719 block sizes depend on the filesystem type, but typically they
3720 are C<1024>, C<2048> or C<4096> only.");
3721
3722   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3723    [InitEmpty, Always, TestOutput (
3724       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3725        ["mke2journal"; "4096"; "/dev/sda1"];
3726        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3727        ["mount_options"; ""; "/dev/sda2"; "/"];
3728        ["write_file"; "/new"; "new file contents"; "0"];
3729        ["cat"; "/new"]], "new file contents")],
3730    "make ext2/3/4 external journal",
3731    "\
3732 This creates an ext2 external journal on C<device>.  It is equivalent
3733 to the command:
3734
3735  mke2fs -O journal_dev -b blocksize device");
3736
3737   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3738    [InitEmpty, Always, TestOutput (
3739       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3740        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3741        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3742        ["mount_options"; ""; "/dev/sda2"; "/"];
3743        ["write_file"; "/new"; "new file contents"; "0"];
3744        ["cat"; "/new"]], "new file contents")],
3745    "make ext2/3/4 external journal with label",
3746    "\
3747 This creates an ext2 external journal on C<device> with label C<label>.");
3748
3749   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3750    (let uuid = uuidgen () in
3751     [InitEmpty, Always, TestOutput (
3752        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3753         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3754         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3755         ["mount_options"; ""; "/dev/sda2"; "/"];
3756         ["write_file"; "/new"; "new file contents"; "0"];
3757         ["cat"; "/new"]], "new file contents")]),
3758    "make ext2/3/4 external journal with UUID",
3759    "\
3760 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3761
3762   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3763    [],
3764    "make ext2/3/4 filesystem with external journal",
3765    "\
3766 This creates an ext2/3/4 filesystem on C<device> with
3767 an external journal on C<journal>.  It is equivalent
3768 to the command:
3769
3770  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3771
3772 See also C<guestfs_mke2journal>.");
3773
3774   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3775    [],
3776    "make ext2/3/4 filesystem with external journal",
3777    "\
3778 This creates an ext2/3/4 filesystem on C<device> with
3779 an external journal on the journal labeled C<label>.
3780
3781 See also C<guestfs_mke2journal_L>.");
3782
3783   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3784    [],
3785    "make ext2/3/4 filesystem with external journal",
3786    "\
3787 This creates an ext2/3/4 filesystem on C<device> with
3788 an external journal on the journal with UUID C<uuid>.
3789
3790 See also C<guestfs_mke2journal_U>.");
3791
3792   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3793    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3794    "load a kernel module",
3795    "\
3796 This loads a kernel module in the appliance.
3797
3798 The kernel module must have been whitelisted when libguestfs
3799 was built (see C<appliance/kmod.whitelist.in> in the source).");
3800
3801   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3802    [InitNone, Always, TestOutput (
3803       [["echo_daemon"; "This is a test"]], "This is a test"
3804     )],
3805    "echo arguments back to the client",
3806    "\
3807 This command concatenates the list of C<words> passed with single spaces
3808 between them and returns the resulting string.
3809
3810 You can use this command to test the connection through to the daemon.
3811
3812 See also C<guestfs_ping_daemon>.");
3813
3814   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3815    [], (* There is a regression test for this. *)
3816    "find all files and directories, returning NUL-separated list",
3817    "\
3818 This command lists out all files and directories, recursively,
3819 starting at C<directory>, placing the resulting list in the
3820 external file called C<files>.
3821
3822 This command works the same way as C<guestfs_find> with the
3823 following exceptions:
3824
3825 =over 4
3826
3827 =item *
3828
3829 The resulting list is written to an external file.
3830
3831 =item *
3832
3833 Items (filenames) in the result are separated
3834 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3835
3836 =item *
3837
3838 This command is not limited in the number of names that it
3839 can return.
3840
3841 =item *
3842
3843 The result list is not sorted.
3844
3845 =back");
3846
3847   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3848    [InitISOFS, Always, TestOutput (
3849       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3850     InitISOFS, Always, TestOutput (
3851       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3852     InitISOFS, Always, TestOutput (
3853       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3854     InitISOFS, Always, TestLastFail (
3855       [["case_sensitive_path"; "/Known-1/"]]);
3856     InitBasicFS, Always, TestOutput (
3857       [["mkdir"; "/a"];
3858        ["mkdir"; "/a/bbb"];
3859        ["touch"; "/a/bbb/c"];
3860        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3861     InitBasicFS, Always, TestOutput (
3862       [["mkdir"; "/a"];
3863        ["mkdir"; "/a/bbb"];
3864        ["touch"; "/a/bbb/c"];
3865        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3866     InitBasicFS, Always, TestLastFail (
3867       [["mkdir"; "/a"];
3868        ["mkdir"; "/a/bbb"];
3869        ["touch"; "/a/bbb/c"];
3870        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3871    "return true path on case-insensitive filesystem",
3872    "\
3873 This can be used to resolve case insensitive paths on
3874 a filesystem which is case sensitive.  The use case is
3875 to resolve paths which you have read from Windows configuration
3876 files or the Windows Registry, to the true path.
3877
3878 The command handles a peculiarity of the Linux ntfs-3g
3879 filesystem driver (and probably others), which is that although
3880 the underlying filesystem is case-insensitive, the driver
3881 exports the filesystem to Linux as case-sensitive.
3882
3883 One consequence of this is that special directories such
3884 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3885 (or other things) depending on the precise details of how
3886 they were created.  In Windows itself this would not be
3887 a problem.
3888
3889 Bug or feature?  You decide:
3890 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3891
3892 This function resolves the true case of each element in the
3893 path and returns the case-sensitive path.
3894
3895 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3896 might return C<\"/WINDOWS/system32\"> (the exact return value
3897 would depend on details of how the directories were originally
3898 created under Windows).
3899
3900 I<Note>:
3901 This function does not handle drive names, backslashes etc.
3902
3903 See also C<guestfs_realpath>.");
3904
3905   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3906    [InitBasicFS, Always, TestOutput (
3907       [["vfs_type"; "/dev/sda1"]], "ext2")],
3908    "get the Linux VFS type corresponding to a mounted device",
3909    "\
3910 This command gets the filesystem type corresponding to
3911 the filesystem on C<device>.
3912
3913 For most filesystems, the result is the name of the Linux
3914 VFS module which would be used to mount this filesystem
3915 if you mounted it without specifying the filesystem type.
3916 For example a string such as C<ext3> or C<ntfs>.");
3917
3918   ("truncate", (RErr, [Pathname "path"]), 199, [],
3919    [InitBasicFS, Always, TestOutputStruct (
3920       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3921        ["truncate"; "/test"];
3922        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3923    "truncate a file to zero size",
3924    "\
3925 This command truncates C<path> to a zero-length file.  The
3926 file must exist already.");
3927
3928   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3929    [InitBasicFS, Always, TestOutputStruct (
3930       [["touch"; "/test"];
3931        ["truncate_size"; "/test"; "1000"];
3932        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3933    "truncate a file to a particular size",
3934    "\
3935 This command truncates C<path> to size C<size> bytes.  The file
3936 must exist already.
3937
3938 If the current file size is less than C<size> then
3939 the file is extended to the required size with zero bytes.
3940 This creates a sparse file (ie. disk blocks are not allocated
3941 for the file until you write to it).  To create a non-sparse
3942 file of zeroes, use C<guestfs_fallocate64> instead.");
3943
3944   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3945    [InitBasicFS, Always, TestOutputStruct (
3946       [["touch"; "/test"];
3947        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3948        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3949    "set timestamp of a file with nanosecond precision",
3950    "\
3951 This command sets the timestamps of a file with nanosecond
3952 precision.
3953
3954 C<atsecs, atnsecs> are the last access time (atime) in secs and
3955 nanoseconds from the epoch.
3956
3957 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3958 secs and nanoseconds from the epoch.
3959
3960 If the C<*nsecs> field contains the special value C<-1> then
3961 the corresponding timestamp is set to the current time.  (The
3962 C<*secs> field is ignored in this case).
3963
3964 If the C<*nsecs> field contains the special value C<-2> then
3965 the corresponding timestamp is left unchanged.  (The
3966 C<*secs> field is ignored in this case).");
3967
3968   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3969    [InitBasicFS, Always, TestOutputStruct (
3970       [["mkdir_mode"; "/test"; "0o111"];
3971        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3972    "create a directory with a particular mode",
3973    "\
3974 This command creates a directory, setting the initial permissions
3975 of the directory to C<mode>.
3976
3977 For common Linux filesystems, the actual mode which is set will
3978 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3979 interpret the mode in other ways.
3980
3981 See also C<guestfs_mkdir>, C<guestfs_umask>");
3982
3983   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3984    [], (* XXX *)
3985    "change file owner and group",
3986    "\
3987 Change the file owner to C<owner> and group to C<group>.
3988 This is like C<guestfs_chown> but if C<path> is a symlink then
3989 the link itself is changed, not the target.
3990
3991 Only numeric uid and gid are supported.  If you want to use
3992 names, you will need to locate and parse the password file
3993 yourself (Augeas support makes this relatively easy).");
3994
3995   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3996    [], (* XXX *)
3997    "lstat on multiple files",
3998    "\
3999 This call allows you to perform the C<guestfs_lstat> operation
4000 on multiple files, where all files are in the directory C<path>.
4001 C<names> is the list of files from this directory.
4002
4003 On return you get a list of stat structs, with a one-to-one
4004 correspondence to the C<names> list.  If any name did not exist
4005 or could not be lstat'd, then the C<ino> field of that structure
4006 is set to C<-1>.
4007
4008 This call is intended for programs that want to efficiently
4009 list a directory contents without making many round-trips.
4010 See also C<guestfs_lxattrlist> for a similarly efficient call
4011 for getting extended attributes.  Very long directory listings
4012 might cause the protocol message size to be exceeded, causing
4013 this call to fail.  The caller must split up such requests
4014 into smaller groups of names.");
4015
4016   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4017    [], (* XXX *)
4018    "lgetxattr on multiple files",
4019    "\
4020 This call allows you to get the extended attributes
4021 of multiple files, where all files are in the directory C<path>.
4022 C<names> is the list of files from this directory.
4023
4024 On return you get a flat list of xattr structs which must be
4025 interpreted sequentially.  The first xattr struct always has a zero-length
4026 C<attrname>.  C<attrval> in this struct is zero-length
4027 to indicate there was an error doing C<lgetxattr> for this
4028 file, I<or> is a C string which is a decimal number
4029 (the number of following attributes for this file, which could
4030 be C<\"0\">).  Then after the first xattr struct are the
4031 zero or more attributes for the first named file.
4032 This repeats for the second and subsequent files.
4033
4034 This call is intended for programs that want to efficiently
4035 list a directory contents without making many round-trips.
4036 See also C<guestfs_lstatlist> for a similarly efficient call
4037 for getting standard stats.  Very long directory listings
4038 might cause the protocol message size to be exceeded, causing
4039 this call to fail.  The caller must split up such requests
4040 into smaller groups of names.");
4041
4042   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4043    [], (* XXX *)
4044    "readlink on multiple files",
4045    "\
4046 This call allows you to do a C<readlink> operation
4047 on multiple files, where all files are in the directory C<path>.
4048 C<names> is the list of files from this directory.
4049
4050 On return you get a list of strings, with a one-to-one
4051 correspondence to the C<names> list.  Each string is the
4052 value of the symbolic link.
4053
4054 If the C<readlink(2)> operation fails on any name, then
4055 the corresponding result string is the empty string C<\"\">.
4056 However the whole operation is completed even if there
4057 were C<readlink(2)> errors, and so you can call this
4058 function with names where you don't know if they are
4059 symbolic links already (albeit slightly less efficient).
4060
4061 This call is intended for programs that want to efficiently
4062 list a directory contents without making many round-trips.
4063 Very long directory listings might cause the protocol
4064 message size to be exceeded, causing
4065 this call to fail.  The caller must split up such requests
4066 into smaller groups of names.");
4067
4068   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4069    [InitISOFS, Always, TestOutputBuffer (
4070       [["pread"; "/known-4"; "1"; "3"]], "\n");
4071     InitISOFS, Always, TestOutputBuffer (
4072       [["pread"; "/empty"; "0"; "100"]], "")],
4073    "read part of a file",
4074    "\
4075 This command lets you read part of a file.  It reads C<count>
4076 bytes of the file, starting at C<offset>, from file C<path>.
4077
4078 This may read fewer bytes than requested.  For further details
4079 see the L<pread(2)> system call.");
4080
4081   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4082    [InitEmpty, Always, TestRun (
4083       [["part_init"; "/dev/sda"; "gpt"]])],
4084    "create an empty partition table",
4085    "\
4086 This creates an empty partition table on C<device> of one of the
4087 partition types listed below.  Usually C<parttype> should be
4088 either C<msdos> or C<gpt> (for large disks).
4089
4090 Initially there are no partitions.  Following this, you should
4091 call C<guestfs_part_add> for each partition required.
4092
4093 Possible values for C<parttype> are:
4094
4095 =over 4
4096
4097 =item B<efi> | B<gpt>
4098
4099 Intel EFI / GPT partition table.
4100
4101 This is recommended for >= 2 TB partitions that will be accessed
4102 from Linux and Intel-based Mac OS X.  It also has limited backwards
4103 compatibility with the C<mbr> format.
4104
4105 =item B<mbr> | B<msdos>
4106
4107 The standard PC \"Master Boot Record\" (MBR) format used
4108 by MS-DOS and Windows.  This partition type will B<only> work
4109 for device sizes up to 2 TB.  For large disks we recommend
4110 using C<gpt>.
4111
4112 =back
4113
4114 Other partition table types that may work but are not
4115 supported include:
4116
4117 =over 4
4118
4119 =item B<aix>
4120
4121 AIX disk labels.
4122
4123 =item B<amiga> | B<rdb>
4124
4125 Amiga \"Rigid Disk Block\" format.
4126
4127 =item B<bsd>
4128
4129 BSD disk labels.
4130
4131 =item B<dasd>
4132
4133 DASD, used on IBM mainframes.
4134
4135 =item B<dvh>
4136
4137 MIPS/SGI volumes.
4138
4139 =item B<mac>
4140
4141 Old Mac partition format.  Modern Macs use C<gpt>.
4142
4143 =item B<pc98>
4144
4145 NEC PC-98 format, common in Japan apparently.
4146
4147 =item B<sun>
4148
4149 Sun disk labels.
4150
4151 =back");
4152
4153   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4154    [InitEmpty, Always, TestRun (
4155       [["part_init"; "/dev/sda"; "mbr"];
4156        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4157     InitEmpty, Always, TestRun (
4158       [["part_init"; "/dev/sda"; "gpt"];
4159        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4160        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4161     InitEmpty, Always, TestRun (
4162       [["part_init"; "/dev/sda"; "mbr"];
4163        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4164        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4165        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4166        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4167    "add a partition to the device",
4168    "\
4169 This command adds a partition to C<device>.  If there is no partition
4170 table on the device, call C<guestfs_part_init> first.
4171
4172 The C<prlogex> parameter is the type of partition.  Normally you
4173 should pass C<p> or C<primary> here, but MBR partition tables also
4174 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4175 types.
4176
4177 C<startsect> and C<endsect> are the start and end of the partition
4178 in I<sectors>.  C<endsect> may be negative, which means it counts
4179 backwards from the end of the disk (C<-1> is the last sector).
4180
4181 Creating a partition which covers the whole disk is not so easy.
4182 Use C<guestfs_part_disk> to do that.");
4183
4184   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4185    [InitEmpty, Always, TestRun (
4186       [["part_disk"; "/dev/sda"; "mbr"]]);
4187     InitEmpty, Always, TestRun (
4188       [["part_disk"; "/dev/sda"; "gpt"]])],
4189    "partition whole disk with a single primary partition",
4190    "\
4191 This command is simply a combination of C<guestfs_part_init>
4192 followed by C<guestfs_part_add> to create a single primary partition
4193 covering the whole disk.
4194
4195 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4196 but other possible values are described in C<guestfs_part_init>.");
4197
4198   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4199    [InitEmpty, Always, TestRun (
4200       [["part_disk"; "/dev/sda"; "mbr"];
4201        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4202    "make a partition bootable",
4203    "\
4204 This sets the bootable flag on partition numbered C<partnum> on
4205 device C<device>.  Note that partitions are numbered from 1.
4206
4207 The bootable flag is used by some operating systems (notably
4208 Windows) to determine which partition to boot from.  It is by
4209 no means universally recognized.");
4210
4211   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4212    [InitEmpty, Always, TestRun (
4213       [["part_disk"; "/dev/sda"; "gpt"];
4214        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4215    "set partition name",
4216    "\
4217 This sets the partition name on partition numbered C<partnum> on
4218 device C<device>.  Note that partitions are numbered from 1.
4219
4220 The partition name can only be set on certain types of partition
4221 table.  This works on C<gpt> but not on C<mbr> partitions.");
4222
4223   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4224    [], (* XXX Add a regression test for this. *)
4225    "list partitions on a device",
4226    "\
4227 This command parses the partition table on C<device> and
4228 returns the list of partitions found.
4229
4230 The fields in the returned structure are:
4231
4232 =over 4
4233
4234 =item B<part_num>
4235
4236 Partition number, counting from 1.
4237
4238 =item B<part_start>
4239
4240 Start of the partition I<in bytes>.  To get sectors you have to
4241 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4242
4243 =item B<part_end>
4244
4245 End of the partition in bytes.
4246
4247 =item B<part_size>
4248
4249 Size of the partition in bytes.
4250
4251 =back");
4252
4253   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4254    [InitEmpty, Always, TestOutput (
4255       [["part_disk"; "/dev/sda"; "gpt"];
4256        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4257    "get the partition table type",
4258    "\
4259 This command examines the partition table on C<device> and
4260 returns the partition table type (format) being used.
4261
4262 Common return values include: C<msdos> (a DOS/Windows style MBR
4263 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4264 values are possible, although unusual.  See C<guestfs_part_init>
4265 for a full list.");
4266
4267   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4268    [InitBasicFS, Always, TestOutputBuffer (
4269       [["fill"; "0x63"; "10"; "/test"];
4270        ["read_file"; "/test"]], "cccccccccc")],
4271    "fill a file with octets",
4272    "\
4273 This command creates a new file called C<path>.  The initial
4274 content of the file is C<len> octets of C<c>, where C<c>
4275 must be a number in the range C<[0..255]>.
4276
4277 To fill a file with zero bytes (sparsely), it is
4278 much more efficient to use C<guestfs_truncate_size>.");
4279
4280   ("available", (RErr, [StringList "groups"]), 216, [],
4281    [InitNone, Always, TestRun [["available"; ""]]],
4282    "test availability of some parts of the API",
4283    "\
4284 This command is used to check the availability of some
4285 groups of functionality in the appliance, which not all builds of
4286 the libguestfs appliance will be able to provide.
4287
4288 The libguestfs groups, and the functions that those
4289 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4290
4291 The argument C<groups> is a list of group names, eg:
4292 C<[\"inotify\", \"augeas\"]> would check for the availability of
4293 the Linux inotify functions and Augeas (configuration file
4294 editing) functions.
4295
4296 The command returns no error if I<all> requested groups are available.
4297
4298 It fails with an error if one or more of the requested
4299 groups is unavailable in the appliance.
4300
4301 If an unknown group name is included in the
4302 list of groups then an error is always returned.
4303
4304 I<Notes:>
4305
4306 =over 4
4307
4308 =item *
4309
4310 You must call C<guestfs_launch> before calling this function.
4311
4312 The reason is because we don't know what groups are
4313 supported by the appliance/daemon until it is running and can
4314 be queried.
4315
4316 =item *
4317
4318 If a group of functions is available, this does not necessarily
4319 mean that they will work.  You still have to check for errors
4320 when calling individual API functions even if they are
4321 available.
4322
4323 =item *
4324
4325 It is usually the job of distro packagers to build
4326 complete functionality into the libguestfs appliance.
4327 Upstream libguestfs, if built from source with all
4328 requirements satisfied, will support everything.
4329
4330 =item *
4331
4332 This call was added in version C<1.0.80>.  In previous
4333 versions of libguestfs all you could do would be to speculatively
4334 execute a command to find out if the daemon implemented it.
4335 See also C<guestfs_version>.
4336
4337 =back");
4338
4339   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4340    [InitBasicFS, Always, TestOutputBuffer (
4341       [["write_file"; "/src"; "hello, world"; "0"];
4342        ["dd"; "/src"; "/dest"];
4343        ["read_file"; "/dest"]], "hello, world")],
4344    "copy from source to destination using dd",
4345    "\
4346 This command copies from one source device or file C<src>
4347 to another destination device or file C<dest>.  Normally you
4348 would use this to copy to or from a device or partition, for
4349 example to duplicate a filesystem.
4350
4351 If the destination is a device, it must be as large or larger
4352 than the source file or device, otherwise the copy will fail.
4353 This command cannot do partial copies (see C<guestfs_copy_size>).");
4354
4355   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4356    [InitBasicFS, Always, TestOutputInt (
4357       [["write_file"; "/file"; "hello, world"; "0"];
4358        ["filesize"; "/file"]], 12)],
4359    "return the size of the file in bytes",
4360    "\
4361 This command returns the size of C<file> in bytes.
4362
4363 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4364 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4365 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4366
4367   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4368    [InitBasicFSonLVM, Always, TestOutputList (
4369       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4370        ["lvs"]], ["/dev/VG/LV2"])],
4371    "rename an LVM logical volume",
4372    "\
4373 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4374
4375   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4376    [InitBasicFSonLVM, Always, TestOutputList (
4377       [["umount"; "/"];
4378        ["vg_activate"; "false"; "VG"];
4379        ["vgrename"; "VG"; "VG2"];
4380        ["vg_activate"; "true"; "VG2"];
4381        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4382        ["vgs"]], ["VG2"])],
4383    "rename an LVM volume group",
4384    "\
4385 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4386
4387   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4388    [InitISOFS, Always, TestOutputBuffer (
4389       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4390    "list the contents of a single file in an initrd",
4391    "\
4392 This command unpacks the file C<filename> from the initrd file
4393 called C<initrdpath>.  The filename must be given I<without> the
4394 initial C</> character.
4395
4396 For example, in guestfish you could use the following command
4397 to examine the boot script (usually called C</init>)
4398 contained in a Linux initrd or initramfs image:
4399
4400  initrd-cat /boot/initrd-<version>.img init
4401
4402 See also C<guestfs_initrd_list>.");
4403
4404   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4405    [],
4406    "get the UUID of a physical volume",
4407    "\
4408 This command returns the UUID of the LVM PV C<device>.");
4409
4410   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4411    [],
4412    "get the UUID of a volume group",
4413    "\
4414 This command returns the UUID of the LVM VG named C<vgname>.");
4415
4416   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4417    [],
4418    "get the UUID of a logical volume",
4419    "\
4420 This command returns the UUID of the LVM LV C<device>.");
4421
4422   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4423    [],
4424    "get the PV UUIDs containing the volume group",
4425    "\
4426 Given a VG called C<vgname>, this returns the UUIDs of all
4427 the physical volumes that this volume group resides on.
4428
4429 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4430 calls to associate physical volumes and volume groups.
4431
4432 See also C<guestfs_vglvuuids>.");
4433
4434   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4435    [],
4436    "get the LV UUIDs of all LVs in the volume group",
4437    "\
4438 Given a VG called C<vgname>, this returns the UUIDs of all
4439 the logical volumes created in this volume group.
4440
4441 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4442 calls to associate logical volumes and volume groups.
4443
4444 See also C<guestfs_vgpvuuids>.");
4445
4446   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4447    [InitBasicFS, Always, TestOutputBuffer (
4448       [["write_file"; "/src"; "hello, world"; "0"];
4449        ["copy_size"; "/src"; "/dest"; "5"];
4450        ["read_file"; "/dest"]], "hello")],
4451    "copy size bytes from source to destination using dd",
4452    "\
4453 This command copies exactly C<size> bytes from one source device
4454 or file C<src> to another destination device or file C<dest>.
4455
4456 Note this will fail if the source is too short or if the destination
4457 is not large enough.");
4458
4459   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4460    [InitEmpty, Always, TestRun (
4461       [["part_init"; "/dev/sda"; "mbr"];
4462        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4463        ["part_del"; "/dev/sda"; "1"]])],
4464    "delete a partition",
4465    "\
4466 This command deletes the partition numbered C<partnum> on C<device>.
4467
4468 Note that in the case of MBR partitioning, deleting an
4469 extended partition also deletes any logical partitions
4470 it contains.");
4471
4472   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4473    [InitEmpty, Always, TestOutputTrue (
4474       [["part_init"; "/dev/sda"; "mbr"];
4475        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4476        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4477        ["part_get_bootable"; "/dev/sda"; "1"]])],
4478    "return true if a partition is bootable",
4479    "\
4480 This command returns true if the partition C<partnum> on
4481 C<device> has the bootable flag set.
4482
4483 See also C<guestfs_part_set_bootable>.");
4484
4485   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4486    [InitEmpty, Always, TestOutputInt (
4487       [["part_init"; "/dev/sda"; "mbr"];
4488        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4489        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4490        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4491    "get the MBR type byte (ID byte) from a partition",
4492    "\
4493 Returns the MBR type byte (also known as the ID byte) from
4494 the numbered partition C<partnum>.
4495
4496 Note that only MBR (old DOS-style) partitions have type bytes.
4497 You will get undefined results for other partition table
4498 types (see C<guestfs_part_get_parttype>).");
4499
4500   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4501    [], (* tested by part_get_mbr_id *)
4502    "set the MBR type byte (ID byte) of a partition",
4503    "\
4504 Sets the MBR type byte (also known as the ID byte) of
4505 the numbered partition C<partnum> to C<idbyte>.  Note
4506 that the type bytes quoted in most documentation are
4507 in fact hexadecimal numbers, but usually documented
4508 without any leading \"0x\" which might be confusing.
4509
4510 Note that only MBR (old DOS-style) partitions have type bytes.
4511 You will get undefined results for other partition table
4512 types (see C<guestfs_part_get_parttype>).");
4513
4514 ]
4515
4516 let all_functions = non_daemon_functions @ daemon_functions
4517
4518 (* In some places we want the functions to be displayed sorted
4519  * alphabetically, so this is useful:
4520  *)
4521 let all_functions_sorted =
4522   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4523                compare n1 n2) all_functions
4524
4525 (* Field types for structures. *)
4526 type field =
4527   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4528   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4529   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4530   | FUInt32
4531   | FInt32
4532   | FUInt64
4533   | FInt64
4534   | FBytes                      (* Any int measure that counts bytes. *)
4535   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4536   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4537
4538 (* Because we generate extra parsing code for LVM command line tools,
4539  * we have to pull out the LVM columns separately here.
4540  *)
4541 let lvm_pv_cols = [
4542   "pv_name", FString;
4543   "pv_uuid", FUUID;
4544   "pv_fmt", FString;
4545   "pv_size", FBytes;
4546   "dev_size", FBytes;
4547   "pv_free", FBytes;
4548   "pv_used", FBytes;
4549   "pv_attr", FString (* XXX *);
4550   "pv_pe_count", FInt64;
4551   "pv_pe_alloc_count", FInt64;
4552   "pv_tags", FString;
4553   "pe_start", FBytes;
4554   "pv_mda_count", FInt64;
4555   "pv_mda_free", FBytes;
4556   (* Not in Fedora 10:
4557      "pv_mda_size", FBytes;
4558   *)
4559 ]
4560 let lvm_vg_cols = [
4561   "vg_name", FString;
4562   "vg_uuid", FUUID;
4563   "vg_fmt", FString;
4564   "vg_attr", FString (* XXX *);
4565   "vg_size", FBytes;
4566   "vg_free", FBytes;
4567   "vg_sysid", FString;
4568   "vg_extent_size", FBytes;
4569   "vg_extent_count", FInt64;
4570   "vg_free_count", FInt64;
4571   "max_lv", FInt64;
4572   "max_pv", FInt64;
4573   "pv_count", FInt64;
4574   "lv_count", FInt64;
4575   "snap_count", FInt64;
4576   "vg_seqno", FInt64;
4577   "vg_tags", FString;
4578   "vg_mda_count", FInt64;
4579   "vg_mda_free", FBytes;
4580   (* Not in Fedora 10:
4581      "vg_mda_size", FBytes;
4582   *)
4583 ]
4584 let lvm_lv_cols = [
4585   "lv_name", FString;
4586   "lv_uuid", FUUID;
4587   "lv_attr", FString (* XXX *);
4588   "lv_major", FInt64;
4589   "lv_minor", FInt64;
4590   "lv_kernel_major", FInt64;
4591   "lv_kernel_minor", FInt64;
4592   "lv_size", FBytes;
4593   "seg_count", FInt64;
4594   "origin", FString;
4595   "snap_percent", FOptPercent;
4596   "copy_percent", FOptPercent;
4597   "move_pv", FString;
4598   "lv_tags", FString;
4599   "mirror_log", FString;
4600   "modules", FString;
4601 ]
4602
4603 (* Names and fields in all structures (in RStruct and RStructList)
4604  * that we support.
4605  *)
4606 let structs = [
4607   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4608    * not use this struct in any new code.
4609    *)
4610   "int_bool", [
4611     "i", FInt32;                (* for historical compatibility *)
4612     "b", FInt32;                (* for historical compatibility *)
4613   ];
4614
4615   (* LVM PVs, VGs, LVs. *)
4616   "lvm_pv", lvm_pv_cols;
4617   "lvm_vg", lvm_vg_cols;
4618   "lvm_lv", lvm_lv_cols;
4619
4620   (* Column names and types from stat structures.
4621    * NB. Can't use things like 'st_atime' because glibc header files
4622    * define some of these as macros.  Ugh.
4623    *)
4624   "stat", [
4625     "dev", FInt64;
4626     "ino", FInt64;
4627     "mode", FInt64;
4628     "nlink", FInt64;
4629     "uid", FInt64;
4630     "gid", FInt64;
4631     "rdev", FInt64;
4632     "size", FInt64;
4633     "blksize", FInt64;
4634     "blocks", FInt64;
4635     "atime", FInt64;
4636     "mtime", FInt64;
4637     "ctime", FInt64;
4638   ];
4639   "statvfs", [
4640     "bsize", FInt64;
4641     "frsize", FInt64;
4642     "blocks", FInt64;
4643     "bfree", FInt64;
4644     "bavail", FInt64;
4645     "files", FInt64;
4646     "ffree", FInt64;
4647     "favail", FInt64;
4648     "fsid", FInt64;
4649     "flag", FInt64;
4650     "namemax", FInt64;
4651   ];
4652
4653   (* Column names in dirent structure. *)
4654   "dirent", [
4655     "ino", FInt64;
4656     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4657     "ftyp", FChar;
4658     "name", FString;
4659   ];
4660
4661   (* Version numbers. *)
4662   "version", [
4663     "major", FInt64;
4664     "minor", FInt64;
4665     "release", FInt64;
4666     "extra", FString;
4667   ];
4668
4669   (* Extended attribute. *)
4670   "xattr", [
4671     "attrname", FString;
4672     "attrval", FBuffer;
4673   ];
4674
4675   (* Inotify events. *)
4676   "inotify_event", [
4677     "in_wd", FInt64;
4678     "in_mask", FUInt32;
4679     "in_cookie", FUInt32;
4680     "in_name", FString;
4681   ];
4682
4683   (* Partition table entry. *)
4684   "partition", [
4685     "part_num", FInt32;
4686     "part_start", FBytes;
4687     "part_end", FBytes;
4688     "part_size", FBytes;
4689   ];
4690 ] (* end of structs *)
4691
4692 (* Ugh, Java has to be different ..
4693  * These names are also used by the Haskell bindings.
4694  *)
4695 let java_structs = [
4696   "int_bool", "IntBool";
4697   "lvm_pv", "PV";
4698   "lvm_vg", "VG";
4699   "lvm_lv", "LV";
4700   "stat", "Stat";
4701   "statvfs", "StatVFS";
4702   "dirent", "Dirent";
4703   "version", "Version";
4704   "xattr", "XAttr";
4705   "inotify_event", "INotifyEvent";
4706   "partition", "Partition";
4707 ]
4708
4709 (* What structs are actually returned. *)
4710 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4711
4712 (* Returns a list of RStruct/RStructList structs that are returned
4713  * by any function.  Each element of returned list is a pair:
4714  *
4715  * (structname, RStructOnly)
4716  *    == there exists function which returns RStruct (_, structname)
4717  * (structname, RStructListOnly)
4718  *    == there exists function which returns RStructList (_, structname)
4719  * (structname, RStructAndList)
4720  *    == there are functions returning both RStruct (_, structname)
4721  *                                      and RStructList (_, structname)
4722  *)
4723 let rstructs_used_by functions =
4724   (* ||| is a "logical OR" for rstructs_used_t *)
4725   let (|||) a b =
4726     match a, b with
4727     | RStructAndList, _
4728     | _, RStructAndList -> RStructAndList
4729     | RStructOnly, RStructListOnly
4730     | RStructListOnly, RStructOnly -> RStructAndList
4731     | RStructOnly, RStructOnly -> RStructOnly
4732     | RStructListOnly, RStructListOnly -> RStructListOnly
4733   in
4734
4735   let h = Hashtbl.create 13 in
4736
4737   (* if elem->oldv exists, update entry using ||| operator,
4738    * else just add elem->newv to the hash
4739    *)
4740   let update elem newv =
4741     try  let oldv = Hashtbl.find h elem in
4742          Hashtbl.replace h elem (newv ||| oldv)
4743     with Not_found -> Hashtbl.add h elem newv
4744   in
4745
4746   List.iter (
4747     fun (_, style, _, _, _, _, _) ->
4748       match fst style with
4749       | RStruct (_, structname) -> update structname RStructOnly
4750       | RStructList (_, structname) -> update structname RStructListOnly
4751       | _ -> ()
4752   ) functions;
4753
4754   (* return key->values as a list of (key,value) *)
4755   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4756
4757 (* Used for testing language bindings. *)
4758 type callt =
4759   | CallString of string
4760   | CallOptString of string option
4761   | CallStringList of string list
4762   | CallInt of int
4763   | CallInt64 of int64
4764   | CallBool of bool
4765
4766 (* Used to memoize the result of pod2text. *)
4767 let pod2text_memo_filename = "src/.pod2text.data"
4768 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4769   try
4770     let chan = open_in pod2text_memo_filename in
4771     let v = input_value chan in
4772     close_in chan;
4773     v
4774   with
4775     _ -> Hashtbl.create 13
4776 let pod2text_memo_updated () =
4777   let chan = open_out pod2text_memo_filename in
4778   output_value chan pod2text_memo;
4779   close_out chan
4780
4781 (* Useful functions.
4782  * Note we don't want to use any external OCaml libraries which
4783  * makes this a bit harder than it should be.
4784  *)
4785 module StringMap = Map.Make (String)
4786
4787 let failwithf fs = ksprintf failwith fs
4788
4789 let unique = let i = ref 0 in fun () -> incr i; !i
4790
4791 let replace_char s c1 c2 =
4792   let s2 = String.copy s in
4793   let r = ref false in
4794   for i = 0 to String.length s2 - 1 do
4795     if String.unsafe_get s2 i = c1 then (
4796       String.unsafe_set s2 i c2;
4797       r := true
4798     )
4799   done;
4800   if not !r then s else s2
4801
4802 let isspace c =
4803   c = ' '
4804   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4805
4806 let triml ?(test = isspace) str =
4807   let i = ref 0 in
4808   let n = ref (String.length str) in
4809   while !n > 0 && test str.[!i]; do
4810     decr n;
4811     incr i
4812   done;
4813   if !i = 0 then str
4814   else String.sub str !i !n
4815
4816 let trimr ?(test = isspace) str =
4817   let n = ref (String.length str) in
4818   while !n > 0 && test str.[!n-1]; do
4819     decr n
4820   done;
4821   if !n = String.length str then str
4822   else String.sub str 0 !n
4823
4824 let trim ?(test = isspace) str =
4825   trimr ~test (triml ~test str)
4826
4827 let rec find s sub =
4828   let len = String.length s in
4829   let sublen = String.length sub in
4830   let rec loop i =
4831     if i <= len-sublen then (
4832       let rec loop2 j =
4833         if j < sublen then (
4834           if s.[i+j] = sub.[j] then loop2 (j+1)
4835           else -1
4836         ) else
4837           i (* found *)
4838       in
4839       let r = loop2 0 in
4840       if r = -1 then loop (i+1) else r
4841     ) else
4842       -1 (* not found *)
4843   in
4844   loop 0
4845
4846 let rec replace_str s s1 s2 =
4847   let len = String.length s in
4848   let sublen = String.length s1 in
4849   let i = find s s1 in
4850   if i = -1 then s
4851   else (
4852     let s' = String.sub s 0 i in
4853     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4854     s' ^ s2 ^ replace_str s'' s1 s2
4855   )
4856
4857 let rec string_split sep str =
4858   let len = String.length str in
4859   let seplen = String.length sep in
4860   let i = find str sep in
4861   if i = -1 then [str]
4862   else (
4863     let s' = String.sub str 0 i in
4864     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4865     s' :: string_split sep s''
4866   )
4867
4868 let files_equal n1 n2 =
4869   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4870   match Sys.command cmd with
4871   | 0 -> true
4872   | 1 -> false
4873   | i -> failwithf "%s: failed with error code %d" cmd i
4874
4875 let rec filter_map f = function
4876   | [] -> []
4877   | x :: xs ->
4878       match f x with
4879       | Some y -> y :: filter_map f xs
4880       | None -> filter_map f xs
4881
4882 let rec find_map f = function
4883   | [] -> raise Not_found
4884   | x :: xs ->
4885       match f x with
4886       | Some y -> y
4887       | None -> find_map f xs
4888
4889 let iteri f xs =
4890   let rec loop i = function
4891     | [] -> ()
4892     | x :: xs -> f i x; loop (i+1) xs
4893   in
4894   loop 0 xs
4895
4896 let mapi f xs =
4897   let rec loop i = function
4898     | [] -> []
4899     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4900   in
4901   loop 0 xs
4902
4903 let count_chars c str =
4904   let count = ref 0 in
4905   for i = 0 to String.length str - 1 do
4906     if c = String.unsafe_get str i then incr count
4907   done;
4908   !count
4909
4910 let name_of_argt = function
4911   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4912   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4913   | FileIn n | FileOut n -> n
4914
4915 let java_name_of_struct typ =
4916   try List.assoc typ java_structs
4917   with Not_found ->
4918     failwithf
4919       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4920
4921 let cols_of_struct typ =
4922   try List.assoc typ structs
4923   with Not_found ->
4924     failwithf "cols_of_struct: unknown struct %s" typ
4925
4926 let seq_of_test = function
4927   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4928   | TestOutputListOfDevices (s, _)
4929   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4930   | TestOutputTrue s | TestOutputFalse s
4931   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4932   | TestOutputStruct (s, _)
4933   | TestLastFail s -> s
4934
4935 (* Handling for function flags. *)
4936 let protocol_limit_warning =
4937   "Because of the message protocol, there is a transfer limit
4938 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4939
4940 let danger_will_robinson =
4941   "B<This command is dangerous.  Without careful use you
4942 can easily destroy all your data>."
4943
4944 let deprecation_notice flags =
4945   try
4946     let alt =
4947       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4948     let txt =
4949       sprintf "This function is deprecated.
4950 In new code, use the C<%s> call instead.
4951
4952 Deprecated functions will not be removed from the API, but the
4953 fact that they are deprecated indicates that there are problems
4954 with correct use of these functions." alt in
4955     Some txt
4956   with
4957     Not_found -> None
4958
4959 (* Create list of optional groups. *)
4960 let optgroups =
4961   let h = Hashtbl.create 13 in
4962   List.iter (
4963     fun (name, _, _, flags, _, _, _) ->
4964       List.iter (
4965         function
4966         | Optional group ->
4967             let names = try Hashtbl.find h group with Not_found -> [] in
4968             Hashtbl.replace h group (name :: names)
4969         | _ -> ()
4970       ) flags
4971   ) daemon_functions;
4972   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4973   let groups =
4974     List.map (
4975       fun group -> group, List.sort compare (Hashtbl.find h group)
4976     ) groups in
4977   List.sort (fun x y -> compare (fst x) (fst y)) groups
4978
4979 (* Check function names etc. for consistency. *)
4980 let check_functions () =
4981   let contains_uppercase str =
4982     let len = String.length str in
4983     let rec loop i =
4984       if i >= len then false
4985       else (
4986         let c = str.[i] in
4987         if c >= 'A' && c <= 'Z' then true
4988         else loop (i+1)
4989       )
4990     in
4991     loop 0
4992   in
4993
4994   (* Check function names. *)
4995   List.iter (
4996     fun (name, _, _, _, _, _, _) ->
4997       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4998         failwithf "function name %s does not need 'guestfs' prefix" name;
4999       if name = "" then
5000         failwithf "function name is empty";
5001       if name.[0] < 'a' || name.[0] > 'z' then
5002         failwithf "function name %s must start with lowercase a-z" name;
5003       if String.contains name '-' then
5004         failwithf "function name %s should not contain '-', use '_' instead."
5005           name
5006   ) all_functions;
5007
5008   (* Check function parameter/return names. *)
5009   List.iter (
5010     fun (name, style, _, _, _, _, _) ->
5011       let check_arg_ret_name n =
5012         if contains_uppercase n then
5013           failwithf "%s param/ret %s should not contain uppercase chars"
5014             name n;
5015         if String.contains n '-' || String.contains n '_' then
5016           failwithf "%s param/ret %s should not contain '-' or '_'"
5017             name n;
5018         if n = "value" then
5019           failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
5020         if n = "int" || n = "char" || n = "short" || n = "long" then
5021           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5022         if n = "i" || n = "n" then
5023           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5024         if n = "argv" || n = "args" then
5025           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5026
5027         (* List Haskell, OCaml and C keywords here.
5028          * http://www.haskell.org/haskellwiki/Keywords
5029          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5030          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5031          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5032          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5033          * Omitting _-containing words, since they're handled above.
5034          * Omitting the OCaml reserved word, "val", is ok,
5035          * and saves us from renaming several parameters.
5036          *)
5037         let reserved = [
5038           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5039           "char"; "class"; "const"; "constraint"; "continue"; "data";
5040           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5041           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5042           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5043           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5044           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5045           "interface";
5046           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5047           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5048           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5049           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5050           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5051           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5052           "volatile"; "when"; "where"; "while";
5053           ] in
5054         if List.mem n reserved then
5055           failwithf "%s has param/ret using reserved word %s" name n;
5056       in
5057
5058       (match fst style with
5059        | RErr -> ()
5060        | RInt n | RInt64 n | RBool n
5061        | RConstString n | RConstOptString n | RString n
5062        | RStringList n | RStruct (n, _) | RStructList (n, _)
5063        | RHashtable n | RBufferOut n ->
5064            check_arg_ret_name n
5065       );
5066       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5067   ) all_functions;
5068
5069   (* Check short descriptions. *)
5070   List.iter (
5071     fun (name, _, _, _, _, shortdesc, _) ->
5072       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5073         failwithf "short description of %s should begin with lowercase." name;
5074       let c = shortdesc.[String.length shortdesc-1] in
5075       if c = '\n' || c = '.' then
5076         failwithf "short description of %s should not end with . or \\n." name
5077   ) all_functions;
5078
5079   (* Check long descriptions. *)
5080   List.iter (
5081     fun (name, _, _, _, _, _, longdesc) ->
5082       if longdesc.[String.length longdesc-1] = '\n' then
5083         failwithf "long description of %s should not end with \\n." name
5084   ) all_functions;
5085
5086   (* Check proc_nrs. *)
5087   List.iter (
5088     fun (name, _, proc_nr, _, _, _, _) ->
5089       if proc_nr <= 0 then
5090         failwithf "daemon function %s should have proc_nr > 0" name
5091   ) daemon_functions;
5092
5093   List.iter (
5094     fun (name, _, proc_nr, _, _, _, _) ->
5095       if proc_nr <> -1 then
5096         failwithf "non-daemon function %s should have proc_nr -1" name
5097   ) non_daemon_functions;
5098
5099   let proc_nrs =
5100     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5101       daemon_functions in
5102   let proc_nrs =
5103     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5104   let rec loop = function
5105     | [] -> ()
5106     | [_] -> ()
5107     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5108         loop rest
5109     | (name1,nr1) :: (name2,nr2) :: _ ->
5110         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5111           name1 name2 nr1 nr2
5112   in
5113   loop proc_nrs;
5114
5115   (* Check tests. *)
5116   List.iter (
5117     function
5118       (* Ignore functions that have no tests.  We generate a
5119        * warning when the user does 'make check' instead.
5120        *)
5121     | name, _, _, _, [], _, _ -> ()
5122     | name, _, _, _, tests, _, _ ->
5123         let funcs =
5124           List.map (
5125             fun (_, _, test) ->
5126               match seq_of_test test with
5127               | [] ->
5128                   failwithf "%s has a test containing an empty sequence" name
5129               | cmds -> List.map List.hd cmds
5130           ) tests in
5131         let funcs = List.flatten funcs in
5132
5133         let tested = List.mem name funcs in
5134
5135         if not tested then
5136           failwithf "function %s has tests but does not test itself" name
5137   ) all_functions
5138
5139 (* 'pr' prints to the current output file. *)
5140 let chan = ref Pervasives.stdout
5141 let lines = ref 0
5142 let pr fs =
5143   ksprintf
5144     (fun str ->
5145        let i = count_chars '\n' str in
5146        lines := !lines + i;
5147        output_string !chan str
5148     ) fs
5149
5150 let copyright_years =
5151   let this_year = 1900 + (localtime (time ())).tm_year in
5152   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5153
5154 (* Generate a header block in a number of standard styles. *)
5155 type comment_style =
5156     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5157 type license = GPLv2plus | LGPLv2plus
5158
5159 let generate_header ?(extra_inputs = []) comment license =
5160   let inputs = "src/generator.ml" :: extra_inputs in
5161   let c = match comment with
5162     | CStyle ->         pr "/* "; " *"
5163     | CPlusPlusStyle -> pr "// "; "//"
5164     | HashStyle ->      pr "# ";  "#"
5165     | OCamlStyle ->     pr "(* "; " *"
5166     | HaskellStyle ->   pr "{- "; "  " in
5167   pr "libguestfs generated file\n";
5168   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5169   List.iter (pr "%s   %s\n" c) inputs;
5170   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5171   pr "%s\n" c;
5172   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5173   pr "%s\n" c;
5174   (match license with
5175    | GPLv2plus ->
5176        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5177        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5178        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5179        pr "%s (at your option) any later version.\n" c;
5180        pr "%s\n" c;
5181        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5182        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5183        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5184        pr "%s GNU General Public License for more details.\n" c;
5185        pr "%s\n" c;
5186        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5187        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5188        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5189
5190    | LGPLv2plus ->
5191        pr "%s This library is free software; you can redistribute it and/or\n" c;
5192        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5193        pr "%s License as published by the Free Software Foundation; either\n" c;
5194        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5195        pr "%s\n" c;
5196        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5197        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5198        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5199        pr "%s Lesser General Public License for more details.\n" c;
5200        pr "%s\n" c;
5201        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5202        pr "%s License along with this library; if not, write to the Free Software\n" c;
5203        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5204   );
5205   (match comment with
5206    | CStyle -> pr " */\n"
5207    | CPlusPlusStyle
5208    | HashStyle -> ()
5209    | OCamlStyle -> pr " *)\n"
5210    | HaskellStyle -> pr "-}\n"
5211   );
5212   pr "\n"
5213
5214 (* Start of main code generation functions below this line. *)
5215
5216 (* Generate the pod documentation for the C API. *)
5217 let rec generate_actions_pod () =
5218   List.iter (
5219     fun (shortname, style, _, flags, _, _, longdesc) ->
5220       if not (List.mem NotInDocs flags) then (
5221         let name = "guestfs_" ^ shortname in
5222         pr "=head2 %s\n\n" name;
5223         pr " ";
5224         generate_prototype ~extern:false ~handle:"g" name style;
5225         pr "\n\n";
5226         pr "%s\n\n" longdesc;
5227         (match fst style with
5228          | RErr ->
5229              pr "This function returns 0 on success or -1 on error.\n\n"
5230          | RInt _ ->
5231              pr "On error this function returns -1.\n\n"
5232          | RInt64 _ ->
5233              pr "On error this function returns -1.\n\n"
5234          | RBool _ ->
5235              pr "This function returns a C truth value on success or -1 on error.\n\n"
5236          | RConstString _ ->
5237              pr "This function returns a string, or NULL on error.
5238 The string is owned by the guest handle and must I<not> be freed.\n\n"
5239          | RConstOptString _ ->
5240              pr "This function returns a string which may be NULL.
5241 There is way to return an error from this function.
5242 The string is owned by the guest handle and must I<not> be freed.\n\n"
5243          | RString _ ->
5244              pr "This function returns a string, or NULL on error.
5245 I<The caller must free the returned string after use>.\n\n"
5246          | RStringList _ ->
5247              pr "This function returns a NULL-terminated array of strings
5248 (like L<environ(3)>), or NULL if there was an error.
5249 I<The caller must free the strings and the array after use>.\n\n"
5250          | RStruct (_, typ) ->
5251              pr "This function returns a C<struct guestfs_%s *>,
5252 or NULL if there was an error.
5253 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5254          | RStructList (_, typ) ->
5255              pr "This function returns a C<struct guestfs_%s_list *>
5256 (see E<lt>guestfs-structs.hE<gt>),
5257 or NULL if there was an error.
5258 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5259          | RHashtable _ ->
5260              pr "This function returns a NULL-terminated array of
5261 strings, or NULL if there was an error.
5262 The array of strings will always have length C<2n+1>, where
5263 C<n> keys and values alternate, followed by the trailing NULL entry.
5264 I<The caller must free the strings and the array after use>.\n\n"
5265          | RBufferOut _ ->
5266              pr "This function returns a buffer, or NULL on error.
5267 The size of the returned buffer is written to C<*size_r>.
5268 I<The caller must free the returned buffer after use>.\n\n"
5269         );
5270         if List.mem ProtocolLimitWarning flags then
5271           pr "%s\n\n" protocol_limit_warning;
5272         if List.mem DangerWillRobinson flags then
5273           pr "%s\n\n" danger_will_robinson;
5274         match deprecation_notice flags with
5275         | None -> ()
5276         | Some txt -> pr "%s\n\n" txt
5277       )
5278   ) all_functions_sorted
5279
5280 and generate_structs_pod () =
5281   (* Structs documentation. *)
5282   List.iter (
5283     fun (typ, cols) ->
5284       pr "=head2 guestfs_%s\n" typ;
5285       pr "\n";
5286       pr " struct guestfs_%s {\n" typ;
5287       List.iter (
5288         function
5289         | name, FChar -> pr "   char %s;\n" name
5290         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5291         | name, FInt32 -> pr "   int32_t %s;\n" name
5292         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5293         | name, FInt64 -> pr "   int64_t %s;\n" name
5294         | name, FString -> pr "   char *%s;\n" name
5295         | name, FBuffer ->
5296             pr "   /* The next two fields describe a byte array. */\n";
5297             pr "   uint32_t %s_len;\n" name;
5298             pr "   char *%s;\n" name
5299         | name, FUUID ->
5300             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5301             pr "   char %s[32];\n" name
5302         | name, FOptPercent ->
5303             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5304             pr "   float %s;\n" name
5305       ) cols;
5306       pr " };\n";
5307       pr " \n";
5308       pr " struct guestfs_%s_list {\n" typ;
5309       pr "   uint32_t len; /* Number of elements in list. */\n";
5310       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5311       pr " };\n";
5312       pr " \n";
5313       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5314       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5315         typ typ;
5316       pr "\n"
5317   ) structs
5318
5319 and generate_availability_pod () =
5320   (* Availability documentation. *)
5321   pr "=over 4\n";
5322   pr "\n";
5323   List.iter (
5324     fun (group, functions) ->
5325       pr "=item B<%s>\n" group;
5326       pr "\n";
5327       pr "The following functions:\n";
5328       List.iter (pr "L</guestfs_%s>\n") functions;
5329       pr "\n"
5330   ) optgroups;
5331   pr "=back\n";
5332   pr "\n"
5333
5334 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5335  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5336  *
5337  * We have to use an underscore instead of a dash because otherwise
5338  * rpcgen generates incorrect code.
5339  *
5340  * This header is NOT exported to clients, but see also generate_structs_h.
5341  *)
5342 and generate_xdr () =
5343   generate_header CStyle LGPLv2plus;
5344
5345   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5346   pr "typedef string str<>;\n";
5347   pr "\n";
5348
5349   (* Internal structures. *)
5350   List.iter (
5351     function
5352     | typ, cols ->
5353         pr "struct guestfs_int_%s {\n" typ;
5354         List.iter (function
5355                    | name, FChar -> pr "  char %s;\n" name
5356                    | name, FString -> pr "  string %s<>;\n" name
5357                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5358                    | name, FUUID -> pr "  opaque %s[32];\n" name
5359                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5360                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5361                    | name, FOptPercent -> pr "  float %s;\n" name
5362                   ) cols;
5363         pr "};\n";
5364         pr "\n";
5365         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5366         pr "\n";
5367   ) structs;
5368
5369   List.iter (
5370     fun (shortname, style, _, _, _, _, _) ->
5371       let name = "guestfs_" ^ shortname in
5372
5373       (match snd style with
5374        | [] -> ()
5375        | args ->
5376            pr "struct %s_args {\n" name;
5377            List.iter (
5378              function
5379              | Pathname n | Device n | Dev_or_Path n | String n ->
5380                  pr "  string %s<>;\n" n
5381              | OptString n -> pr "  str *%s;\n" n
5382              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5383              | Bool n -> pr "  bool %s;\n" n
5384              | Int n -> pr "  int %s;\n" n
5385              | Int64 n -> pr "  hyper %s;\n" n
5386              | FileIn _ | FileOut _ -> ()
5387            ) args;
5388            pr "};\n\n"
5389       );
5390       (match fst style with
5391        | RErr -> ()
5392        | RInt n ->
5393            pr "struct %s_ret {\n" name;
5394            pr "  int %s;\n" n;
5395            pr "};\n\n"
5396        | RInt64 n ->
5397            pr "struct %s_ret {\n" name;
5398            pr "  hyper %s;\n" n;
5399            pr "};\n\n"
5400        | RBool n ->
5401            pr "struct %s_ret {\n" name;
5402            pr "  bool %s;\n" n;
5403            pr "};\n\n"
5404        | RConstString _ | RConstOptString _ ->
5405            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5406        | RString n ->
5407            pr "struct %s_ret {\n" name;
5408            pr "  string %s<>;\n" n;
5409            pr "};\n\n"
5410        | RStringList n ->
5411            pr "struct %s_ret {\n" name;
5412            pr "  str %s<>;\n" n;
5413            pr "};\n\n"
5414        | RStruct (n, typ) ->
5415            pr "struct %s_ret {\n" name;
5416            pr "  guestfs_int_%s %s;\n" typ n;
5417            pr "};\n\n"
5418        | RStructList (n, typ) ->
5419            pr "struct %s_ret {\n" name;
5420            pr "  guestfs_int_%s_list %s;\n" typ n;
5421            pr "};\n\n"
5422        | RHashtable n ->
5423            pr "struct %s_ret {\n" name;
5424            pr "  str %s<>;\n" n;
5425            pr "};\n\n"
5426        | RBufferOut n ->
5427            pr "struct %s_ret {\n" name;
5428            pr "  opaque %s<>;\n" n;
5429            pr "};\n\n"
5430       );
5431   ) daemon_functions;
5432
5433   (* Table of procedure numbers. *)
5434   pr "enum guestfs_procedure {\n";
5435   List.iter (
5436     fun (shortname, _, proc_nr, _, _, _, _) ->
5437       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5438   ) daemon_functions;
5439   pr "  GUESTFS_PROC_NR_PROCS\n";
5440   pr "};\n";
5441   pr "\n";
5442
5443   (* Having to choose a maximum message size is annoying for several
5444    * reasons (it limits what we can do in the API), but it (a) makes
5445    * the protocol a lot simpler, and (b) provides a bound on the size
5446    * of the daemon which operates in limited memory space.
5447    *)
5448   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5449   pr "\n";
5450
5451   (* Message header, etc. *)
5452   pr "\
5453 /* The communication protocol is now documented in the guestfs(3)
5454  * manpage.
5455  */
5456
5457 const GUESTFS_PROGRAM = 0x2000F5F5;
5458 const GUESTFS_PROTOCOL_VERSION = 1;
5459
5460 /* These constants must be larger than any possible message length. */
5461 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5462 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5463
5464 enum guestfs_message_direction {
5465   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5466   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5467 };
5468
5469 enum guestfs_message_status {
5470   GUESTFS_STATUS_OK = 0,
5471   GUESTFS_STATUS_ERROR = 1
5472 };
5473
5474 const GUESTFS_ERROR_LEN = 256;
5475
5476 struct guestfs_message_error {
5477   string error_message<GUESTFS_ERROR_LEN>;
5478 };
5479
5480 struct guestfs_message_header {
5481   unsigned prog;                     /* GUESTFS_PROGRAM */
5482   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5483   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5484   guestfs_message_direction direction;
5485   unsigned serial;                   /* message serial number */
5486   guestfs_message_status status;
5487 };
5488
5489 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5490
5491 struct guestfs_chunk {
5492   int cancel;                        /* if non-zero, transfer is cancelled */
5493   /* data size is 0 bytes if the transfer has finished successfully */
5494   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5495 };
5496 "
5497
5498 (* Generate the guestfs-structs.h file. *)
5499 and generate_structs_h () =
5500   generate_header CStyle LGPLv2plus;
5501
5502   (* This is a public exported header file containing various
5503    * structures.  The structures are carefully written to have
5504    * exactly the same in-memory format as the XDR structures that
5505    * we use on the wire to the daemon.  The reason for creating
5506    * copies of these structures here is just so we don't have to
5507    * export the whole of guestfs_protocol.h (which includes much
5508    * unrelated and XDR-dependent stuff that we don't want to be
5509    * public, or required by clients).
5510    *
5511    * To reiterate, we will pass these structures to and from the
5512    * client with a simple assignment or memcpy, so the format
5513    * must be identical to what rpcgen / the RFC defines.
5514    *)
5515
5516   (* Public structures. *)
5517   List.iter (
5518     fun (typ, cols) ->
5519       pr "struct guestfs_%s {\n" typ;
5520       List.iter (
5521         function
5522         | name, FChar -> pr "  char %s;\n" name
5523         | name, FString -> pr "  char *%s;\n" name
5524         | name, FBuffer ->
5525             pr "  uint32_t %s_len;\n" name;
5526             pr "  char *%s;\n" name
5527         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5528         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5529         | name, FInt32 -> pr "  int32_t %s;\n" name
5530         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5531         | name, FInt64 -> pr "  int64_t %s;\n" name
5532         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5533       ) cols;
5534       pr "};\n";
5535       pr "\n";
5536       pr "struct guestfs_%s_list {\n" typ;
5537       pr "  uint32_t len;\n";
5538       pr "  struct guestfs_%s *val;\n" typ;
5539       pr "};\n";
5540       pr "\n";
5541       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5542       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5543       pr "\n"
5544   ) structs
5545
5546 (* Generate the guestfs-actions.h file. *)
5547 and generate_actions_h () =
5548   generate_header CStyle LGPLv2plus;
5549   List.iter (
5550     fun (shortname, style, _, _, _, _, _) ->
5551       let name = "guestfs_" ^ shortname in
5552       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5553         name style
5554   ) all_functions
5555
5556 (* Generate the guestfs-internal-actions.h file. *)
5557 and generate_internal_actions_h () =
5558   generate_header CStyle LGPLv2plus;
5559   List.iter (
5560     fun (shortname, style, _, _, _, _, _) ->
5561       let name = "guestfs__" ^ shortname in
5562       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5563         name style
5564   ) non_daemon_functions
5565
5566 (* Generate the client-side dispatch stubs. *)
5567 and generate_client_actions () =
5568   generate_header CStyle LGPLv2plus;
5569
5570   pr "\
5571 #include <stdio.h>
5572 #include <stdlib.h>
5573 #include <stdint.h>
5574 #include <string.h>
5575 #include <inttypes.h>
5576
5577 #include \"guestfs.h\"
5578 #include \"guestfs-internal.h\"
5579 #include \"guestfs-internal-actions.h\"
5580 #include \"guestfs_protocol.h\"
5581
5582 #define error guestfs_error
5583 //#define perrorf guestfs_perrorf
5584 #define safe_malloc guestfs_safe_malloc
5585 #define safe_realloc guestfs_safe_realloc
5586 //#define safe_strdup guestfs_safe_strdup
5587 #define safe_memdup guestfs_safe_memdup
5588
5589 /* Check the return message from a call for validity. */
5590 static int
5591 check_reply_header (guestfs_h *g,
5592                     const struct guestfs_message_header *hdr,
5593                     unsigned int proc_nr, unsigned int serial)
5594 {
5595   if (hdr->prog != GUESTFS_PROGRAM) {
5596     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5597     return -1;
5598   }
5599   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5600     error (g, \"wrong protocol version (%%d/%%d)\",
5601            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5602     return -1;
5603   }
5604   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5605     error (g, \"unexpected message direction (%%d/%%d)\",
5606            hdr->direction, GUESTFS_DIRECTION_REPLY);
5607     return -1;
5608   }
5609   if (hdr->proc != proc_nr) {
5610     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5611     return -1;
5612   }
5613   if (hdr->serial != serial) {
5614     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5615     return -1;
5616   }
5617
5618   return 0;
5619 }
5620
5621 /* Check we are in the right state to run a high-level action. */
5622 static int
5623 check_state (guestfs_h *g, const char *caller)
5624 {
5625   if (!guestfs__is_ready (g)) {
5626     if (guestfs__is_config (g) || guestfs__is_launching (g))
5627       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5628         caller);
5629     else
5630       error (g, \"%%s called from the wrong state, %%d != READY\",
5631         caller, guestfs__get_state (g));
5632     return -1;
5633   }
5634   return 0;
5635 }
5636
5637 ";
5638
5639   (* Generate code to generate guestfish call traces. *)
5640   let trace_call shortname style =
5641     pr "  if (guestfs__get_trace (g)) {\n";
5642
5643     let needs_i =
5644       List.exists (function
5645                    | StringList _ | DeviceList _ -> true
5646                    | _ -> false) (snd style) in
5647     if needs_i then (
5648       pr "    int i;\n";
5649       pr "\n"
5650     );
5651
5652     pr "    printf (\"%s\");\n" shortname;
5653     List.iter (
5654       function
5655       | String n                        (* strings *)
5656       | Device n
5657       | Pathname n
5658       | Dev_or_Path n
5659       | FileIn n
5660       | FileOut n ->
5661           (* guestfish doesn't support string escaping, so neither do we *)
5662           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5663       | OptString n ->                  (* string option *)
5664           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5665           pr "    else printf (\" null\");\n"
5666       | StringList n
5667       | DeviceList n ->                 (* string list *)
5668           pr "    putchar (' ');\n";
5669           pr "    putchar ('\"');\n";
5670           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5671           pr "      if (i > 0) putchar (' ');\n";
5672           pr "      fputs (%s[i], stdout);\n" n;
5673           pr "    }\n";
5674           pr "    putchar ('\"');\n";
5675       | Bool n ->                       (* boolean *)
5676           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5677       | Int n ->                        (* int *)
5678           pr "    printf (\" %%d\", %s);\n" n
5679       | Int64 n ->
5680           pr "    printf (\" %%\" PRIi64, %s);\n" n
5681     ) (snd style);
5682     pr "    putchar ('\\n');\n";
5683     pr "  }\n";
5684     pr "\n";
5685   in
5686
5687   (* For non-daemon functions, generate a wrapper around each function. *)
5688   List.iter (
5689     fun (shortname, style, _, _, _, _, _) ->
5690       let name = "guestfs_" ^ shortname in
5691
5692       generate_prototype ~extern:false ~semicolon:false ~newline:true
5693         ~handle:"g" name style;
5694       pr "{\n";
5695       trace_call shortname style;
5696       pr "  return guestfs__%s " shortname;
5697       generate_c_call_args ~handle:"g" style;
5698       pr ";\n";
5699       pr "}\n";
5700       pr "\n"
5701   ) non_daemon_functions;
5702
5703   (* Client-side stubs for each function. *)
5704   List.iter (
5705     fun (shortname, style, _, _, _, _, _) ->
5706       let name = "guestfs_" ^ shortname in
5707
5708       (* Generate the action stub. *)
5709       generate_prototype ~extern:false ~semicolon:false ~newline:true
5710         ~handle:"g" name style;
5711
5712       let error_code =
5713         match fst style with
5714         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5715         | RConstString _ | RConstOptString _ ->
5716             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5717         | RString _ | RStringList _
5718         | RStruct _ | RStructList _
5719         | RHashtable _ | RBufferOut _ ->
5720             "NULL" in
5721
5722       pr "{\n";
5723
5724       (match snd style with
5725        | [] -> ()
5726        | _ -> pr "  struct %s_args args;\n" name
5727       );
5728
5729       pr "  guestfs_message_header hdr;\n";
5730       pr "  guestfs_message_error err;\n";
5731       let has_ret =
5732         match fst style with
5733         | RErr -> false
5734         | RConstString _ | RConstOptString _ ->
5735             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5736         | RInt _ | RInt64 _
5737         | RBool _ | RString _ | RStringList _
5738         | RStruct _ | RStructList _
5739         | RHashtable _ | RBufferOut _ ->
5740             pr "  struct %s_ret ret;\n" name;
5741             true in
5742
5743       pr "  int serial;\n";
5744       pr "  int r;\n";
5745       pr "\n";
5746       trace_call shortname style;
5747       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5748       pr "  guestfs___set_busy (g);\n";
5749       pr "\n";
5750
5751       (* Send the main header and arguments. *)
5752       (match snd style with
5753        | [] ->
5754            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5755              (String.uppercase shortname)
5756        | args ->
5757            List.iter (
5758              function
5759              | Pathname n | Device n | Dev_or_Path n | String n ->
5760                  pr "  args.%s = (char *) %s;\n" n n
5761              | OptString n ->
5762                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5763              | StringList n | DeviceList n ->
5764                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5765                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5766              | Bool n ->
5767                  pr "  args.%s = %s;\n" n n
5768              | Int n ->
5769                  pr "  args.%s = %s;\n" n n
5770              | Int64 n ->
5771                  pr "  args.%s = %s;\n" n n
5772              | FileIn _ | FileOut _ -> ()
5773            ) args;
5774            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5775              (String.uppercase shortname);
5776            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5777              name;
5778       );
5779       pr "  if (serial == -1) {\n";
5780       pr "    guestfs___end_busy (g);\n";
5781       pr "    return %s;\n" error_code;
5782       pr "  }\n";
5783       pr "\n";
5784
5785       (* Send any additional files (FileIn) requested. *)
5786       let need_read_reply_label = ref false in
5787       List.iter (
5788         function
5789         | FileIn n ->
5790             pr "  r = guestfs___send_file (g, %s);\n" n;
5791             pr "  if (r == -1) {\n";
5792             pr "    guestfs___end_busy (g);\n";
5793             pr "    return %s;\n" error_code;
5794             pr "  }\n";
5795             pr "  if (r == -2) /* daemon cancelled */\n";
5796             pr "    goto read_reply;\n";
5797             need_read_reply_label := true;
5798             pr "\n";
5799         | _ -> ()
5800       ) (snd style);
5801
5802       (* Wait for the reply from the remote end. *)
5803       if !need_read_reply_label then pr " read_reply:\n";
5804       pr "  memset (&hdr, 0, sizeof hdr);\n";
5805       pr "  memset (&err, 0, sizeof err);\n";
5806       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5807       pr "\n";
5808       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5809       if not has_ret then
5810         pr "NULL, NULL"
5811       else
5812         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5813       pr ");\n";
5814
5815       pr "  if (r == -1) {\n";
5816       pr "    guestfs___end_busy (g);\n";
5817       pr "    return %s;\n" error_code;
5818       pr "  }\n";
5819       pr "\n";
5820
5821       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5822         (String.uppercase shortname);
5823       pr "    guestfs___end_busy (g);\n";
5824       pr "    return %s;\n" error_code;
5825       pr "  }\n";
5826       pr "\n";
5827
5828       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5829       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5830       pr "    free (err.error_message);\n";
5831       pr "    guestfs___end_busy (g);\n";
5832       pr "    return %s;\n" error_code;
5833       pr "  }\n";
5834       pr "\n";
5835
5836       (* Expecting to receive further files (FileOut)? *)
5837       List.iter (
5838         function
5839         | FileOut n ->
5840             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5841             pr "    guestfs___end_busy (g);\n";
5842             pr "    return %s;\n" error_code;
5843             pr "  }\n";
5844             pr "\n";
5845         | _ -> ()
5846       ) (snd style);
5847
5848       pr "  guestfs___end_busy (g);\n";
5849
5850       (match fst style with
5851        | RErr -> pr "  return 0;\n"
5852        | RInt n | RInt64 n | RBool n ->
5853            pr "  return ret.%s;\n" n
5854        | RConstString _ | RConstOptString _ ->
5855            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5856        | RString n ->
5857            pr "  return ret.%s; /* caller will free */\n" n
5858        | RStringList n | RHashtable n ->
5859            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5860            pr "  ret.%s.%s_val =\n" n n;
5861            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5862            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5863              n n;
5864            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5865            pr "  return ret.%s.%s_val;\n" n n
5866        | RStruct (n, _) ->
5867            pr "  /* caller will free this */\n";
5868            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5869        | RStructList (n, _) ->
5870            pr "  /* caller will free this */\n";
5871            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5872        | RBufferOut n ->
5873            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5874            pr "   * _val might be NULL here.  To make the API saner for\n";
5875            pr "   * callers, we turn this case into a unique pointer (using\n";
5876            pr "   * malloc(1)).\n";
5877            pr "   */\n";
5878            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5879            pr "    *size_r = ret.%s.%s_len;\n" n n;
5880            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5881            pr "  } else {\n";
5882            pr "    free (ret.%s.%s_val);\n" n n;
5883            pr "    char *p = safe_malloc (g, 1);\n";
5884            pr "    *size_r = ret.%s.%s_len;\n" n n;
5885            pr "    return p;\n";
5886            pr "  }\n";
5887       );
5888
5889       pr "}\n\n"
5890   ) daemon_functions;
5891
5892   (* Functions to free structures. *)
5893   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5894   pr " * structure format is identical to the XDR format.  See note in\n";
5895   pr " * generator.ml.\n";
5896   pr " */\n";
5897   pr "\n";
5898
5899   List.iter (
5900     fun (typ, _) ->
5901       pr "void\n";
5902       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5903       pr "{\n";
5904       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5905       pr "  free (x);\n";
5906       pr "}\n";
5907       pr "\n";
5908
5909       pr "void\n";
5910       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5911       pr "{\n";
5912       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5913       pr "  free (x);\n";
5914       pr "}\n";
5915       pr "\n";
5916
5917   ) structs;
5918
5919 (* Generate daemon/actions.h. *)
5920 and generate_daemon_actions_h () =
5921   generate_header CStyle GPLv2plus;
5922
5923   pr "#include \"../src/guestfs_protocol.h\"\n";
5924   pr "\n";
5925
5926   List.iter (
5927     fun (name, style, _, _, _, _, _) ->
5928       generate_prototype
5929         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5930         name style;
5931   ) daemon_functions
5932
5933 (* Generate the linker script which controls the visibility of
5934  * symbols in the public ABI and ensures no other symbols get
5935  * exported accidentally.
5936  *)
5937 and generate_linker_script () =
5938   generate_header HashStyle GPLv2plus;
5939
5940   let globals = [
5941     "guestfs_create";
5942     "guestfs_close";
5943     "guestfs_get_error_handler";
5944     "guestfs_get_out_of_memory_handler";
5945     "guestfs_last_error";
5946     "guestfs_set_error_handler";
5947     "guestfs_set_launch_done_callback";
5948     "guestfs_set_log_message_callback";
5949     "guestfs_set_out_of_memory_handler";
5950     "guestfs_set_subprocess_quit_callback";
5951
5952     (* Unofficial parts of the API: the bindings code use these
5953      * functions, so it is useful to export them.
5954      *)
5955     "guestfs_safe_calloc";
5956     "guestfs_safe_malloc";
5957     "guestfs_safe_strdup";
5958     "guestfs_safe_memdup";
5959   ] in
5960   let functions =
5961     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5962       all_functions in
5963   let structs =
5964     List.concat (
5965       List.map (fun (typ, _) ->
5966                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5967         structs
5968     ) in
5969   let globals = List.sort compare (globals @ functions @ structs) in
5970
5971   pr "{\n";
5972   pr "    global:\n";
5973   List.iter (pr "        %s;\n") globals;
5974   pr "\n";
5975
5976   pr "    local:\n";
5977   pr "        *;\n";
5978   pr "};\n"
5979
5980 (* Generate the server-side stubs. *)
5981 and generate_daemon_actions () =
5982   generate_header CStyle GPLv2plus;
5983
5984   pr "#include <config.h>\n";
5985   pr "\n";
5986   pr "#include <stdio.h>\n";
5987   pr "#include <stdlib.h>\n";
5988   pr "#include <string.h>\n";
5989   pr "#include <inttypes.h>\n";
5990   pr "#include <rpc/types.h>\n";
5991   pr "#include <rpc/xdr.h>\n";
5992   pr "\n";
5993   pr "#include \"daemon.h\"\n";
5994   pr "#include \"c-ctype.h\"\n";
5995   pr "#include \"../src/guestfs_protocol.h\"\n";
5996   pr "#include \"actions.h\"\n";
5997   pr "\n";
5998
5999   List.iter (
6000     fun (name, style, _, _, _, _, _) ->
6001       (* Generate server-side stubs. *)
6002       pr "static void %s_stub (XDR *xdr_in)\n" name;
6003       pr "{\n";
6004       let error_code =
6005         match fst style with
6006         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6007         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6008         | RBool _ -> pr "  int r;\n"; "-1"
6009         | RConstString _ | RConstOptString _ ->
6010             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6011         | RString _ -> pr "  char *r;\n"; "NULL"
6012         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6013         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6014         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6015         | RBufferOut _ ->
6016             pr "  size_t size = 1;\n";
6017             pr "  char *r;\n";
6018             "NULL" in
6019
6020       (match snd style with
6021        | [] -> ()
6022        | args ->
6023            pr "  struct guestfs_%s_args args;\n" name;
6024            List.iter (
6025              function
6026              | Device n | Dev_or_Path n
6027              | Pathname n
6028              | String n -> ()
6029              | OptString n -> pr "  char *%s;\n" n
6030              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6031              | Bool n -> pr "  int %s;\n" n
6032              | Int n -> pr "  int %s;\n" n
6033              | Int64 n -> pr "  int64_t %s;\n" n
6034              | FileIn _ | FileOut _ -> ()
6035            ) args
6036       );
6037       pr "\n";
6038
6039       (match snd style with
6040        | [] -> ()
6041        | args ->
6042            pr "  memset (&args, 0, sizeof args);\n";
6043            pr "\n";
6044            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6045            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6046            pr "    return;\n";
6047            pr "  }\n";
6048            let pr_args n =
6049              pr "  char *%s = args.%s;\n" n n
6050            in
6051            let pr_list_handling_code n =
6052              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6053              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6054              pr "  if (%s == NULL) {\n" n;
6055              pr "    reply_with_perror (\"realloc\");\n";
6056              pr "    goto done;\n";
6057              pr "  }\n";
6058              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6059              pr "  args.%s.%s_val = %s;\n" n n n;
6060            in
6061            List.iter (
6062              function
6063              | Pathname n ->
6064                  pr_args n;
6065                  pr "  ABS_PATH (%s, goto done);\n" n;
6066              | Device n ->
6067                  pr_args n;
6068                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6069              | Dev_or_Path n ->
6070                  pr_args n;
6071                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6072              | String n -> pr_args n
6073              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6074              | StringList n ->
6075                  pr_list_handling_code n;
6076              | DeviceList n ->
6077                  pr_list_handling_code n;
6078                  pr "  /* Ensure that each is a device,\n";
6079                  pr "   * and perform device name translation. */\n";
6080                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
6081                  pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
6082                  pr "  }\n";
6083              | Bool n -> pr "  %s = args.%s;\n" n n
6084              | Int n -> pr "  %s = args.%s;\n" n n
6085              | Int64 n -> pr "  %s = args.%s;\n" n n
6086              | FileIn _ | FileOut _ -> ()
6087            ) args;
6088            pr "\n"
6089       );
6090
6091
6092       (* this is used at least for do_equal *)
6093       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6094         (* Emit NEED_ROOT just once, even when there are two or
6095            more Pathname args *)
6096         pr "  NEED_ROOT (goto done);\n";
6097       );
6098
6099       (* Don't want to call the impl with any FileIn or FileOut
6100        * parameters, since these go "outside" the RPC protocol.
6101        *)
6102       let args' =
6103         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6104           (snd style) in
6105       pr "  r = do_%s " name;
6106       generate_c_call_args (fst style, args');
6107       pr ";\n";
6108
6109       (match fst style with
6110        | RErr | RInt _ | RInt64 _ | RBool _
6111        | RConstString _ | RConstOptString _
6112        | RString _ | RStringList _ | RHashtable _
6113        | RStruct (_, _) | RStructList (_, _) ->
6114            pr "  if (r == %s)\n" error_code;
6115            pr "    /* do_%s has already called reply_with_error */\n" name;
6116            pr "    goto done;\n";
6117            pr "\n"
6118        | RBufferOut _ ->
6119            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6120            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6121            pr "   */\n";
6122            pr "  if (size == 1 && r == %s)\n" error_code;
6123            pr "    /* do_%s has already called reply_with_error */\n" name;
6124            pr "    goto done;\n";
6125            pr "\n"
6126       );
6127
6128       (* If there are any FileOut parameters, then the impl must
6129        * send its own reply.
6130        *)
6131       let no_reply =
6132         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6133       if no_reply then
6134         pr "  /* do_%s has already sent a reply */\n" name
6135       else (
6136         match fst style with
6137         | RErr -> pr "  reply (NULL, NULL);\n"
6138         | RInt n | RInt64 n | RBool n ->
6139             pr "  struct guestfs_%s_ret ret;\n" name;
6140             pr "  ret.%s = r;\n" n;
6141             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6142               name
6143         | RConstString _ | RConstOptString _ ->
6144             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6145         | RString n ->
6146             pr "  struct guestfs_%s_ret ret;\n" name;
6147             pr "  ret.%s = r;\n" n;
6148             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6149               name;
6150             pr "  free (r);\n"
6151         | RStringList n | RHashtable n ->
6152             pr "  struct guestfs_%s_ret ret;\n" name;
6153             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6154             pr "  ret.%s.%s_val = r;\n" n n;
6155             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6156               name;
6157             pr "  free_strings (r);\n"
6158         | RStruct (n, _) ->
6159             pr "  struct guestfs_%s_ret ret;\n" name;
6160             pr "  ret.%s = *r;\n" n;
6161             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6162               name;
6163             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6164               name
6165         | RStructList (n, _) ->
6166             pr "  struct guestfs_%s_ret ret;\n" name;
6167             pr "  ret.%s = *r;\n" n;
6168             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6169               name;
6170             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6171               name
6172         | RBufferOut n ->
6173             pr "  struct guestfs_%s_ret ret;\n" name;
6174             pr "  ret.%s.%s_val = r;\n" n n;
6175             pr "  ret.%s.%s_len = size;\n" n n;
6176             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6177               name;
6178             pr "  free (r);\n"
6179       );
6180
6181       (* Free the args. *)
6182       (match snd style with
6183        | [] ->
6184            pr "done: ;\n";
6185        | _ ->
6186            pr "done:\n";
6187            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6188              name
6189       );
6190
6191       pr "}\n\n";
6192   ) daemon_functions;
6193
6194   (* Dispatch function. *)
6195   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6196   pr "{\n";
6197   pr "  switch (proc_nr) {\n";
6198
6199   List.iter (
6200     fun (name, style, _, _, _, _, _) ->
6201       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6202       pr "      %s_stub (xdr_in);\n" name;
6203       pr "      break;\n"
6204   ) daemon_functions;
6205
6206   pr "    default:\n";
6207   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";
6208   pr "  }\n";
6209   pr "}\n";
6210   pr "\n";
6211
6212   (* LVM columns and tokenization functions. *)
6213   (* XXX This generates crap code.  We should rethink how we
6214    * do this parsing.
6215    *)
6216   List.iter (
6217     function
6218     | typ, cols ->
6219         pr "static const char *lvm_%s_cols = \"%s\";\n"
6220           typ (String.concat "," (List.map fst cols));
6221         pr "\n";
6222
6223         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6224         pr "{\n";
6225         pr "  char *tok, *p, *next;\n";
6226         pr "  int i, j;\n";
6227         pr "\n";
6228         (*
6229           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6230           pr "\n";
6231         *)
6232         pr "  if (!str) {\n";
6233         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6234         pr "    return -1;\n";
6235         pr "  }\n";
6236         pr "  if (!*str || c_isspace (*str)) {\n";
6237         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6238         pr "    return -1;\n";
6239         pr "  }\n";
6240         pr "  tok = str;\n";
6241         List.iter (
6242           fun (name, coltype) ->
6243             pr "  if (!tok) {\n";
6244             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6245             pr "    return -1;\n";
6246             pr "  }\n";
6247             pr "  p = strchrnul (tok, ',');\n";
6248             pr "  if (*p) next = p+1; else next = NULL;\n";
6249             pr "  *p = '\\0';\n";
6250             (match coltype with
6251              | FString ->
6252                  pr "  r->%s = strdup (tok);\n" name;
6253                  pr "  if (r->%s == NULL) {\n" name;
6254                  pr "    perror (\"strdup\");\n";
6255                  pr "    return -1;\n";
6256                  pr "  }\n"
6257              | FUUID ->
6258                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6259                  pr "    if (tok[j] == '\\0') {\n";
6260                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6261                  pr "      return -1;\n";
6262                  pr "    } else if (tok[j] != '-')\n";
6263                  pr "      r->%s[i++] = tok[j];\n" name;
6264                  pr "  }\n";
6265              | FBytes ->
6266                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6267                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6268                  pr "    return -1;\n";
6269                  pr "  }\n";
6270              | FInt64 ->
6271                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6272                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6273                  pr "    return -1;\n";
6274                  pr "  }\n";
6275              | FOptPercent ->
6276                  pr "  if (tok[0] == '\\0')\n";
6277                  pr "    r->%s = -1;\n" name;
6278                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6279                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6280                  pr "    return -1;\n";
6281                  pr "  }\n";
6282              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6283                  assert false (* can never be an LVM column *)
6284             );
6285             pr "  tok = next;\n";
6286         ) cols;
6287
6288         pr "  if (tok != NULL) {\n";
6289         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6290         pr "    return -1;\n";
6291         pr "  }\n";
6292         pr "  return 0;\n";
6293         pr "}\n";
6294         pr "\n";
6295
6296         pr "guestfs_int_lvm_%s_list *\n" typ;
6297         pr "parse_command_line_%ss (void)\n" typ;
6298         pr "{\n";
6299         pr "  char *out, *err;\n";
6300         pr "  char *p, *pend;\n";
6301         pr "  int r, i;\n";
6302         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6303         pr "  void *newp;\n";
6304         pr "\n";
6305         pr "  ret = malloc (sizeof *ret);\n";
6306         pr "  if (!ret) {\n";
6307         pr "    reply_with_perror (\"malloc\");\n";
6308         pr "    return NULL;\n";
6309         pr "  }\n";
6310         pr "\n";
6311         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6312         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6313         pr "\n";
6314         pr "  r = command (&out, &err,\n";
6315         pr "           \"lvm\", \"%ss\",\n" typ;
6316         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6317         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6318         pr "  if (r == -1) {\n";
6319         pr "    reply_with_error (\"%%s\", err);\n";
6320         pr "    free (out);\n";
6321         pr "    free (err);\n";
6322         pr "    free (ret);\n";
6323         pr "    return NULL;\n";
6324         pr "  }\n";
6325         pr "\n";
6326         pr "  free (err);\n";
6327         pr "\n";
6328         pr "  /* Tokenize each line of the output. */\n";
6329         pr "  p = out;\n";
6330         pr "  i = 0;\n";
6331         pr "  while (p) {\n";
6332         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6333         pr "    if (pend) {\n";
6334         pr "      *pend = '\\0';\n";
6335         pr "      pend++;\n";
6336         pr "    }\n";
6337         pr "\n";
6338         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6339         pr "      p++;\n";
6340         pr "\n";
6341         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6342         pr "      p = pend;\n";
6343         pr "      continue;\n";
6344         pr "    }\n";
6345         pr "\n";
6346         pr "    /* Allocate some space to store this next entry. */\n";
6347         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6348         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6349         pr "    if (newp == NULL) {\n";
6350         pr "      reply_with_perror (\"realloc\");\n";
6351         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6352         pr "      free (ret);\n";
6353         pr "      free (out);\n";
6354         pr "      return NULL;\n";
6355         pr "    }\n";
6356         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6357         pr "\n";
6358         pr "    /* Tokenize the next entry. */\n";
6359         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6360         pr "    if (r == -1) {\n";
6361         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6362         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6363         pr "      free (ret);\n";
6364         pr "      free (out);\n";
6365         pr "      return NULL;\n";
6366         pr "    }\n";
6367         pr "\n";
6368         pr "    ++i;\n";
6369         pr "    p = pend;\n";
6370         pr "  }\n";
6371         pr "\n";
6372         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6373         pr "\n";
6374         pr "  free (out);\n";
6375         pr "  return ret;\n";
6376         pr "}\n"
6377
6378   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6379
6380 (* Generate a list of function names, for debugging in the daemon.. *)
6381 and generate_daemon_names () =
6382   generate_header CStyle GPLv2plus;
6383
6384   pr "#include <config.h>\n";
6385   pr "\n";
6386   pr "#include \"daemon.h\"\n";
6387   pr "\n";
6388
6389   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6390   pr "const char *function_names[] = {\n";
6391   List.iter (
6392     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6393   ) daemon_functions;
6394   pr "};\n";
6395
6396 (* Generate the optional groups for the daemon to implement
6397  * guestfs_available.
6398  *)
6399 and generate_daemon_optgroups_c () =
6400   generate_header CStyle GPLv2plus;
6401
6402   pr "#include <config.h>\n";
6403   pr "\n";
6404   pr "#include \"daemon.h\"\n";
6405   pr "#include \"optgroups.h\"\n";
6406   pr "\n";
6407
6408   pr "struct optgroup optgroups[] = {\n";
6409   List.iter (
6410     fun (group, _) ->
6411       pr "  { \"%s\", optgroup_%s_available },\n" group group
6412   ) optgroups;
6413   pr "  { NULL, NULL }\n";
6414   pr "};\n"
6415
6416 and generate_daemon_optgroups_h () =
6417   generate_header CStyle GPLv2plus;
6418
6419   List.iter (
6420     fun (group, _) ->
6421       pr "extern int optgroup_%s_available (void);\n" group
6422   ) optgroups
6423
6424 (* Generate the tests. *)
6425 and generate_tests () =
6426   generate_header CStyle GPLv2plus;
6427
6428   pr "\
6429 #include <stdio.h>
6430 #include <stdlib.h>
6431 #include <string.h>
6432 #include <unistd.h>
6433 #include <sys/types.h>
6434 #include <fcntl.h>
6435
6436 #include \"guestfs.h\"
6437 #include \"guestfs-internal.h\"
6438
6439 static guestfs_h *g;
6440 static int suppress_error = 0;
6441
6442 static void print_error (guestfs_h *g, void *data, const char *msg)
6443 {
6444   if (!suppress_error)
6445     fprintf (stderr, \"%%s\\n\", msg);
6446 }
6447
6448 /* FIXME: nearly identical code appears in fish.c */
6449 static void print_strings (char *const *argv)
6450 {
6451   int argc;
6452
6453   for (argc = 0; argv[argc] != NULL; ++argc)
6454     printf (\"\\t%%s\\n\", argv[argc]);
6455 }
6456
6457 /*
6458 static void print_table (char const *const *argv)
6459 {
6460   int i;
6461
6462   for (i = 0; argv[i] != NULL; i += 2)
6463     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6464 }
6465 */
6466
6467 static int
6468 is_available (const char *group)
6469 {
6470   const char *groups[] = { group, NULL };
6471   int r;
6472
6473   suppress_error = 1;
6474   r = guestfs_available (g, (char **) groups);
6475   suppress_error = 0;
6476
6477   return r == 0;
6478 }
6479
6480 ";
6481
6482   (* Generate a list of commands which are not tested anywhere. *)
6483   pr "static void no_test_warnings (void)\n";
6484   pr "{\n";
6485
6486   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6487   List.iter (
6488     fun (_, _, _, _, tests, _, _) ->
6489       let tests = filter_map (
6490         function
6491         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
6492         | (_, Disabled, _) -> None
6493       ) tests in
6494       let seq = List.concat (List.map seq_of_test tests) in
6495       let cmds_tested = List.map List.hd seq in
6496       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6497   ) all_functions;
6498
6499   List.iter (
6500     fun (name, _, _, _, _, _, _) ->
6501       if not (Hashtbl.mem hash name) then
6502         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6503   ) all_functions;
6504
6505   pr "}\n";
6506   pr "\n";
6507
6508   (* Generate the actual tests.  Note that we generate the tests
6509    * in reverse order, deliberately, so that (in general) the
6510    * newest tests run first.  This makes it quicker and easier to
6511    * debug them.
6512    *)
6513   let test_names =
6514     List.map (
6515       fun (name, _, _, flags, tests, _, _) ->
6516         mapi (generate_one_test name flags) tests
6517     ) (List.rev all_functions) in
6518   let test_names = List.concat test_names in
6519   let nr_tests = List.length test_names in
6520
6521   pr "\
6522 int main (int argc, char *argv[])
6523 {
6524   char c = 0;
6525   unsigned long int n_failed = 0;
6526   const char *filename;
6527   int fd;
6528   int nr_tests, test_num = 0;
6529
6530   setbuf (stdout, NULL);
6531
6532   no_test_warnings ();
6533
6534   g = guestfs_create ();
6535   if (g == NULL) {
6536     printf (\"guestfs_create FAILED\\n\");
6537     exit (EXIT_FAILURE);
6538   }
6539
6540   guestfs_set_error_handler (g, print_error, NULL);
6541
6542   guestfs_set_path (g, \"../appliance\");
6543
6544   filename = \"test1.img\";
6545   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6546   if (fd == -1) {
6547     perror (filename);
6548     exit (EXIT_FAILURE);
6549   }
6550   if (lseek (fd, %d, SEEK_SET) == -1) {
6551     perror (\"lseek\");
6552     close (fd);
6553     unlink (filename);
6554     exit (EXIT_FAILURE);
6555   }
6556   if (write (fd, &c, 1) == -1) {
6557     perror (\"write\");
6558     close (fd);
6559     unlink (filename);
6560     exit (EXIT_FAILURE);
6561   }
6562   if (close (fd) == -1) {
6563     perror (filename);
6564     unlink (filename);
6565     exit (EXIT_FAILURE);
6566   }
6567   if (guestfs_add_drive (g, filename) == -1) {
6568     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6569     exit (EXIT_FAILURE);
6570   }
6571
6572   filename = \"test2.img\";
6573   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6574   if (fd == -1) {
6575     perror (filename);
6576     exit (EXIT_FAILURE);
6577   }
6578   if (lseek (fd, %d, SEEK_SET) == -1) {
6579     perror (\"lseek\");
6580     close (fd);
6581     unlink (filename);
6582     exit (EXIT_FAILURE);
6583   }
6584   if (write (fd, &c, 1) == -1) {
6585     perror (\"write\");
6586     close (fd);
6587     unlink (filename);
6588     exit (EXIT_FAILURE);
6589   }
6590   if (close (fd) == -1) {
6591     perror (filename);
6592     unlink (filename);
6593     exit (EXIT_FAILURE);
6594   }
6595   if (guestfs_add_drive (g, filename) == -1) {
6596     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6597     exit (EXIT_FAILURE);
6598   }
6599
6600   filename = \"test3.img\";
6601   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6602   if (fd == -1) {
6603     perror (filename);
6604     exit (EXIT_FAILURE);
6605   }
6606   if (lseek (fd, %d, SEEK_SET) == -1) {
6607     perror (\"lseek\");
6608     close (fd);
6609     unlink (filename);
6610     exit (EXIT_FAILURE);
6611   }
6612   if (write (fd, &c, 1) == -1) {
6613     perror (\"write\");
6614     close (fd);
6615     unlink (filename);
6616     exit (EXIT_FAILURE);
6617   }
6618   if (close (fd) == -1) {
6619     perror (filename);
6620     unlink (filename);
6621     exit (EXIT_FAILURE);
6622   }
6623   if (guestfs_add_drive (g, filename) == -1) {
6624     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6625     exit (EXIT_FAILURE);
6626   }
6627
6628   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6629     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6630     exit (EXIT_FAILURE);
6631   }
6632
6633   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6634   alarm (600);
6635
6636   if (guestfs_launch (g) == -1) {
6637     printf (\"guestfs_launch FAILED\\n\");
6638     exit (EXIT_FAILURE);
6639   }
6640
6641   /* Cancel previous alarm. */
6642   alarm (0);
6643
6644   nr_tests = %d;
6645
6646 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6647
6648   iteri (
6649     fun i test_name ->
6650       pr "  test_num++;\n";
6651       pr "  if (guestfs_get_verbose (g))\n";
6652       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6653       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6654       pr "  if (%s () == -1) {\n" test_name;
6655       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6656       pr "    n_failed++;\n";
6657       pr "  }\n";
6658   ) test_names;
6659   pr "\n";
6660
6661   pr "  guestfs_close (g);\n";
6662   pr "  unlink (\"test1.img\");\n";
6663   pr "  unlink (\"test2.img\");\n";
6664   pr "  unlink (\"test3.img\");\n";
6665   pr "\n";
6666
6667   pr "  if (n_failed > 0) {\n";
6668   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6669   pr "    exit (EXIT_FAILURE);\n";
6670   pr "  }\n";
6671   pr "\n";
6672
6673   pr "  exit (EXIT_SUCCESS);\n";
6674   pr "}\n"
6675
6676 and generate_one_test name flags i (init, prereq, test) =
6677   let test_name = sprintf "test_%s_%d" name i in
6678
6679   pr "\
6680 static int %s_skip (void)
6681 {
6682   const char *str;
6683
6684   str = getenv (\"TEST_ONLY\");
6685   if (str)
6686     return strstr (str, \"%s\") == NULL;
6687   str = getenv (\"SKIP_%s\");
6688   if (str && STREQ (str, \"1\")) return 1;
6689   str = getenv (\"SKIP_TEST_%s\");
6690   if (str && STREQ (str, \"1\")) return 1;
6691   return 0;
6692 }
6693
6694 " test_name name (String.uppercase test_name) (String.uppercase name);
6695
6696   (match prereq with
6697    | Disabled | Always | IfAvailable _ -> ()
6698    | If code | Unless code ->
6699        pr "static int %s_prereq (void)\n" test_name;
6700        pr "{\n";
6701        pr "  %s\n" code;
6702        pr "}\n";
6703        pr "\n";
6704   );
6705
6706   pr "\
6707 static int %s (void)
6708 {
6709   if (%s_skip ()) {
6710     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6711     return 0;
6712   }
6713
6714 " test_name test_name test_name;
6715
6716   (* Optional functions should only be tested if the relevant
6717    * support is available in the daemon.
6718    *)
6719   List.iter (
6720     function
6721     | Optional group ->
6722         pr "  if (!is_available (\"%s\")) {\n" group;
6723         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
6724         pr "    return 0;\n";
6725         pr "  }\n";
6726     | _ -> ()
6727   ) flags;
6728
6729   (match prereq with
6730    | Disabled ->
6731        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6732    | If _ ->
6733        pr "  if (! %s_prereq ()) {\n" test_name;
6734        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6735        pr "    return 0;\n";
6736        pr "  }\n";
6737        pr "\n";
6738        generate_one_test_body name i test_name init test;
6739    | Unless _ ->
6740        pr "  if (%s_prereq ()) {\n" test_name;
6741        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6742        pr "    return 0;\n";
6743        pr "  }\n";
6744        pr "\n";
6745        generate_one_test_body name i test_name init test;
6746    | IfAvailable group ->
6747        pr "  if (!is_available (\"%s\")) {\n" group;
6748        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
6749        pr "    return 0;\n";
6750        pr "  }\n";
6751        pr "\n";
6752        generate_one_test_body name i test_name init test;
6753    | Always ->
6754        generate_one_test_body name i test_name init test
6755   );
6756
6757   pr "  return 0;\n";
6758   pr "}\n";
6759   pr "\n";
6760   test_name
6761
6762 and generate_one_test_body name i test_name init test =
6763   (match init with
6764    | InitNone (* XXX at some point, InitNone and InitEmpty became
6765                * folded together as the same thing.  Really we should
6766                * make InitNone do nothing at all, but the tests may
6767                * need to be checked to make sure this is OK.
6768                *)
6769    | InitEmpty ->
6770        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6771        List.iter (generate_test_command_call test_name)
6772          [["blockdev_setrw"; "/dev/sda"];
6773           ["umount_all"];
6774           ["lvm_remove_all"]]
6775    | InitPartition ->
6776        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6777        List.iter (generate_test_command_call test_name)
6778          [["blockdev_setrw"; "/dev/sda"];
6779           ["umount_all"];
6780           ["lvm_remove_all"];
6781           ["part_disk"; "/dev/sda"; "mbr"]]
6782    | InitBasicFS ->
6783        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6784        List.iter (generate_test_command_call test_name)
6785          [["blockdev_setrw"; "/dev/sda"];
6786           ["umount_all"];
6787           ["lvm_remove_all"];
6788           ["part_disk"; "/dev/sda"; "mbr"];
6789           ["mkfs"; "ext2"; "/dev/sda1"];
6790           ["mount_options"; ""; "/dev/sda1"; "/"]]
6791    | InitBasicFSonLVM ->
6792        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6793          test_name;
6794        List.iter (generate_test_command_call test_name)
6795          [["blockdev_setrw"; "/dev/sda"];
6796           ["umount_all"];
6797           ["lvm_remove_all"];
6798           ["part_disk"; "/dev/sda"; "mbr"];
6799           ["pvcreate"; "/dev/sda1"];
6800           ["vgcreate"; "VG"; "/dev/sda1"];
6801           ["lvcreate"; "LV"; "VG"; "8"];
6802           ["mkfs"; "ext2"; "/dev/VG/LV"];
6803           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6804    | InitISOFS ->
6805        pr "  /* InitISOFS for %s */\n" test_name;
6806        List.iter (generate_test_command_call test_name)
6807          [["blockdev_setrw"; "/dev/sda"];
6808           ["umount_all"];
6809           ["lvm_remove_all"];
6810           ["mount_ro"; "/dev/sdd"; "/"]]
6811   );
6812
6813   let get_seq_last = function
6814     | [] ->
6815         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6816           test_name
6817     | seq ->
6818         let seq = List.rev seq in
6819         List.rev (List.tl seq), List.hd seq
6820   in
6821
6822   match test with
6823   | TestRun seq ->
6824       pr "  /* TestRun for %s (%d) */\n" name i;
6825       List.iter (generate_test_command_call test_name) seq
6826   | TestOutput (seq, expected) ->
6827       pr "  /* TestOutput for %s (%d) */\n" name i;
6828       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6829       let seq, last = get_seq_last seq in
6830       let test () =
6831         pr "    if (STRNEQ (r, expected)) {\n";
6832         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6833         pr "      return -1;\n";
6834         pr "    }\n"
6835       in
6836       List.iter (generate_test_command_call test_name) seq;
6837       generate_test_command_call ~test test_name last
6838   | TestOutputList (seq, expected) ->
6839       pr "  /* TestOutputList for %s (%d) */\n" name i;
6840       let seq, last = get_seq_last seq in
6841       let test () =
6842         iteri (
6843           fun i str ->
6844             pr "    if (!r[%d]) {\n" i;
6845             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6846             pr "      print_strings (r);\n";
6847             pr "      return -1;\n";
6848             pr "    }\n";
6849             pr "    {\n";
6850             pr "      const char *expected = \"%s\";\n" (c_quote str);
6851             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6852             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6853             pr "        return -1;\n";
6854             pr "      }\n";
6855             pr "    }\n"
6856         ) expected;
6857         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6858         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6859           test_name;
6860         pr "      print_strings (r);\n";
6861         pr "      return -1;\n";
6862         pr "    }\n"
6863       in
6864       List.iter (generate_test_command_call test_name) seq;
6865       generate_test_command_call ~test test_name last
6866   | TestOutputListOfDevices (seq, expected) ->
6867       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6868       let seq, last = get_seq_last seq in
6869       let test () =
6870         iteri (
6871           fun i str ->
6872             pr "    if (!r[%d]) {\n" i;
6873             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6874             pr "      print_strings (r);\n";
6875             pr "      return -1;\n";
6876             pr "    }\n";
6877             pr "    {\n";
6878             pr "      const char *expected = \"%s\";\n" (c_quote str);
6879             pr "      r[%d][5] = 's';\n" i;
6880             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6881             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6882             pr "        return -1;\n";
6883             pr "      }\n";
6884             pr "    }\n"
6885         ) expected;
6886         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6887         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6888           test_name;
6889         pr "      print_strings (r);\n";
6890         pr "      return -1;\n";
6891         pr "    }\n"
6892       in
6893       List.iter (generate_test_command_call test_name) seq;
6894       generate_test_command_call ~test test_name last
6895   | TestOutputInt (seq, expected) ->
6896       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6897       let seq, last = get_seq_last seq in
6898       let test () =
6899         pr "    if (r != %d) {\n" expected;
6900         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6901           test_name expected;
6902         pr "               (int) r);\n";
6903         pr "      return -1;\n";
6904         pr "    }\n"
6905       in
6906       List.iter (generate_test_command_call test_name) seq;
6907       generate_test_command_call ~test test_name last
6908   | TestOutputIntOp (seq, op, expected) ->
6909       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6910       let seq, last = get_seq_last seq in
6911       let test () =
6912         pr "    if (! (r %s %d)) {\n" op expected;
6913         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6914           test_name op expected;
6915         pr "               (int) r);\n";
6916         pr "      return -1;\n";
6917         pr "    }\n"
6918       in
6919       List.iter (generate_test_command_call test_name) seq;
6920       generate_test_command_call ~test test_name last
6921   | TestOutputTrue seq ->
6922       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6923       let seq, last = get_seq_last seq in
6924       let test () =
6925         pr "    if (!r) {\n";
6926         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6927           test_name;
6928         pr "      return -1;\n";
6929         pr "    }\n"
6930       in
6931       List.iter (generate_test_command_call test_name) seq;
6932       generate_test_command_call ~test test_name last
6933   | TestOutputFalse seq ->
6934       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6935       let seq, last = get_seq_last seq in
6936       let test () =
6937         pr "    if (r) {\n";
6938         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6939           test_name;
6940         pr "      return -1;\n";
6941         pr "    }\n"
6942       in
6943       List.iter (generate_test_command_call test_name) seq;
6944       generate_test_command_call ~test test_name last
6945   | TestOutputLength (seq, expected) ->
6946       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6947       let seq, last = get_seq_last seq in
6948       let test () =
6949         pr "    int j;\n";
6950         pr "    for (j = 0; j < %d; ++j)\n" expected;
6951         pr "      if (r[j] == NULL) {\n";
6952         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6953           test_name;
6954         pr "        print_strings (r);\n";
6955         pr "        return -1;\n";
6956         pr "      }\n";
6957         pr "    if (r[j] != NULL) {\n";
6958         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6959           test_name;
6960         pr "      print_strings (r);\n";
6961         pr "      return -1;\n";
6962         pr "    }\n"
6963       in
6964       List.iter (generate_test_command_call test_name) seq;
6965       generate_test_command_call ~test test_name last
6966   | TestOutputBuffer (seq, expected) ->
6967       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6968       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6969       let seq, last = get_seq_last seq in
6970       let len = String.length expected in
6971       let test () =
6972         pr "    if (size != %d) {\n" len;
6973         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6974         pr "      return -1;\n";
6975         pr "    }\n";
6976         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6977         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6978         pr "      return -1;\n";
6979         pr "    }\n"
6980       in
6981       List.iter (generate_test_command_call test_name) seq;
6982       generate_test_command_call ~test test_name last
6983   | TestOutputStruct (seq, checks) ->
6984       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6985       let seq, last = get_seq_last seq in
6986       let test () =
6987         List.iter (
6988           function
6989           | CompareWithInt (field, expected) ->
6990               pr "    if (r->%s != %d) {\n" field expected;
6991               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6992                 test_name field expected;
6993               pr "               (int) r->%s);\n" field;
6994               pr "      return -1;\n";
6995               pr "    }\n"
6996           | CompareWithIntOp (field, op, expected) ->
6997               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6998               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
6999                 test_name field op expected;
7000               pr "               (int) r->%s);\n" field;
7001               pr "      return -1;\n";
7002               pr "    }\n"
7003           | CompareWithString (field, expected) ->
7004               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7005               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7006                 test_name field expected;
7007               pr "               r->%s);\n" field;
7008               pr "      return -1;\n";
7009               pr "    }\n"
7010           | CompareFieldsIntEq (field1, field2) ->
7011               pr "    if (r->%s != r->%s) {\n" field1 field2;
7012               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7013                 test_name field1 field2;
7014               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7015               pr "      return -1;\n";
7016               pr "    }\n"
7017           | CompareFieldsStrEq (field1, field2) ->
7018               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7019               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7020                 test_name field1 field2;
7021               pr "               r->%s, r->%s);\n" field1 field2;
7022               pr "      return -1;\n";
7023               pr "    }\n"
7024         ) checks
7025       in
7026       List.iter (generate_test_command_call test_name) seq;
7027       generate_test_command_call ~test test_name last
7028   | TestLastFail seq ->
7029       pr "  /* TestLastFail for %s (%d) */\n" name i;
7030       let seq, last = get_seq_last seq in
7031       List.iter (generate_test_command_call test_name) seq;
7032       generate_test_command_call test_name ~expect_error:true last
7033
7034 (* Generate the code to run a command, leaving the result in 'r'.
7035  * If you expect to get an error then you should set expect_error:true.
7036  *)
7037 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7038   match cmd with
7039   | [] -> assert false
7040   | name :: args ->
7041       (* Look up the command to find out what args/ret it has. *)
7042       let style =
7043         try
7044           let _, style, _, _, _, _, _ =
7045             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7046           style
7047         with Not_found ->
7048           failwithf "%s: in test, command %s was not found" test_name name in
7049
7050       if List.length (snd style) <> List.length args then
7051         failwithf "%s: in test, wrong number of args given to %s"
7052           test_name name;
7053
7054       pr "  {\n";
7055
7056       List.iter (
7057         function
7058         | OptString n, "NULL" -> ()
7059         | Pathname n, arg
7060         | Device n, arg
7061         | Dev_or_Path n, arg
7062         | String n, arg
7063         | OptString n, arg ->
7064             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7065         | Int _, _
7066         | Int64 _, _
7067         | Bool _, _
7068         | FileIn _, _ | FileOut _, _ -> ()
7069         | StringList n, "" | DeviceList n, "" ->
7070             pr "    const char *const %s[1] = { NULL };\n" n
7071         | StringList n, arg | DeviceList n, arg ->
7072             let strs = string_split " " arg in
7073             iteri (
7074               fun i str ->
7075                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7076             ) strs;
7077             pr "    const char *const %s[] = {\n" n;
7078             iteri (
7079               fun i _ -> pr "      %s_%d,\n" n i
7080             ) strs;
7081             pr "      NULL\n";
7082             pr "    };\n";
7083       ) (List.combine (snd style) args);
7084
7085       let error_code =
7086         match fst style with
7087         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7088         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7089         | RConstString _ | RConstOptString _ ->
7090             pr "    const char *r;\n"; "NULL"
7091         | RString _ -> pr "    char *r;\n"; "NULL"
7092         | RStringList _ | RHashtable _ ->
7093             pr "    char **r;\n";
7094             pr "    int i;\n";
7095             "NULL"
7096         | RStruct (_, typ) ->
7097             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7098         | RStructList (_, typ) ->
7099             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7100         | RBufferOut _ ->
7101             pr "    char *r;\n";
7102             pr "    size_t size;\n";
7103             "NULL" in
7104
7105       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7106       pr "    r = guestfs_%s (g" name;
7107
7108       (* Generate the parameters. *)
7109       List.iter (
7110         function
7111         | OptString _, "NULL" -> pr ", NULL"
7112         | Pathname n, _
7113         | Device n, _ | Dev_or_Path n, _
7114         | String n, _
7115         | OptString n, _ ->
7116             pr ", %s" n
7117         | FileIn _, arg | FileOut _, arg ->
7118             pr ", \"%s\"" (c_quote arg)
7119         | StringList n, _ | DeviceList n, _ ->
7120             pr ", (char **) %s" n
7121         | Int _, arg ->
7122             let i =
7123               try int_of_string arg
7124               with Failure "int_of_string" ->
7125                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7126             pr ", %d" i
7127         | Int64 _, arg ->
7128             let i =
7129               try Int64.of_string arg
7130               with Failure "int_of_string" ->
7131                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7132             pr ", %Ld" i
7133         | Bool _, arg ->
7134             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7135       ) (List.combine (snd style) args);
7136
7137       (match fst style with
7138        | RBufferOut _ -> pr ", &size"
7139        | _ -> ()
7140       );
7141
7142       pr ");\n";
7143
7144       if not expect_error then
7145         pr "    if (r == %s)\n" error_code
7146       else
7147         pr "    if (r != %s)\n" error_code;
7148       pr "      return -1;\n";
7149
7150       (* Insert the test code. *)
7151       (match test with
7152        | None -> ()
7153        | Some f -> f ()
7154       );
7155
7156       (match fst style with
7157        | RErr | RInt _ | RInt64 _ | RBool _
7158        | RConstString _ | RConstOptString _ -> ()
7159        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7160        | RStringList _ | RHashtable _ ->
7161            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7162            pr "      free (r[i]);\n";
7163            pr "    free (r);\n"
7164        | RStruct (_, typ) ->
7165            pr "    guestfs_free_%s (r);\n" typ
7166        | RStructList (_, typ) ->
7167            pr "    guestfs_free_%s_list (r);\n" typ
7168       );
7169
7170       pr "  }\n"
7171
7172 and c_quote str =
7173   let str = replace_str str "\r" "\\r" in
7174   let str = replace_str str "\n" "\\n" in
7175   let str = replace_str str "\t" "\\t" in
7176   let str = replace_str str "\000" "\\0" in
7177   str
7178
7179 (* Generate a lot of different functions for guestfish. *)
7180 and generate_fish_cmds () =
7181   generate_header CStyle GPLv2plus;
7182
7183   let all_functions =
7184     List.filter (
7185       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7186     ) all_functions in
7187   let all_functions_sorted =
7188     List.filter (
7189       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7190     ) all_functions_sorted in
7191
7192   pr "#include <config.h>\n";
7193   pr "\n";
7194   pr "#include <stdio.h>\n";
7195   pr "#include <stdlib.h>\n";
7196   pr "#include <string.h>\n";
7197   pr "#include <inttypes.h>\n";
7198   pr "\n";
7199   pr "#include <guestfs.h>\n";
7200   pr "#include \"c-ctype.h\"\n";
7201   pr "#include \"full-write.h\"\n";
7202   pr "#include \"xstrtol.h\"\n";
7203   pr "#include \"fish.h\"\n";
7204   pr "\n";
7205
7206   (* list_commands function, which implements guestfish -h *)
7207   pr "void list_commands (void)\n";
7208   pr "{\n";
7209   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7210   pr "  list_builtin_commands ();\n";
7211   List.iter (
7212     fun (name, _, _, flags, _, shortdesc, _) ->
7213       let name = replace_char name '_' '-' in
7214       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7215         name shortdesc
7216   ) all_functions_sorted;
7217   pr "  printf (\"    %%s\\n\",";
7218   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7219   pr "}\n";
7220   pr "\n";
7221
7222   (* display_command function, which implements guestfish -h cmd *)
7223   pr "int display_command (const char *cmd)\n";
7224   pr "{\n";
7225   List.iter (
7226     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7227       let name2 = replace_char name '_' '-' in
7228       let alias =
7229         try find_map (function FishAlias n -> Some n | _ -> None) flags
7230         with Not_found -> name in
7231       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7232       let synopsis =
7233         match snd style with
7234         | [] -> name2
7235         | args ->
7236             sprintf "%s %s"
7237               name2 (String.concat " " (List.map name_of_argt args)) in
7238
7239       let warnings =
7240         if List.mem ProtocolLimitWarning flags then
7241           ("\n\n" ^ protocol_limit_warning)
7242         else "" in
7243
7244       (* For DangerWillRobinson commands, we should probably have
7245        * guestfish prompt before allowing you to use them (especially
7246        * in interactive mode). XXX
7247        *)
7248       let warnings =
7249         warnings ^
7250           if List.mem DangerWillRobinson flags then
7251             ("\n\n" ^ danger_will_robinson)
7252           else "" in
7253
7254       let warnings =
7255         warnings ^
7256           match deprecation_notice flags with
7257           | None -> ""
7258           | Some txt -> "\n\n" ^ txt in
7259
7260       let describe_alias =
7261         if name <> alias then
7262           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7263         else "" in
7264
7265       pr "  if (";
7266       pr "STRCASEEQ (cmd, \"%s\")" name;
7267       if name <> name2 then
7268         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7269       if name <> alias then
7270         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7271       pr ") {\n";
7272       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7273         name2 shortdesc
7274         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7275          "=head1 DESCRIPTION\n\n" ^
7276          longdesc ^ warnings ^ describe_alias);
7277       pr "    return 0;\n";
7278       pr "  }\n";
7279       pr "  else\n"
7280   ) all_functions;
7281   pr "    return display_builtin_command (cmd);\n";
7282   pr "}\n";
7283   pr "\n";
7284
7285   let emit_print_list_function typ =
7286     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7287       typ typ typ;
7288     pr "{\n";
7289     pr "  unsigned int i;\n";
7290     pr "\n";
7291     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7292     pr "    printf (\"[%%d] = {\\n\", i);\n";
7293     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7294     pr "    printf (\"}\\n\");\n";
7295     pr "  }\n";
7296     pr "}\n";
7297     pr "\n";
7298   in
7299
7300   (* print_* functions *)
7301   List.iter (
7302     fun (typ, cols) ->
7303       let needs_i =
7304         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7305
7306       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7307       pr "{\n";
7308       if needs_i then (
7309         pr "  unsigned int i;\n";
7310         pr "\n"
7311       );
7312       List.iter (
7313         function
7314         | name, FString ->
7315             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7316         | name, FUUID ->
7317             pr "  printf (\"%%s%s: \", indent);\n" name;
7318             pr "  for (i = 0; i < 32; ++i)\n";
7319             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7320             pr "  printf (\"\\n\");\n"
7321         | name, FBuffer ->
7322             pr "  printf (\"%%s%s: \", indent);\n" name;
7323             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7324             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7325             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7326             pr "    else\n";
7327             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7328             pr "  printf (\"\\n\");\n"
7329         | name, (FUInt64|FBytes) ->
7330             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7331               name typ name
7332         | name, FInt64 ->
7333             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7334               name typ name
7335         | name, FUInt32 ->
7336             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7337               name typ name
7338         | name, FInt32 ->
7339             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7340               name typ name
7341         | name, FChar ->
7342             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7343               name typ name
7344         | name, FOptPercent ->
7345             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7346               typ name name typ name;
7347             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7348       ) cols;
7349       pr "}\n";
7350       pr "\n";
7351   ) structs;
7352
7353   (* Emit a print_TYPE_list function definition only if that function is used. *)
7354   List.iter (
7355     function
7356     | typ, (RStructListOnly | RStructAndList) ->
7357         (* generate the function for typ *)
7358         emit_print_list_function typ
7359     | typ, _ -> () (* empty *)
7360   ) (rstructs_used_by all_functions);
7361
7362   (* Emit a print_TYPE function definition only if that function is used. *)
7363   List.iter (
7364     function
7365     | typ, (RStructOnly | RStructAndList) ->
7366         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7367         pr "{\n";
7368         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7369         pr "}\n";
7370         pr "\n";
7371     | typ, _ -> () (* empty *)
7372   ) (rstructs_used_by all_functions);
7373
7374   (* run_<action> actions *)
7375   List.iter (
7376     fun (name, style, _, flags, _, _, _) ->
7377       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7378       pr "{\n";
7379       (match fst style with
7380        | RErr
7381        | RInt _
7382        | RBool _ -> pr "  int r;\n"
7383        | RInt64 _ -> pr "  int64_t r;\n"
7384        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7385        | RString _ -> pr "  char *r;\n"
7386        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7387        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7388        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7389        | RBufferOut _ ->
7390            pr "  char *r;\n";
7391            pr "  size_t size;\n";
7392       );
7393       List.iter (
7394         function
7395         | Device n
7396         | String n
7397         | OptString n
7398         | FileIn n
7399         | FileOut n -> pr "  const char *%s;\n" n
7400         | Pathname n
7401         | Dev_or_Path n -> pr "  char *%s;\n" n
7402         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7403         | Bool n -> pr "  int %s;\n" n
7404         | Int n -> pr "  int %s;\n" n
7405         | Int64 n -> pr "  int64_t %s;\n" n
7406       ) (snd style);
7407
7408       (* Check and convert parameters. *)
7409       let argc_expected = List.length (snd style) in
7410       pr "  if (argc != %d) {\n" argc_expected;
7411       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7412         argc_expected;
7413       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7414       pr "    return -1;\n";
7415       pr "  }\n";
7416
7417       let parse_integer fn fntyp rtyp range name i =
7418         pr "  {\n";
7419         pr "    strtol_error xerr;\n";
7420         pr "    %s r;\n" fntyp;
7421         pr "\n";
7422         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7423         pr "    if (xerr != LONGINT_OK) {\n";
7424         pr "      fprintf (stderr,\n";
7425         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7426         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7427         pr "      return -1;\n";
7428         pr "    }\n";
7429         (match range with
7430          | None -> ()
7431          | Some (min, max, comment) ->
7432              pr "    /* %s */\n" comment;
7433              pr "    if (r < %s || r > %s) {\n" min max;
7434              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7435                name;
7436              pr "      return -1;\n";
7437              pr "    }\n";
7438              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7439         );
7440         pr "    %s = r;\n" name;
7441         pr "  }\n";
7442       in
7443
7444       iteri (
7445         fun i ->
7446           function
7447           | Device name
7448           | String name ->
7449               pr "  %s = argv[%d];\n" name i
7450           | Pathname name
7451           | Dev_or_Path name ->
7452               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7453               pr "  if (%s == NULL) return -1;\n" name
7454           | OptString name ->
7455               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7456                 name i i
7457           | FileIn name ->
7458               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7459                 name i i
7460           | FileOut name ->
7461               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7462                 name i i
7463           | StringList name | DeviceList name ->
7464               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7465               pr "  if (%s == NULL) return -1;\n" name;
7466           | Bool name ->
7467               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7468           | Int name ->
7469               let range =
7470                 let min = "(-(2LL<<30))"
7471                 and max = "((2LL<<30)-1)"
7472                 and comment =
7473                   "The Int type in the generator is a signed 31 bit int." in
7474                 Some (min, max, comment) in
7475               parse_integer "xstrtoll" "long long" "int" range name i
7476           | Int64 name ->
7477               parse_integer "xstrtoll" "long long" "int64_t" None name i
7478       ) (snd style);
7479
7480       (* Call C API function. *)
7481       let fn =
7482         try find_map (function FishAction n -> Some n | _ -> None) flags
7483         with Not_found -> sprintf "guestfs_%s" name in
7484       pr "  r = %s " fn;
7485       generate_c_call_args ~handle:"g" style;
7486       pr ";\n";
7487
7488       List.iter (
7489         function
7490         | Device name | String name
7491         | OptString name | FileIn name | FileOut name | Bool name
7492         | Int name | Int64 name -> ()
7493         | Pathname name | Dev_or_Path name ->
7494             pr "  free (%s);\n" name
7495         | StringList name | DeviceList name ->
7496             pr "  free_strings (%s);\n" name
7497       ) (snd style);
7498
7499       (* Check return value for errors and display command results. *)
7500       (match fst style with
7501        | RErr -> pr "  return r;\n"
7502        | RInt _ ->
7503            pr "  if (r == -1) return -1;\n";
7504            pr "  printf (\"%%d\\n\", r);\n";
7505            pr "  return 0;\n"
7506        | RInt64 _ ->
7507            pr "  if (r == -1) return -1;\n";
7508            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7509            pr "  return 0;\n"
7510        | RBool _ ->
7511            pr "  if (r == -1) return -1;\n";
7512            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7513            pr "  return 0;\n"
7514        | RConstString _ ->
7515            pr "  if (r == NULL) return -1;\n";
7516            pr "  printf (\"%%s\\n\", r);\n";
7517            pr "  return 0;\n"
7518        | RConstOptString _ ->
7519            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7520            pr "  return 0;\n"
7521        | RString _ ->
7522            pr "  if (r == NULL) return -1;\n";
7523            pr "  printf (\"%%s\\n\", r);\n";
7524            pr "  free (r);\n";
7525            pr "  return 0;\n"
7526        | RStringList _ ->
7527            pr "  if (r == NULL) return -1;\n";
7528            pr "  print_strings (r);\n";
7529            pr "  free_strings (r);\n";
7530            pr "  return 0;\n"
7531        | RStruct (_, typ) ->
7532            pr "  if (r == NULL) return -1;\n";
7533            pr "  print_%s (r);\n" typ;
7534            pr "  guestfs_free_%s (r);\n" typ;
7535            pr "  return 0;\n"
7536        | RStructList (_, typ) ->
7537            pr "  if (r == NULL) return -1;\n";
7538            pr "  print_%s_list (r);\n" typ;
7539            pr "  guestfs_free_%s_list (r);\n" typ;
7540            pr "  return 0;\n"
7541        | RHashtable _ ->
7542            pr "  if (r == NULL) return -1;\n";
7543            pr "  print_table (r);\n";
7544            pr "  free_strings (r);\n";
7545            pr "  return 0;\n"
7546        | RBufferOut _ ->
7547            pr "  if (r == NULL) return -1;\n";
7548            pr "  if (full_write (1, r, size) != size) {\n";
7549            pr "    perror (\"write\");\n";
7550            pr "    free (r);\n";
7551            pr "    return -1;\n";
7552            pr "  }\n";
7553            pr "  free (r);\n";
7554            pr "  return 0;\n"
7555       );
7556       pr "}\n";
7557       pr "\n"
7558   ) all_functions;
7559
7560   (* run_action function *)
7561   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7562   pr "{\n";
7563   List.iter (
7564     fun (name, _, _, flags, _, _, _) ->
7565       let name2 = replace_char name '_' '-' in
7566       let alias =
7567         try find_map (function FishAlias n -> Some n | _ -> None) flags
7568         with Not_found -> name in
7569       pr "  if (";
7570       pr "STRCASEEQ (cmd, \"%s\")" name;
7571       if name <> name2 then
7572         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7573       if name <> alias then
7574         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7575       pr ")\n";
7576       pr "    return run_%s (cmd, argc, argv);\n" name;
7577       pr "  else\n";
7578   ) all_functions;
7579   pr "    {\n";
7580   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7581   pr "      if (command_num == 1)\n";
7582   pr "        extended_help_message ();\n";
7583   pr "      return -1;\n";
7584   pr "    }\n";
7585   pr "  return 0;\n";
7586   pr "}\n";
7587   pr "\n"
7588
7589 (* Readline completion for guestfish. *)
7590 and generate_fish_completion () =
7591   generate_header CStyle GPLv2plus;
7592
7593   let all_functions =
7594     List.filter (
7595       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7596     ) all_functions in
7597
7598   pr "\
7599 #include <config.h>
7600
7601 #include <stdio.h>
7602 #include <stdlib.h>
7603 #include <string.h>
7604
7605 #ifdef HAVE_LIBREADLINE
7606 #include <readline/readline.h>
7607 #endif
7608
7609 #include \"fish.h\"
7610
7611 #ifdef HAVE_LIBREADLINE
7612
7613 static const char *const commands[] = {
7614   BUILTIN_COMMANDS_FOR_COMPLETION,
7615 ";
7616
7617   (* Get the commands, including the aliases.  They don't need to be
7618    * sorted - the generator() function just does a dumb linear search.
7619    *)
7620   let commands =
7621     List.map (
7622       fun (name, _, _, flags, _, _, _) ->
7623         let name2 = replace_char name '_' '-' in
7624         let alias =
7625           try find_map (function FishAlias n -> Some n | _ -> None) flags
7626           with Not_found -> name in
7627
7628         if name <> alias then [name2; alias] else [name2]
7629     ) all_functions in
7630   let commands = List.flatten commands in
7631
7632   List.iter (pr "  \"%s\",\n") commands;
7633
7634   pr "  NULL
7635 };
7636
7637 static char *
7638 generator (const char *text, int state)
7639 {
7640   static int index, len;
7641   const char *name;
7642
7643   if (!state) {
7644     index = 0;
7645     len = strlen (text);
7646   }
7647
7648   rl_attempted_completion_over = 1;
7649
7650   while ((name = commands[index]) != NULL) {
7651     index++;
7652     if (STRCASEEQLEN (name, text, len))
7653       return strdup (name);
7654   }
7655
7656   return NULL;
7657 }
7658
7659 #endif /* HAVE_LIBREADLINE */
7660
7661 #ifdef HAVE_RL_COMPLETION_MATCHES
7662 #define RL_COMPLETION_MATCHES rl_completion_matches
7663 #else
7664 #ifdef HAVE_COMPLETION_MATCHES
7665 #define RL_COMPLETION_MATCHES completion_matches
7666 #endif
7667 #endif /* else just fail if we don't have either symbol */
7668
7669 char **
7670 do_completion (const char *text, int start, int end)
7671 {
7672   char **matches = NULL;
7673
7674 #ifdef HAVE_LIBREADLINE
7675   rl_completion_append_character = ' ';
7676
7677   if (start == 0)
7678     matches = RL_COMPLETION_MATCHES (text, generator);
7679   else if (complete_dest_paths)
7680     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7681 #endif
7682
7683   return matches;
7684 }
7685 ";
7686
7687 (* Generate the POD documentation for guestfish. *)
7688 and generate_fish_actions_pod () =
7689   let all_functions_sorted =
7690     List.filter (
7691       fun (_, _, _, flags, _, _, _) ->
7692         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7693     ) all_functions_sorted in
7694
7695   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7696
7697   List.iter (
7698     fun (name, style, _, flags, _, _, longdesc) ->
7699       let longdesc =
7700         Str.global_substitute rex (
7701           fun s ->
7702             let sub =
7703               try Str.matched_group 1 s
7704               with Not_found ->
7705                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7706             "C<" ^ replace_char sub '_' '-' ^ ">"
7707         ) longdesc in
7708       let name = replace_char name '_' '-' in
7709       let alias =
7710         try find_map (function FishAlias n -> Some n | _ -> None) flags
7711         with Not_found -> name in
7712
7713       pr "=head2 %s" name;
7714       if name <> alias then
7715         pr " | %s" alias;
7716       pr "\n";
7717       pr "\n";
7718       pr " %s" name;
7719       List.iter (
7720         function
7721         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7722         | OptString n -> pr " %s" n
7723         | StringList n | DeviceList n -> pr " '%s ...'" n
7724         | Bool _ -> pr " true|false"
7725         | Int n -> pr " %s" n
7726         | Int64 n -> pr " %s" n
7727         | FileIn n | FileOut n -> pr " (%s|-)" n
7728       ) (snd style);
7729       pr "\n";
7730       pr "\n";
7731       pr "%s\n\n" longdesc;
7732
7733       if List.exists (function FileIn _ | FileOut _ -> true
7734                       | _ -> false) (snd style) then
7735         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7736
7737       if List.mem ProtocolLimitWarning flags then
7738         pr "%s\n\n" protocol_limit_warning;
7739
7740       if List.mem DangerWillRobinson flags then
7741         pr "%s\n\n" danger_will_robinson;
7742
7743       match deprecation_notice flags with
7744       | None -> ()
7745       | Some txt -> pr "%s\n\n" txt
7746   ) all_functions_sorted
7747
7748 (* Generate a C function prototype. *)
7749 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7750     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7751     ?(prefix = "")
7752     ?handle name style =
7753   if extern then pr "extern ";
7754   if static then pr "static ";
7755   (match fst style with
7756    | RErr -> pr "int "
7757    | RInt _ -> pr "int "
7758    | RInt64 _ -> pr "int64_t "
7759    | RBool _ -> pr "int "
7760    | RConstString _ | RConstOptString _ -> pr "const char *"
7761    | RString _ | RBufferOut _ -> pr "char *"
7762    | RStringList _ | RHashtable _ -> pr "char **"
7763    | RStruct (_, typ) ->
7764        if not in_daemon then pr "struct guestfs_%s *" typ
7765        else pr "guestfs_int_%s *" typ
7766    | RStructList (_, typ) ->
7767        if not in_daemon then pr "struct guestfs_%s_list *" typ
7768        else pr "guestfs_int_%s_list *" typ
7769   );
7770   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7771   pr "%s%s (" prefix name;
7772   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7773     pr "void"
7774   else (
7775     let comma = ref false in
7776     (match handle with
7777      | None -> ()
7778      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7779     );
7780     let next () =
7781       if !comma then (
7782         if single_line then pr ", " else pr ",\n\t\t"
7783       );
7784       comma := true
7785     in
7786     List.iter (
7787       function
7788       | Pathname n
7789       | Device n | Dev_or_Path n
7790       | String n
7791       | OptString n ->
7792           next ();
7793           pr "const char *%s" n
7794       | StringList n | DeviceList n ->
7795           next ();
7796           pr "char *const *%s" n
7797       | Bool n -> next (); pr "int %s" n
7798       | Int n -> next (); pr "int %s" n
7799       | Int64 n -> next (); pr "int64_t %s" n
7800       | FileIn n
7801       | FileOut n ->
7802           if not in_daemon then (next (); pr "const char *%s" n)
7803     ) (snd style);
7804     if is_RBufferOut then (next (); pr "size_t *size_r");
7805   );
7806   pr ")";
7807   if semicolon then pr ";";
7808   if newline then pr "\n"
7809
7810 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7811 and generate_c_call_args ?handle ?(decl = false) style =
7812   pr "(";
7813   let comma = ref false in
7814   let next () =
7815     if !comma then pr ", ";
7816     comma := true
7817   in
7818   (match handle with
7819    | None -> ()
7820    | Some handle -> pr "%s" handle; comma := true
7821   );
7822   List.iter (
7823     fun arg ->
7824       next ();
7825       pr "%s" (name_of_argt arg)
7826   ) (snd style);
7827   (* For RBufferOut calls, add implicit &size parameter. *)
7828   if not decl then (
7829     match fst style with
7830     | RBufferOut _ ->
7831         next ();
7832         pr "&size"
7833     | _ -> ()
7834   );
7835   pr ")"
7836
7837 (* Generate the OCaml bindings interface. *)
7838 and generate_ocaml_mli () =
7839   generate_header OCamlStyle LGPLv2plus;
7840
7841   pr "\
7842 (** For API documentation you should refer to the C API
7843     in the guestfs(3) manual page.  The OCaml API uses almost
7844     exactly the same calls. *)
7845
7846 type t
7847 (** A [guestfs_h] handle. *)
7848
7849 exception Error of string
7850 (** This exception is raised when there is an error. *)
7851
7852 exception Handle_closed of string
7853 (** This exception is raised if you use a {!Guestfs.t} handle
7854     after calling {!close} on it.  The string is the name of
7855     the function. *)
7856
7857 val create : unit -> t
7858 (** Create a {!Guestfs.t} handle. *)
7859
7860 val close : t -> unit
7861 (** Close the {!Guestfs.t} handle and free up all resources used
7862     by it immediately.
7863
7864     Handles are closed by the garbage collector when they become
7865     unreferenced, but callers can call this in order to provide
7866     predictable cleanup. *)
7867
7868 ";
7869   generate_ocaml_structure_decls ();
7870
7871   (* The actions. *)
7872   List.iter (
7873     fun (name, style, _, _, _, shortdesc, _) ->
7874       generate_ocaml_prototype name style;
7875       pr "(** %s *)\n" shortdesc;
7876       pr "\n"
7877   ) all_functions_sorted
7878
7879 (* Generate the OCaml bindings implementation. *)
7880 and generate_ocaml_ml () =
7881   generate_header OCamlStyle LGPLv2plus;
7882
7883   pr "\
7884 type t
7885
7886 exception Error of string
7887 exception Handle_closed of string
7888
7889 external create : unit -> t = \"ocaml_guestfs_create\"
7890 external close : t -> unit = \"ocaml_guestfs_close\"
7891
7892 (* Give the exceptions names, so they can be raised from the C code. *)
7893 let () =
7894   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7895   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7896
7897 ";
7898
7899   generate_ocaml_structure_decls ();
7900
7901   (* The actions. *)
7902   List.iter (
7903     fun (name, style, _, _, _, shortdesc, _) ->
7904       generate_ocaml_prototype ~is_external:true name style;
7905   ) all_functions_sorted
7906
7907 (* Generate the OCaml bindings C implementation. *)
7908 and generate_ocaml_c () =
7909   generate_header CStyle LGPLv2plus;
7910
7911   pr "\
7912 #include <stdio.h>
7913 #include <stdlib.h>
7914 #include <string.h>
7915
7916 #include <caml/config.h>
7917 #include <caml/alloc.h>
7918 #include <caml/callback.h>
7919 #include <caml/fail.h>
7920 #include <caml/memory.h>
7921 #include <caml/mlvalues.h>
7922 #include <caml/signals.h>
7923
7924 #include \"guestfs.h\"
7925
7926 #include \"guestfs_c.h\"
7927
7928 /* Copy a hashtable of string pairs into an assoc-list.  We return
7929  * the list in reverse order, but hashtables aren't supposed to be
7930  * ordered anyway.
7931  */
7932 static CAMLprim value
7933 copy_table (char * const * argv)
7934 {
7935   CAMLparam0 ();
7936   CAMLlocal5 (rv, pairv, kv, vv, cons);
7937   int i;
7938
7939   rv = Val_int (0);
7940   for (i = 0; argv[i] != NULL; i += 2) {
7941     kv = caml_copy_string (argv[i]);
7942     vv = caml_copy_string (argv[i+1]);
7943     pairv = caml_alloc (2, 0);
7944     Store_field (pairv, 0, kv);
7945     Store_field (pairv, 1, vv);
7946     cons = caml_alloc (2, 0);
7947     Store_field (cons, 1, rv);
7948     rv = cons;
7949     Store_field (cons, 0, pairv);
7950   }
7951
7952   CAMLreturn (rv);
7953 }
7954
7955 ";
7956
7957   (* Struct copy functions. *)
7958
7959   let emit_ocaml_copy_list_function typ =
7960     pr "static CAMLprim value\n";
7961     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7962     pr "{\n";
7963     pr "  CAMLparam0 ();\n";
7964     pr "  CAMLlocal2 (rv, v);\n";
7965     pr "  unsigned int i;\n";
7966     pr "\n";
7967     pr "  if (%ss->len == 0)\n" typ;
7968     pr "    CAMLreturn (Atom (0));\n";
7969     pr "  else {\n";
7970     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7971     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7972     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7973     pr "      caml_modify (&Field (rv, i), v);\n";
7974     pr "    }\n";
7975     pr "    CAMLreturn (rv);\n";
7976     pr "  }\n";
7977     pr "}\n";
7978     pr "\n";
7979   in
7980
7981   List.iter (
7982     fun (typ, cols) ->
7983       let has_optpercent_col =
7984         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7985
7986       pr "static CAMLprim value\n";
7987       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7988       pr "{\n";
7989       pr "  CAMLparam0 ();\n";
7990       if has_optpercent_col then
7991         pr "  CAMLlocal3 (rv, v, v2);\n"
7992       else
7993         pr "  CAMLlocal2 (rv, v);\n";
7994       pr "\n";
7995       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7996       iteri (
7997         fun i col ->
7998           (match col with
7999            | name, FString ->
8000                pr "  v = caml_copy_string (%s->%s);\n" typ name
8001            | name, FBuffer ->
8002                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8003                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8004                  typ name typ name
8005            | name, FUUID ->
8006                pr "  v = caml_alloc_string (32);\n";
8007                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8008            | name, (FBytes|FInt64|FUInt64) ->
8009                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8010            | name, (FInt32|FUInt32) ->
8011                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8012            | name, FOptPercent ->
8013                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8014                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8015                pr "    v = caml_alloc (1, 0);\n";
8016                pr "    Store_field (v, 0, v2);\n";
8017                pr "  } else /* None */\n";
8018                pr "    v = Val_int (0);\n";
8019            | name, FChar ->
8020                pr "  v = Val_int (%s->%s);\n" typ name
8021           );
8022           pr "  Store_field (rv, %d, v);\n" i
8023       ) cols;
8024       pr "  CAMLreturn (rv);\n";
8025       pr "}\n";
8026       pr "\n";
8027   ) structs;
8028
8029   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8030   List.iter (
8031     function
8032     | typ, (RStructListOnly | RStructAndList) ->
8033         (* generate the function for typ *)
8034         emit_ocaml_copy_list_function typ
8035     | typ, _ -> () (* empty *)
8036   ) (rstructs_used_by all_functions);
8037
8038   (* The wrappers. *)
8039   List.iter (
8040     fun (name, style, _, _, _, _, _) ->
8041       pr "/* Automatically generated wrapper for function\n";
8042       pr " * ";
8043       generate_ocaml_prototype name style;
8044       pr " */\n";
8045       pr "\n";
8046
8047       let params =
8048         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8049
8050       let needs_extra_vs =
8051         match fst style with RConstOptString _ -> true | _ -> false in
8052
8053       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8054       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8055       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8056       pr "\n";
8057
8058       pr "CAMLprim value\n";
8059       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8060       List.iter (pr ", value %s") (List.tl params);
8061       pr ")\n";
8062       pr "{\n";
8063
8064       (match params with
8065        | [p1; p2; p3; p4; p5] ->
8066            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8067        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8068            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8069            pr "  CAMLxparam%d (%s);\n"
8070              (List.length rest) (String.concat ", " rest)
8071        | ps ->
8072            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8073       );
8074       if not needs_extra_vs then
8075         pr "  CAMLlocal1 (rv);\n"
8076       else
8077         pr "  CAMLlocal3 (rv, v, v2);\n";
8078       pr "\n";
8079
8080       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8081       pr "  if (g == NULL)\n";
8082       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8083       pr "\n";
8084
8085       List.iter (
8086         function
8087         | Pathname n
8088         | Device n | Dev_or_Path n
8089         | String n
8090         | FileIn n
8091         | FileOut n ->
8092             (* Copy strings in case the GC moves them: RHBZ#604691 *)
8093             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
8094         | OptString n ->
8095             pr "  char *%s =\n" n;
8096             pr "    %sv != Val_int (0) ?" n;
8097             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
8098         | StringList n | DeviceList n ->
8099             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8100         | Bool n ->
8101             pr "  int %s = Bool_val (%sv);\n" n n
8102         | Int n ->
8103             pr "  int %s = Int_val (%sv);\n" n n
8104         | Int64 n ->
8105             pr "  int64_t %s = Int64_val (%sv);\n" n n
8106       ) (snd style);
8107       let error_code =
8108         match fst style with
8109         | RErr -> pr "  int r;\n"; "-1"
8110         | RInt _ -> pr "  int r;\n"; "-1"
8111         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8112         | RBool _ -> pr "  int r;\n"; "-1"
8113         | RConstString _ | RConstOptString _ ->
8114             pr "  const char *r;\n"; "NULL"
8115         | RString _ -> pr "  char *r;\n"; "NULL"
8116         | RStringList _ ->
8117             pr "  int i;\n";
8118             pr "  char **r;\n";
8119             "NULL"
8120         | RStruct (_, typ) ->
8121             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8122         | RStructList (_, typ) ->
8123             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8124         | RHashtable _ ->
8125             pr "  int i;\n";
8126             pr "  char **r;\n";
8127             "NULL"
8128         | RBufferOut _ ->
8129             pr "  char *r;\n";
8130             pr "  size_t size;\n";
8131             "NULL" in
8132       pr "\n";
8133
8134       pr "  caml_enter_blocking_section ();\n";
8135       pr "  r = guestfs_%s " name;
8136       generate_c_call_args ~handle:"g" style;
8137       pr ";\n";
8138       pr "  caml_leave_blocking_section ();\n";
8139
8140       (* Free strings if we copied them above. *)
8141       List.iter (
8142         function
8143         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
8144         | FileIn n | FileOut n ->
8145             pr "  free (%s);\n" n
8146         | StringList n | DeviceList n ->
8147             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8148         | Bool _ | Int _ | Int64 _ -> ()
8149       ) (snd style);
8150
8151       pr "  if (r == %s)\n" error_code;
8152       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8153       pr "\n";
8154
8155       (match fst style with
8156        | RErr -> pr "  rv = Val_unit;\n"
8157        | RInt _ -> pr "  rv = Val_int (r);\n"
8158        | RInt64 _ ->
8159            pr "  rv = caml_copy_int64 (r);\n"
8160        | RBool _ -> pr "  rv = Val_bool (r);\n"
8161        | RConstString _ ->
8162            pr "  rv = caml_copy_string (r);\n"
8163        | RConstOptString _ ->
8164            pr "  if (r) { /* Some string */\n";
8165            pr "    v = caml_alloc (1, 0);\n";
8166            pr "    v2 = caml_copy_string (r);\n";
8167            pr "    Store_field (v, 0, v2);\n";
8168            pr "  } else /* None */\n";
8169            pr "    v = Val_int (0);\n";
8170        | RString _ ->
8171            pr "  rv = caml_copy_string (r);\n";
8172            pr "  free (r);\n"
8173        | RStringList _ ->
8174            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8175            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8176            pr "  free (r);\n"
8177        | RStruct (_, typ) ->
8178            pr "  rv = copy_%s (r);\n" typ;
8179            pr "  guestfs_free_%s (r);\n" typ;
8180        | RStructList (_, typ) ->
8181            pr "  rv = copy_%s_list (r);\n" typ;
8182            pr "  guestfs_free_%s_list (r);\n" typ;
8183        | RHashtable _ ->
8184            pr "  rv = copy_table (r);\n";
8185            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8186            pr "  free (r);\n";
8187        | RBufferOut _ ->
8188            pr "  rv = caml_alloc_string (size);\n";
8189            pr "  memcpy (String_val (rv), r, size);\n";
8190       );
8191
8192       pr "  CAMLreturn (rv);\n";
8193       pr "}\n";
8194       pr "\n";
8195
8196       if List.length params > 5 then (
8197         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8198         pr "CAMLprim value ";
8199         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8200         pr "CAMLprim value\n";
8201         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8202         pr "{\n";
8203         pr "  return ocaml_guestfs_%s (argv[0]" name;
8204         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8205         pr ");\n";
8206         pr "}\n";
8207         pr "\n"
8208       )
8209   ) all_functions_sorted
8210
8211 and generate_ocaml_structure_decls () =
8212   List.iter (
8213     fun (typ, cols) ->
8214       pr "type %s = {\n" typ;
8215       List.iter (
8216         function
8217         | name, FString -> pr "  %s : string;\n" name
8218         | name, FBuffer -> pr "  %s : string;\n" name
8219         | name, FUUID -> pr "  %s : string;\n" name
8220         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8221         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8222         | name, FChar -> pr "  %s : char;\n" name
8223         | name, FOptPercent -> pr "  %s : float option;\n" name
8224       ) cols;
8225       pr "}\n";
8226       pr "\n"
8227   ) structs
8228
8229 and generate_ocaml_prototype ?(is_external = false) name style =
8230   if is_external then pr "external " else pr "val ";
8231   pr "%s : t -> " name;
8232   List.iter (
8233     function
8234     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8235     | OptString _ -> pr "string option -> "
8236     | StringList _ | DeviceList _ -> pr "string array -> "
8237     | Bool _ -> pr "bool -> "
8238     | Int _ -> pr "int -> "
8239     | Int64 _ -> pr "int64 -> "
8240   ) (snd style);
8241   (match fst style with
8242    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8243    | RInt _ -> pr "int"
8244    | RInt64 _ -> pr "int64"
8245    | RBool _ -> pr "bool"
8246    | RConstString _ -> pr "string"
8247    | RConstOptString _ -> pr "string option"
8248    | RString _ | RBufferOut _ -> pr "string"
8249    | RStringList _ -> pr "string array"
8250    | RStruct (_, typ) -> pr "%s" typ
8251    | RStructList (_, typ) -> pr "%s array" typ
8252    | RHashtable _ -> pr "(string * string) list"
8253   );
8254   if is_external then (
8255     pr " = ";
8256     if List.length (snd style) + 1 > 5 then
8257       pr "\"ocaml_guestfs_%s_byte\" " name;
8258     pr "\"ocaml_guestfs_%s\"" name
8259   );
8260   pr "\n"
8261
8262 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8263 and generate_perl_xs () =
8264   generate_header CStyle LGPLv2plus;
8265
8266   pr "\
8267 #include \"EXTERN.h\"
8268 #include \"perl.h\"
8269 #include \"XSUB.h\"
8270
8271 #include <guestfs.h>
8272
8273 #ifndef PRId64
8274 #define PRId64 \"lld\"
8275 #endif
8276
8277 static SV *
8278 my_newSVll(long long val) {
8279 #ifdef USE_64_BIT_ALL
8280   return newSViv(val);
8281 #else
8282   char buf[100];
8283   int len;
8284   len = snprintf(buf, 100, \"%%\" PRId64, val);
8285   return newSVpv(buf, len);
8286 #endif
8287 }
8288
8289 #ifndef PRIu64
8290 #define PRIu64 \"llu\"
8291 #endif
8292
8293 static SV *
8294 my_newSVull(unsigned long long val) {
8295 #ifdef USE_64_BIT_ALL
8296   return newSVuv(val);
8297 #else
8298   char buf[100];
8299   int len;
8300   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8301   return newSVpv(buf, len);
8302 #endif
8303 }
8304
8305 /* http://www.perlmonks.org/?node_id=680842 */
8306 static char **
8307 XS_unpack_charPtrPtr (SV *arg) {
8308   char **ret;
8309   AV *av;
8310   I32 i;
8311
8312   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8313     croak (\"array reference expected\");
8314
8315   av = (AV *)SvRV (arg);
8316   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8317   if (!ret)
8318     croak (\"malloc failed\");
8319
8320   for (i = 0; i <= av_len (av); i++) {
8321     SV **elem = av_fetch (av, i, 0);
8322
8323     if (!elem || !*elem)
8324       croak (\"missing element in list\");
8325
8326     ret[i] = SvPV_nolen (*elem);
8327   }
8328
8329   ret[i] = NULL;
8330
8331   return ret;
8332 }
8333
8334 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8335
8336 PROTOTYPES: ENABLE
8337
8338 guestfs_h *
8339 _create ()
8340    CODE:
8341       RETVAL = guestfs_create ();
8342       if (!RETVAL)
8343         croak (\"could not create guestfs handle\");
8344       guestfs_set_error_handler (RETVAL, NULL, NULL);
8345  OUTPUT:
8346       RETVAL
8347
8348 void
8349 DESTROY (g)
8350       guestfs_h *g;
8351  PPCODE:
8352       guestfs_close (g);
8353
8354 ";
8355
8356   List.iter (
8357     fun (name, style, _, _, _, _, _) ->
8358       (match fst style with
8359        | RErr -> pr "void\n"
8360        | RInt _ -> pr "SV *\n"
8361        | RInt64 _ -> pr "SV *\n"
8362        | RBool _ -> pr "SV *\n"
8363        | RConstString _ -> pr "SV *\n"
8364        | RConstOptString _ -> pr "SV *\n"
8365        | RString _ -> pr "SV *\n"
8366        | RBufferOut _ -> pr "SV *\n"
8367        | RStringList _
8368        | RStruct _ | RStructList _
8369        | RHashtable _ ->
8370            pr "void\n" (* all lists returned implictly on the stack *)
8371       );
8372       (* Call and arguments. *)
8373       pr "%s " name;
8374       generate_c_call_args ~handle:"g" ~decl:true style;
8375       pr "\n";
8376       pr "      guestfs_h *g;\n";
8377       iteri (
8378         fun i ->
8379           function
8380           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8381               pr "      char *%s;\n" n
8382           | OptString n ->
8383               (* http://www.perlmonks.org/?node_id=554277
8384                * Note that the implicit handle argument means we have
8385                * to add 1 to the ST(x) operator.
8386                *)
8387               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8388           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8389           | Bool n -> pr "      int %s;\n" n
8390           | Int n -> pr "      int %s;\n" n
8391           | Int64 n -> pr "      int64_t %s;\n" n
8392       ) (snd style);
8393
8394       let do_cleanups () =
8395         List.iter (
8396           function
8397           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8398           | Bool _ | Int _ | Int64 _
8399           | FileIn _ | FileOut _ -> ()
8400           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8401         ) (snd style)
8402       in
8403
8404       (* Code. *)
8405       (match fst style with
8406        | RErr ->
8407            pr "PREINIT:\n";
8408            pr "      int r;\n";
8409            pr " PPCODE:\n";
8410            pr "      r = guestfs_%s " name;
8411            generate_c_call_args ~handle:"g" style;
8412            pr ";\n";
8413            do_cleanups ();
8414            pr "      if (r == -1)\n";
8415            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8416        | RInt n
8417        | RBool n ->
8418            pr "PREINIT:\n";
8419            pr "      int %s;\n" n;
8420            pr "   CODE:\n";
8421            pr "      %s = guestfs_%s " n name;
8422            generate_c_call_args ~handle:"g" style;
8423            pr ";\n";
8424            do_cleanups ();
8425            pr "      if (%s == -1)\n" n;
8426            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8427            pr "      RETVAL = newSViv (%s);\n" n;
8428            pr " OUTPUT:\n";
8429            pr "      RETVAL\n"
8430        | RInt64 n ->
8431            pr "PREINIT:\n";
8432            pr "      int64_t %s;\n" n;
8433            pr "   CODE:\n";
8434            pr "      %s = guestfs_%s " n name;
8435            generate_c_call_args ~handle:"g" style;
8436            pr ";\n";
8437            do_cleanups ();
8438            pr "      if (%s == -1)\n" n;
8439            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8440            pr "      RETVAL = my_newSVll (%s);\n" n;
8441            pr " OUTPUT:\n";
8442            pr "      RETVAL\n"
8443        | RConstString n ->
8444            pr "PREINIT:\n";
8445            pr "      const char *%s;\n" n;
8446            pr "   CODE:\n";
8447            pr "      %s = guestfs_%s " n name;
8448            generate_c_call_args ~handle:"g" style;
8449            pr ";\n";
8450            do_cleanups ();
8451            pr "      if (%s == NULL)\n" n;
8452            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8453            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8454            pr " OUTPUT:\n";
8455            pr "      RETVAL\n"
8456        | RConstOptString n ->
8457            pr "PREINIT:\n";
8458            pr "      const char *%s;\n" n;
8459            pr "   CODE:\n";
8460            pr "      %s = guestfs_%s " n name;
8461            generate_c_call_args ~handle:"g" style;
8462            pr ";\n";
8463            do_cleanups ();
8464            pr "      if (%s == NULL)\n" n;
8465            pr "        RETVAL = &PL_sv_undef;\n";
8466            pr "      else\n";
8467            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8468            pr " OUTPUT:\n";
8469            pr "      RETVAL\n"
8470        | RString n ->
8471            pr "PREINIT:\n";
8472            pr "      char *%s;\n" n;
8473            pr "   CODE:\n";
8474            pr "      %s = guestfs_%s " n name;
8475            generate_c_call_args ~handle:"g" style;
8476            pr ";\n";
8477            do_cleanups ();
8478            pr "      if (%s == NULL)\n" n;
8479            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8480            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8481            pr "      free (%s);\n" n;
8482            pr " OUTPUT:\n";
8483            pr "      RETVAL\n"
8484        | RStringList n | RHashtable n ->
8485            pr "PREINIT:\n";
8486            pr "      char **%s;\n" n;
8487            pr "      int i, n;\n";
8488            pr " PPCODE:\n";
8489            pr "      %s = guestfs_%s " n name;
8490            generate_c_call_args ~handle:"g" style;
8491            pr ";\n";
8492            do_cleanups ();
8493            pr "      if (%s == NULL)\n" n;
8494            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8495            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8496            pr "      EXTEND (SP, n);\n";
8497            pr "      for (i = 0; i < n; ++i) {\n";
8498            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8499            pr "        free (%s[i]);\n" n;
8500            pr "      }\n";
8501            pr "      free (%s);\n" n;
8502        | RStruct (n, typ) ->
8503            let cols = cols_of_struct typ in
8504            generate_perl_struct_code typ cols name style n do_cleanups
8505        | RStructList (n, typ) ->
8506            let cols = cols_of_struct typ in
8507            generate_perl_struct_list_code typ cols name style n do_cleanups
8508        | RBufferOut n ->
8509            pr "PREINIT:\n";
8510            pr "      char *%s;\n" n;
8511            pr "      size_t size;\n";
8512            pr "   CODE:\n";
8513            pr "      %s = guestfs_%s " n name;
8514            generate_c_call_args ~handle:"g" style;
8515            pr ";\n";
8516            do_cleanups ();
8517            pr "      if (%s == NULL)\n" n;
8518            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8519            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8520            pr "      free (%s);\n" n;
8521            pr " OUTPUT:\n";
8522            pr "      RETVAL\n"
8523       );
8524
8525       pr "\n"
8526   ) all_functions
8527
8528 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8529   pr "PREINIT:\n";
8530   pr "      struct guestfs_%s_list *%s;\n" typ n;
8531   pr "      int i;\n";
8532   pr "      HV *hv;\n";
8533   pr " PPCODE:\n";
8534   pr "      %s = guestfs_%s " n name;
8535   generate_c_call_args ~handle:"g" style;
8536   pr ";\n";
8537   do_cleanups ();
8538   pr "      if (%s == NULL)\n" n;
8539   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8540   pr "      EXTEND (SP, %s->len);\n" n;
8541   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8542   pr "        hv = newHV ();\n";
8543   List.iter (
8544     function
8545     | name, FString ->
8546         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8547           name (String.length name) n name
8548     | name, FUUID ->
8549         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8550           name (String.length name) n name
8551     | name, FBuffer ->
8552         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8553           name (String.length name) n name n name
8554     | name, (FBytes|FUInt64) ->
8555         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8556           name (String.length name) n name
8557     | name, FInt64 ->
8558         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8559           name (String.length name) n name
8560     | name, (FInt32|FUInt32) ->
8561         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8562           name (String.length name) n name
8563     | name, FChar ->
8564         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8565           name (String.length name) n name
8566     | name, FOptPercent ->
8567         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8568           name (String.length name) n name
8569   ) cols;
8570   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8571   pr "      }\n";
8572   pr "      guestfs_free_%s_list (%s);\n" typ n
8573
8574 and generate_perl_struct_code typ cols name style n do_cleanups =
8575   pr "PREINIT:\n";
8576   pr "      struct guestfs_%s *%s;\n" typ n;
8577   pr " PPCODE:\n";
8578   pr "      %s = guestfs_%s " n name;
8579   generate_c_call_args ~handle:"g" style;
8580   pr ";\n";
8581   do_cleanups ();
8582   pr "      if (%s == NULL)\n" n;
8583   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8584   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8585   List.iter (
8586     fun ((name, _) as col) ->
8587       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8588
8589       match col with
8590       | name, FString ->
8591           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8592             n name
8593       | name, FBuffer ->
8594           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8595             n name n name
8596       | name, FUUID ->
8597           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8598             n name
8599       | name, (FBytes|FUInt64) ->
8600           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8601             n name
8602       | name, FInt64 ->
8603           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8604             n name
8605       | name, (FInt32|FUInt32) ->
8606           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8607             n name
8608       | name, FChar ->
8609           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8610             n name
8611       | name, FOptPercent ->
8612           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8613             n name
8614   ) cols;
8615   pr "      free (%s);\n" n
8616
8617 (* Generate Sys/Guestfs.pm. *)
8618 and generate_perl_pm () =
8619   generate_header HashStyle LGPLv2plus;
8620
8621   pr "\
8622 =pod
8623
8624 =head1 NAME
8625
8626 Sys::Guestfs - Perl bindings for libguestfs
8627
8628 =head1 SYNOPSIS
8629
8630  use Sys::Guestfs;
8631
8632  my $h = Sys::Guestfs->new ();
8633  $h->add_drive ('guest.img');
8634  $h->launch ();
8635  $h->mount ('/dev/sda1', '/');
8636  $h->touch ('/hello');
8637  $h->sync ();
8638
8639 =head1 DESCRIPTION
8640
8641 The C<Sys::Guestfs> module provides a Perl XS binding to the
8642 libguestfs API for examining and modifying virtual machine
8643 disk images.
8644
8645 Amongst the things this is good for: making batch configuration
8646 changes to guests, getting disk used/free statistics (see also:
8647 virt-df), migrating between virtualization systems (see also:
8648 virt-p2v), performing partial backups, performing partial guest
8649 clones, cloning guests and changing registry/UUID/hostname info, and
8650 much else besides.
8651
8652 Libguestfs uses Linux kernel and qemu code, and can access any type of
8653 guest filesystem that Linux and qemu can, including but not limited
8654 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8655 schemes, qcow, qcow2, vmdk.
8656
8657 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8658 LVs, what filesystem is in each LV, etc.).  It can also run commands
8659 in the context of the guest.  Also you can access filesystems over
8660 FUSE.
8661
8662 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8663 functions for using libguestfs from Perl, including integration
8664 with libvirt.
8665
8666 =head1 ERRORS
8667
8668 All errors turn into calls to C<croak> (see L<Carp(3)>).
8669
8670 =head1 METHODS
8671
8672 =over 4
8673
8674 =cut
8675
8676 package Sys::Guestfs;
8677
8678 use strict;
8679 use warnings;
8680
8681 require XSLoader;
8682 XSLoader::load ('Sys::Guestfs');
8683
8684 =item $h = Sys::Guestfs->new ();
8685
8686 Create a new guestfs handle.
8687
8688 =cut
8689
8690 sub new {
8691   my $proto = shift;
8692   my $class = ref ($proto) || $proto;
8693
8694   my $self = Sys::Guestfs::_create ();
8695   bless $self, $class;
8696   return $self;
8697 }
8698
8699 ";
8700
8701   (* Actions.  We only need to print documentation for these as
8702    * they are pulled in from the XS code automatically.
8703    *)
8704   List.iter (
8705     fun (name, style, _, flags, _, _, longdesc) ->
8706       if not (List.mem NotInDocs flags) then (
8707         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8708         pr "=item ";
8709         generate_perl_prototype name style;
8710         pr "\n\n";
8711         pr "%s\n\n" longdesc;
8712         if List.mem ProtocolLimitWarning flags then
8713           pr "%s\n\n" protocol_limit_warning;
8714         if List.mem DangerWillRobinson flags then
8715           pr "%s\n\n" danger_will_robinson;
8716         match deprecation_notice flags with
8717         | None -> ()
8718         | Some txt -> pr "%s\n\n" txt
8719       )
8720   ) all_functions_sorted;
8721
8722   (* End of file. *)
8723   pr "\
8724 =cut
8725
8726 1;
8727
8728 =back
8729
8730 =head1 COPYRIGHT
8731
8732 Copyright (C) %s Red Hat Inc.
8733
8734 =head1 LICENSE
8735
8736 Please see the file COPYING.LIB for the full license.
8737
8738 =head1 SEE ALSO
8739
8740 L<guestfs(3)>,
8741 L<guestfish(1)>,
8742 L<http://libguestfs.org>,
8743 L<Sys::Guestfs::Lib(3)>.
8744
8745 =cut
8746 " copyright_years
8747
8748 and generate_perl_prototype name style =
8749   (match fst style with
8750    | RErr -> ()
8751    | RBool n
8752    | RInt n
8753    | RInt64 n
8754    | RConstString n
8755    | RConstOptString n
8756    | RString n
8757    | RBufferOut n -> pr "$%s = " n
8758    | RStruct (n,_)
8759    | RHashtable n -> pr "%%%s = " n
8760    | RStringList n
8761    | RStructList (n,_) -> pr "@%s = " n
8762   );
8763   pr "$h->%s (" name;
8764   let comma = ref false in
8765   List.iter (
8766     fun arg ->
8767       if !comma then pr ", ";
8768       comma := true;
8769       match arg with
8770       | Pathname n | Device n | Dev_or_Path n | String n
8771       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8772           pr "$%s" n
8773       | StringList n | DeviceList n ->
8774           pr "\\@%s" n
8775   ) (snd style);
8776   pr ");"
8777
8778 (* Generate Python C module. *)
8779 and generate_python_c () =
8780   generate_header CStyle LGPLv2plus;
8781
8782   pr "\
8783 #include <Python.h>
8784
8785 #include <stdio.h>
8786 #include <stdlib.h>
8787 #include <assert.h>
8788
8789 #include \"guestfs.h\"
8790
8791 typedef struct {
8792   PyObject_HEAD
8793   guestfs_h *g;
8794 } Pyguestfs_Object;
8795
8796 static guestfs_h *
8797 get_handle (PyObject *obj)
8798 {
8799   assert (obj);
8800   assert (obj != Py_None);
8801   return ((Pyguestfs_Object *) obj)->g;
8802 }
8803
8804 static PyObject *
8805 put_handle (guestfs_h *g)
8806 {
8807   assert (g);
8808   return
8809     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8810 }
8811
8812 /* This list should be freed (but not the strings) after use. */
8813 static char **
8814 get_string_list (PyObject *obj)
8815 {
8816   int i, len;
8817   char **r;
8818
8819   assert (obj);
8820
8821   if (!PyList_Check (obj)) {
8822     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8823     return NULL;
8824   }
8825
8826   len = PyList_Size (obj);
8827   r = malloc (sizeof (char *) * (len+1));
8828   if (r == NULL) {
8829     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8830     return NULL;
8831   }
8832
8833   for (i = 0; i < len; ++i)
8834     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8835   r[len] = NULL;
8836
8837   return r;
8838 }
8839
8840 static PyObject *
8841 put_string_list (char * const * const argv)
8842 {
8843   PyObject *list;
8844   int argc, i;
8845
8846   for (argc = 0; argv[argc] != NULL; ++argc)
8847     ;
8848
8849   list = PyList_New (argc);
8850   for (i = 0; i < argc; ++i)
8851     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8852
8853   return list;
8854 }
8855
8856 static PyObject *
8857 put_table (char * const * const argv)
8858 {
8859   PyObject *list, *item;
8860   int argc, i;
8861
8862   for (argc = 0; argv[argc] != NULL; ++argc)
8863     ;
8864
8865   list = PyList_New (argc >> 1);
8866   for (i = 0; i < argc; i += 2) {
8867     item = PyTuple_New (2);
8868     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8869     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8870     PyList_SetItem (list, i >> 1, item);
8871   }
8872
8873   return list;
8874 }
8875
8876 static void
8877 free_strings (char **argv)
8878 {
8879   int argc;
8880
8881   for (argc = 0; argv[argc] != NULL; ++argc)
8882     free (argv[argc]);
8883   free (argv);
8884 }
8885
8886 static PyObject *
8887 py_guestfs_create (PyObject *self, PyObject *args)
8888 {
8889   guestfs_h *g;
8890
8891   g = guestfs_create ();
8892   if (g == NULL) {
8893     PyErr_SetString (PyExc_RuntimeError,
8894                      \"guestfs.create: failed to allocate handle\");
8895     return NULL;
8896   }
8897   guestfs_set_error_handler (g, NULL, NULL);
8898   return put_handle (g);
8899 }
8900
8901 static PyObject *
8902 py_guestfs_close (PyObject *self, PyObject *args)
8903 {
8904   PyObject *py_g;
8905   guestfs_h *g;
8906
8907   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8908     return NULL;
8909   g = get_handle (py_g);
8910
8911   guestfs_close (g);
8912
8913   Py_INCREF (Py_None);
8914   return Py_None;
8915 }
8916
8917 ";
8918
8919   let emit_put_list_function typ =
8920     pr "static PyObject *\n";
8921     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8922     pr "{\n";
8923     pr "  PyObject *list;\n";
8924     pr "  int i;\n";
8925     pr "\n";
8926     pr "  list = PyList_New (%ss->len);\n" typ;
8927     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8928     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8929     pr "  return list;\n";
8930     pr "};\n";
8931     pr "\n"
8932   in
8933
8934   (* Structures, turned into Python dictionaries. *)
8935   List.iter (
8936     fun (typ, cols) ->
8937       pr "static PyObject *\n";
8938       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8939       pr "{\n";
8940       pr "  PyObject *dict;\n";
8941       pr "\n";
8942       pr "  dict = PyDict_New ();\n";
8943       List.iter (
8944         function
8945         | name, FString ->
8946             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8947             pr "                        PyString_FromString (%s->%s));\n"
8948               typ name
8949         | name, FBuffer ->
8950             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8951             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8952               typ name typ name
8953         | name, FUUID ->
8954             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8955             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8956               typ name
8957         | name, (FBytes|FUInt64) ->
8958             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8959             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8960               typ name
8961         | name, FInt64 ->
8962             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8963             pr "                        PyLong_FromLongLong (%s->%s));\n"
8964               typ name
8965         | name, FUInt32 ->
8966             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8967             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8968               typ name
8969         | name, FInt32 ->
8970             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8971             pr "                        PyLong_FromLong (%s->%s));\n"
8972               typ name
8973         | name, FOptPercent ->
8974             pr "  if (%s->%s >= 0)\n" typ name;
8975             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8976             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8977               typ name;
8978             pr "  else {\n";
8979             pr "    Py_INCREF (Py_None);\n";
8980             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8981             pr "  }\n"
8982         | name, FChar ->
8983             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8984             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8985       ) cols;
8986       pr "  return dict;\n";
8987       pr "};\n";
8988       pr "\n";
8989
8990   ) structs;
8991
8992   (* Emit a put_TYPE_list function definition only if that function is used. *)
8993   List.iter (
8994     function
8995     | typ, (RStructListOnly | RStructAndList) ->
8996         (* generate the function for typ *)
8997         emit_put_list_function typ
8998     | typ, _ -> () (* empty *)
8999   ) (rstructs_used_by all_functions);
9000
9001   (* Python wrapper functions. *)
9002   List.iter (
9003     fun (name, style, _, _, _, _, _) ->
9004       pr "static PyObject *\n";
9005       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9006       pr "{\n";
9007
9008       pr "  PyObject *py_g;\n";
9009       pr "  guestfs_h *g;\n";
9010       pr "  PyObject *py_r;\n";
9011
9012       let error_code =
9013         match fst style with
9014         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9015         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9016         | RConstString _ | RConstOptString _ ->
9017             pr "  const char *r;\n"; "NULL"
9018         | RString _ -> pr "  char *r;\n"; "NULL"
9019         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9020         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9021         | RStructList (_, typ) ->
9022             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9023         | RBufferOut _ ->
9024             pr "  char *r;\n";
9025             pr "  size_t size;\n";
9026             "NULL" in
9027
9028       List.iter (
9029         function
9030         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9031             pr "  const char *%s;\n" n
9032         | OptString n -> pr "  const char *%s;\n" n
9033         | StringList n | DeviceList n ->
9034             pr "  PyObject *py_%s;\n" n;
9035             pr "  char **%s;\n" n
9036         | Bool n -> pr "  int %s;\n" n
9037         | Int n -> pr "  int %s;\n" n
9038         | Int64 n -> pr "  long long %s;\n" n
9039       ) (snd style);
9040
9041       pr "\n";
9042
9043       (* Convert the parameters. *)
9044       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9045       List.iter (
9046         function
9047         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9048         | OptString _ -> pr "z"
9049         | StringList _ | DeviceList _ -> pr "O"
9050         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9051         | Int _ -> pr "i"
9052         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9053                              * emulate C's int/long/long long in Python?
9054                              *)
9055       ) (snd style);
9056       pr ":guestfs_%s\",\n" name;
9057       pr "                         &py_g";
9058       List.iter (
9059         function
9060         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9061         | OptString n -> pr ", &%s" n
9062         | StringList n | DeviceList n -> pr ", &py_%s" n
9063         | Bool n -> pr ", &%s" n
9064         | Int n -> pr ", &%s" n
9065         | Int64 n -> pr ", &%s" n
9066       ) (snd style);
9067
9068       pr "))\n";
9069       pr "    return NULL;\n";
9070
9071       pr "  g = get_handle (py_g);\n";
9072       List.iter (
9073         function
9074         | Pathname _ | Device _ | Dev_or_Path _ | String _
9075         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9076         | StringList n | DeviceList n ->
9077             pr "  %s = get_string_list (py_%s);\n" n n;
9078             pr "  if (!%s) return NULL;\n" n
9079       ) (snd style);
9080
9081       pr "\n";
9082
9083       pr "  r = guestfs_%s " name;
9084       generate_c_call_args ~handle:"g" style;
9085       pr ";\n";
9086
9087       List.iter (
9088         function
9089         | Pathname _ | Device _ | Dev_or_Path _ | String _
9090         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9091         | StringList n | DeviceList n ->
9092             pr "  free (%s);\n" n
9093       ) (snd style);
9094
9095       pr "  if (r == %s) {\n" error_code;
9096       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9097       pr "    return NULL;\n";
9098       pr "  }\n";
9099       pr "\n";
9100
9101       (match fst style with
9102        | RErr ->
9103            pr "  Py_INCREF (Py_None);\n";
9104            pr "  py_r = Py_None;\n"
9105        | RInt _
9106        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9107        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9108        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9109        | RConstOptString _ ->
9110            pr "  if (r)\n";
9111            pr "    py_r = PyString_FromString (r);\n";
9112            pr "  else {\n";
9113            pr "    Py_INCREF (Py_None);\n";
9114            pr "    py_r = Py_None;\n";
9115            pr "  }\n"
9116        | RString _ ->
9117            pr "  py_r = PyString_FromString (r);\n";
9118            pr "  free (r);\n"
9119        | RStringList _ ->
9120            pr "  py_r = put_string_list (r);\n";
9121            pr "  free_strings (r);\n"
9122        | RStruct (_, typ) ->
9123            pr "  py_r = put_%s (r);\n" typ;
9124            pr "  guestfs_free_%s (r);\n" typ
9125        | RStructList (_, typ) ->
9126            pr "  py_r = put_%s_list (r);\n" typ;
9127            pr "  guestfs_free_%s_list (r);\n" typ
9128        | RHashtable n ->
9129            pr "  py_r = put_table (r);\n";
9130            pr "  free_strings (r);\n"
9131        | RBufferOut _ ->
9132            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9133            pr "  free (r);\n"
9134       );
9135
9136       pr "  return py_r;\n";
9137       pr "}\n";
9138       pr "\n"
9139   ) all_functions;
9140
9141   (* Table of functions. *)
9142   pr "static PyMethodDef methods[] = {\n";
9143   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9144   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9145   List.iter (
9146     fun (name, _, _, _, _, _, _) ->
9147       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9148         name name
9149   ) all_functions;
9150   pr "  { NULL, NULL, 0, NULL }\n";
9151   pr "};\n";
9152   pr "\n";
9153
9154   (* Init function. *)
9155   pr "\
9156 void
9157 initlibguestfsmod (void)
9158 {
9159   static int initialized = 0;
9160
9161   if (initialized) return;
9162   Py_InitModule ((char *) \"libguestfsmod\", methods);
9163   initialized = 1;
9164 }
9165 "
9166
9167 (* Generate Python module. *)
9168 and generate_python_py () =
9169   generate_header HashStyle LGPLv2plus;
9170
9171   pr "\
9172 u\"\"\"Python bindings for libguestfs
9173
9174 import guestfs
9175 g = guestfs.GuestFS ()
9176 g.add_drive (\"guest.img\")
9177 g.launch ()
9178 parts = g.list_partitions ()
9179
9180 The guestfs module provides a Python binding to the libguestfs API
9181 for examining and modifying virtual machine disk images.
9182
9183 Amongst the things this is good for: making batch configuration
9184 changes to guests, getting disk used/free statistics (see also:
9185 virt-df), migrating between virtualization systems (see also:
9186 virt-p2v), performing partial backups, performing partial guest
9187 clones, cloning guests and changing registry/UUID/hostname info, and
9188 much else besides.
9189
9190 Libguestfs uses Linux kernel and qemu code, and can access any type of
9191 guest filesystem that Linux and qemu can, including but not limited
9192 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9193 schemes, qcow, qcow2, vmdk.
9194
9195 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9196 LVs, what filesystem is in each LV, etc.).  It can also run commands
9197 in the context of the guest.  Also you can access filesystems over
9198 FUSE.
9199
9200 Errors which happen while using the API are turned into Python
9201 RuntimeError exceptions.
9202
9203 To create a guestfs handle you usually have to perform the following
9204 sequence of calls:
9205
9206 # Create the handle, call add_drive at least once, and possibly
9207 # several times if the guest has multiple block devices:
9208 g = guestfs.GuestFS ()
9209 g.add_drive (\"guest.img\")
9210
9211 # Launch the qemu subprocess and wait for it to become ready:
9212 g.launch ()
9213
9214 # Now you can issue commands, for example:
9215 logvols = g.lvs ()
9216
9217 \"\"\"
9218
9219 import libguestfsmod
9220
9221 class GuestFS:
9222     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9223
9224     def __init__ (self):
9225         \"\"\"Create a new libguestfs handle.\"\"\"
9226         self._o = libguestfsmod.create ()
9227
9228     def __del__ (self):
9229         libguestfsmod.close (self._o)
9230
9231 ";
9232
9233   List.iter (
9234     fun (name, style, _, flags, _, _, longdesc) ->
9235       pr "    def %s " name;
9236       generate_py_call_args ~handle:"self" (snd style);
9237       pr ":\n";
9238
9239       if not (List.mem NotInDocs flags) then (
9240         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9241         let doc =
9242           match fst style with
9243           | RErr | RInt _ | RInt64 _ | RBool _
9244           | RConstOptString _ | RConstString _
9245           | RString _ | RBufferOut _ -> doc
9246           | RStringList _ ->
9247               doc ^ "\n\nThis function returns a list of strings."
9248           | RStruct (_, typ) ->
9249               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9250           | RStructList (_, typ) ->
9251               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9252           | RHashtable _ ->
9253               doc ^ "\n\nThis function returns a dictionary." in
9254         let doc =
9255           if List.mem ProtocolLimitWarning flags then
9256             doc ^ "\n\n" ^ protocol_limit_warning
9257           else doc in
9258         let doc =
9259           if List.mem DangerWillRobinson flags then
9260             doc ^ "\n\n" ^ danger_will_robinson
9261           else doc in
9262         let doc =
9263           match deprecation_notice flags with
9264           | None -> doc
9265           | Some txt -> doc ^ "\n\n" ^ txt in
9266         let doc = pod2text ~width:60 name doc in
9267         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9268         let doc = String.concat "\n        " doc in
9269         pr "        u\"\"\"%s\"\"\"\n" doc;
9270       );
9271       pr "        return libguestfsmod.%s " name;
9272       generate_py_call_args ~handle:"self._o" (snd style);
9273       pr "\n";
9274       pr "\n";
9275   ) all_functions
9276
9277 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9278 and generate_py_call_args ~handle args =
9279   pr "(%s" handle;
9280   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9281   pr ")"
9282
9283 (* Useful if you need the longdesc POD text as plain text.  Returns a
9284  * list of lines.
9285  *
9286  * Because this is very slow (the slowest part of autogeneration),
9287  * we memoize the results.
9288  *)
9289 and pod2text ~width name longdesc =
9290   let key = width, name, longdesc in
9291   try Hashtbl.find pod2text_memo key
9292   with Not_found ->
9293     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9294     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9295     close_out chan;
9296     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9297     let chan = open_process_in cmd in
9298     let lines = ref [] in
9299     let rec loop i =
9300       let line = input_line chan in
9301       if i = 1 then             (* discard the first line of output *)
9302         loop (i+1)
9303       else (
9304         let line = triml line in
9305         lines := line :: !lines;
9306         loop (i+1)
9307       ) in
9308     let lines = try loop 1 with End_of_file -> List.rev !lines in
9309     unlink filename;
9310     (match close_process_in chan with
9311      | WEXITED 0 -> ()
9312      | WEXITED i ->
9313          failwithf "pod2text: process exited with non-zero status (%d)" i
9314      | WSIGNALED i | WSTOPPED i ->
9315          failwithf "pod2text: process signalled or stopped by signal %d" i
9316     );
9317     Hashtbl.add pod2text_memo key lines;
9318     pod2text_memo_updated ();
9319     lines
9320
9321 (* Generate ruby bindings. *)
9322 and generate_ruby_c () =
9323   generate_header CStyle LGPLv2plus;
9324
9325   pr "\
9326 #include <stdio.h>
9327 #include <stdlib.h>
9328
9329 #include <ruby.h>
9330
9331 #include \"guestfs.h\"
9332
9333 #include \"extconf.h\"
9334
9335 /* For Ruby < 1.9 */
9336 #ifndef RARRAY_LEN
9337 #define RARRAY_LEN(r) (RARRAY((r))->len)
9338 #endif
9339
9340 static VALUE m_guestfs;                 /* guestfs module */
9341 static VALUE c_guestfs;                 /* guestfs_h handle */
9342 static VALUE e_Error;                   /* used for all errors */
9343
9344 static void ruby_guestfs_free (void *p)
9345 {
9346   if (!p) return;
9347   guestfs_close ((guestfs_h *) p);
9348 }
9349
9350 static VALUE ruby_guestfs_create (VALUE m)
9351 {
9352   guestfs_h *g;
9353
9354   g = guestfs_create ();
9355   if (!g)
9356     rb_raise (e_Error, \"failed to create guestfs handle\");
9357
9358   /* Don't print error messages to stderr by default. */
9359   guestfs_set_error_handler (g, NULL, NULL);
9360
9361   /* Wrap it, and make sure the close function is called when the
9362    * handle goes away.
9363    */
9364   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9365 }
9366
9367 static VALUE ruby_guestfs_close (VALUE gv)
9368 {
9369   guestfs_h *g;
9370   Data_Get_Struct (gv, guestfs_h, g);
9371
9372   ruby_guestfs_free (g);
9373   DATA_PTR (gv) = NULL;
9374
9375   return Qnil;
9376 }
9377
9378 ";
9379
9380   List.iter (
9381     fun (name, style, _, _, _, _, _) ->
9382       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9383       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9384       pr ")\n";
9385       pr "{\n";
9386       pr "  guestfs_h *g;\n";
9387       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9388       pr "  if (!g)\n";
9389       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9390         name;
9391       pr "\n";
9392
9393       List.iter (
9394         function
9395         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9396             pr "  Check_Type (%sv, T_STRING);\n" n;
9397             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9398             pr "  if (!%s)\n" n;
9399             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9400             pr "              \"%s\", \"%s\");\n" n name
9401         | OptString n ->
9402             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9403         | StringList n | DeviceList n ->
9404             pr "  char **%s;\n" n;
9405             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9406             pr "  {\n";
9407             pr "    int i, len;\n";
9408             pr "    len = RARRAY_LEN (%sv);\n" n;
9409             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9410               n;
9411             pr "    for (i = 0; i < len; ++i) {\n";
9412             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9413             pr "      %s[i] = StringValueCStr (v);\n" n;
9414             pr "    }\n";
9415             pr "    %s[len] = NULL;\n" n;
9416             pr "  }\n";
9417         | Bool n ->
9418             pr "  int %s = RTEST (%sv);\n" n n
9419         | Int n ->
9420             pr "  int %s = NUM2INT (%sv);\n" n n
9421         | Int64 n ->
9422             pr "  long long %s = NUM2LL (%sv);\n" n n
9423       ) (snd style);
9424       pr "\n";
9425
9426       let error_code =
9427         match fst style with
9428         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9429         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9430         | RConstString _ | RConstOptString _ ->
9431             pr "  const char *r;\n"; "NULL"
9432         | RString _ -> pr "  char *r;\n"; "NULL"
9433         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9434         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9435         | RStructList (_, typ) ->
9436             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9437         | RBufferOut _ ->
9438             pr "  char *r;\n";
9439             pr "  size_t size;\n";
9440             "NULL" in
9441       pr "\n";
9442
9443       pr "  r = guestfs_%s " name;
9444       generate_c_call_args ~handle:"g" style;
9445       pr ";\n";
9446
9447       List.iter (
9448         function
9449         | Pathname _ | Device _ | Dev_or_Path _ | String _
9450         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9451         | StringList n | DeviceList n ->
9452             pr "  free (%s);\n" n
9453       ) (snd style);
9454
9455       pr "  if (r == %s)\n" error_code;
9456       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9457       pr "\n";
9458
9459       (match fst style with
9460        | RErr ->
9461            pr "  return Qnil;\n"
9462        | RInt _ | RBool _ ->
9463            pr "  return INT2NUM (r);\n"
9464        | RInt64 _ ->
9465            pr "  return ULL2NUM (r);\n"
9466        | RConstString _ ->
9467            pr "  return rb_str_new2 (r);\n";
9468        | RConstOptString _ ->
9469            pr "  if (r)\n";
9470            pr "    return rb_str_new2 (r);\n";
9471            pr "  else\n";
9472            pr "    return Qnil;\n";
9473        | RString _ ->
9474            pr "  VALUE rv = rb_str_new2 (r);\n";
9475            pr "  free (r);\n";
9476            pr "  return rv;\n";
9477        | RStringList _ ->
9478            pr "  int i, len = 0;\n";
9479            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9480            pr "  VALUE rv = rb_ary_new2 (len);\n";
9481            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9482            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9483            pr "    free (r[i]);\n";
9484            pr "  }\n";
9485            pr "  free (r);\n";
9486            pr "  return rv;\n"
9487        | RStruct (_, typ) ->
9488            let cols = cols_of_struct typ in
9489            generate_ruby_struct_code typ cols
9490        | RStructList (_, typ) ->
9491            let cols = cols_of_struct typ in
9492            generate_ruby_struct_list_code typ cols
9493        | RHashtable _ ->
9494            pr "  VALUE rv = rb_hash_new ();\n";
9495            pr "  int i;\n";
9496            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9497            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9498            pr "    free (r[i]);\n";
9499            pr "    free (r[i+1]);\n";
9500            pr "  }\n";
9501            pr "  free (r);\n";
9502            pr "  return rv;\n"
9503        | RBufferOut _ ->
9504            pr "  VALUE rv = rb_str_new (r, size);\n";
9505            pr "  free (r);\n";
9506            pr "  return rv;\n";
9507       );
9508
9509       pr "}\n";
9510       pr "\n"
9511   ) all_functions;
9512
9513   pr "\
9514 /* Initialize the module. */
9515 void Init__guestfs ()
9516 {
9517   m_guestfs = rb_define_module (\"Guestfs\");
9518   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9519   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9520
9521   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9522   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9523
9524 ";
9525   (* Define the rest of the methods. *)
9526   List.iter (
9527     fun (name, style, _, _, _, _, _) ->
9528       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9529       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9530   ) all_functions;
9531
9532   pr "}\n"
9533
9534 (* Ruby code to return a struct. *)
9535 and generate_ruby_struct_code typ cols =
9536   pr "  VALUE rv = rb_hash_new ();\n";
9537   List.iter (
9538     function
9539     | name, FString ->
9540         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9541     | name, FBuffer ->
9542         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9543     | name, FUUID ->
9544         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9545     | name, (FBytes|FUInt64) ->
9546         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9547     | name, FInt64 ->
9548         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9549     | name, FUInt32 ->
9550         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9551     | name, FInt32 ->
9552         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9553     | name, FOptPercent ->
9554         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9555     | name, FChar -> (* XXX wrong? *)
9556         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9557   ) cols;
9558   pr "  guestfs_free_%s (r);\n" typ;
9559   pr "  return rv;\n"
9560
9561 (* Ruby code to return a struct list. *)
9562 and generate_ruby_struct_list_code typ cols =
9563   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9564   pr "  int i;\n";
9565   pr "  for (i = 0; i < r->len; ++i) {\n";
9566   pr "    VALUE hv = rb_hash_new ();\n";
9567   List.iter (
9568     function
9569     | name, FString ->
9570         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9571     | name, FBuffer ->
9572         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
9573     | name, FUUID ->
9574         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9575     | name, (FBytes|FUInt64) ->
9576         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9577     | name, FInt64 ->
9578         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9579     | name, FUInt32 ->
9580         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9581     | name, FInt32 ->
9582         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9583     | name, FOptPercent ->
9584         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9585     | name, FChar -> (* XXX wrong? *)
9586         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9587   ) cols;
9588   pr "    rb_ary_push (rv, hv);\n";
9589   pr "  }\n";
9590   pr "  guestfs_free_%s_list (r);\n" typ;
9591   pr "  return rv;\n"
9592
9593 (* Generate Java bindings GuestFS.java file. *)
9594 and generate_java_java () =
9595   generate_header CStyle LGPLv2plus;
9596
9597   pr "\
9598 package com.redhat.et.libguestfs;
9599
9600 import java.util.HashMap;
9601 import com.redhat.et.libguestfs.LibGuestFSException;
9602 import com.redhat.et.libguestfs.PV;
9603 import com.redhat.et.libguestfs.VG;
9604 import com.redhat.et.libguestfs.LV;
9605 import com.redhat.et.libguestfs.Stat;
9606 import com.redhat.et.libguestfs.StatVFS;
9607 import com.redhat.et.libguestfs.IntBool;
9608 import com.redhat.et.libguestfs.Dirent;
9609
9610 /**
9611  * The GuestFS object is a libguestfs handle.
9612  *
9613  * @author rjones
9614  */
9615 public class GuestFS {
9616   // Load the native code.
9617   static {
9618     System.loadLibrary (\"guestfs_jni\");
9619   }
9620
9621   /**
9622    * The native guestfs_h pointer.
9623    */
9624   long g;
9625
9626   /**
9627    * Create a libguestfs handle.
9628    *
9629    * @throws LibGuestFSException
9630    */
9631   public GuestFS () throws LibGuestFSException
9632   {
9633     g = _create ();
9634   }
9635   private native long _create () throws LibGuestFSException;
9636
9637   /**
9638    * Close a libguestfs handle.
9639    *
9640    * You can also leave handles to be collected by the garbage
9641    * collector, but this method ensures that the resources used
9642    * by the handle are freed up immediately.  If you call any
9643    * other methods after closing the handle, you will get an
9644    * exception.
9645    *
9646    * @throws LibGuestFSException
9647    */
9648   public void close () throws LibGuestFSException
9649   {
9650     if (g != 0)
9651       _close (g);
9652     g = 0;
9653   }
9654   private native void _close (long g) throws LibGuestFSException;
9655
9656   public void finalize () throws LibGuestFSException
9657   {
9658     close ();
9659   }
9660
9661 ";
9662
9663   List.iter (
9664     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9665       if not (List.mem NotInDocs flags); then (
9666         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9667         let doc =
9668           if List.mem ProtocolLimitWarning flags then
9669             doc ^ "\n\n" ^ protocol_limit_warning
9670           else doc in
9671         let doc =
9672           if List.mem DangerWillRobinson flags then
9673             doc ^ "\n\n" ^ danger_will_robinson
9674           else doc in
9675         let doc =
9676           match deprecation_notice flags with
9677           | None -> doc
9678           | Some txt -> doc ^ "\n\n" ^ txt in
9679         let doc = pod2text ~width:60 name doc in
9680         let doc = List.map (            (* RHBZ#501883 *)
9681           function
9682           | "" -> "<p>"
9683           | nonempty -> nonempty
9684         ) doc in
9685         let doc = String.concat "\n   * " doc in
9686
9687         pr "  /**\n";
9688         pr "   * %s\n" shortdesc;
9689         pr "   * <p>\n";
9690         pr "   * %s\n" doc;
9691         pr "   * @throws LibGuestFSException\n";
9692         pr "   */\n";
9693         pr "  ";
9694       );
9695       generate_java_prototype ~public:true ~semicolon:false name style;
9696       pr "\n";
9697       pr "  {\n";
9698       pr "    if (g == 0)\n";
9699       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9700         name;
9701       pr "    ";
9702       if fst style <> RErr then pr "return ";
9703       pr "_%s " name;
9704       generate_java_call_args ~handle:"g" (snd style);
9705       pr ";\n";
9706       pr "  }\n";
9707       pr "  ";
9708       generate_java_prototype ~privat:true ~native:true name style;
9709       pr "\n";
9710       pr "\n";
9711   ) all_functions;
9712
9713   pr "}\n"
9714
9715 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9716 and generate_java_call_args ~handle args =
9717   pr "(%s" handle;
9718   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9719   pr ")"
9720
9721 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9722     ?(semicolon=true) name style =
9723   if privat then pr "private ";
9724   if public then pr "public ";
9725   if native then pr "native ";
9726
9727   (* return type *)
9728   (match fst style with
9729    | RErr -> pr "void ";
9730    | RInt _ -> pr "int ";
9731    | RInt64 _ -> pr "long ";
9732    | RBool _ -> pr "boolean ";
9733    | RConstString _ | RConstOptString _ | RString _
9734    | RBufferOut _ -> pr "String ";
9735    | RStringList _ -> pr "String[] ";
9736    | RStruct (_, typ) ->
9737        let name = java_name_of_struct typ in
9738        pr "%s " name;
9739    | RStructList (_, typ) ->
9740        let name = java_name_of_struct typ in
9741        pr "%s[] " name;
9742    | RHashtable _ -> pr "HashMap<String,String> ";
9743   );
9744
9745   if native then pr "_%s " name else pr "%s " name;
9746   pr "(";
9747   let needs_comma = ref false in
9748   if native then (
9749     pr "long g";
9750     needs_comma := true
9751   );
9752
9753   (* args *)
9754   List.iter (
9755     fun arg ->
9756       if !needs_comma then pr ", ";
9757       needs_comma := true;
9758
9759       match arg with
9760       | Pathname n
9761       | Device n | Dev_or_Path n
9762       | String n
9763       | OptString n
9764       | FileIn n
9765       | FileOut n ->
9766           pr "String %s" n
9767       | StringList n | DeviceList n ->
9768           pr "String[] %s" n
9769       | Bool n ->
9770           pr "boolean %s" n
9771       | Int n ->
9772           pr "int %s" n
9773       | Int64 n ->
9774           pr "long %s" n
9775   ) (snd style);
9776
9777   pr ")\n";
9778   pr "    throws LibGuestFSException";
9779   if semicolon then pr ";"
9780
9781 and generate_java_struct jtyp cols () =
9782   generate_header CStyle LGPLv2plus;
9783
9784   pr "\
9785 package com.redhat.et.libguestfs;
9786
9787 /**
9788  * Libguestfs %s structure.
9789  *
9790  * @author rjones
9791  * @see GuestFS
9792  */
9793 public class %s {
9794 " jtyp jtyp;
9795
9796   List.iter (
9797     function
9798     | name, FString
9799     | name, FUUID
9800     | name, FBuffer -> pr "  public String %s;\n" name
9801     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9802     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9803     | name, FChar -> pr "  public char %s;\n" name
9804     | name, FOptPercent ->
9805         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9806         pr "  public float %s;\n" name
9807   ) cols;
9808
9809   pr "}\n"
9810
9811 and generate_java_c () =
9812   generate_header CStyle LGPLv2plus;
9813
9814   pr "\
9815 #include <stdio.h>
9816 #include <stdlib.h>
9817 #include <string.h>
9818
9819 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9820 #include \"guestfs.h\"
9821
9822 /* Note that this function returns.  The exception is not thrown
9823  * until after the wrapper function returns.
9824  */
9825 static void
9826 throw_exception (JNIEnv *env, const char *msg)
9827 {
9828   jclass cl;
9829   cl = (*env)->FindClass (env,
9830                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9831   (*env)->ThrowNew (env, cl, msg);
9832 }
9833
9834 JNIEXPORT jlong JNICALL
9835 Java_com_redhat_et_libguestfs_GuestFS__1create
9836   (JNIEnv *env, jobject obj)
9837 {
9838   guestfs_h *g;
9839
9840   g = guestfs_create ();
9841   if (g == NULL) {
9842     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9843     return 0;
9844   }
9845   guestfs_set_error_handler (g, NULL, NULL);
9846   return (jlong) (long) g;
9847 }
9848
9849 JNIEXPORT void JNICALL
9850 Java_com_redhat_et_libguestfs_GuestFS__1close
9851   (JNIEnv *env, jobject obj, jlong jg)
9852 {
9853   guestfs_h *g = (guestfs_h *) (long) jg;
9854   guestfs_close (g);
9855 }
9856
9857 ";
9858
9859   List.iter (
9860     fun (name, style, _, _, _, _, _) ->
9861       pr "JNIEXPORT ";
9862       (match fst style with
9863        | RErr -> pr "void ";
9864        | RInt _ -> pr "jint ";
9865        | RInt64 _ -> pr "jlong ";
9866        | RBool _ -> pr "jboolean ";
9867        | RConstString _ | RConstOptString _ | RString _
9868        | RBufferOut _ -> pr "jstring ";
9869        | RStruct _ | RHashtable _ ->
9870            pr "jobject ";
9871        | RStringList _ | RStructList _ ->
9872            pr "jobjectArray ";
9873       );
9874       pr "JNICALL\n";
9875       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9876       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9877       pr "\n";
9878       pr "  (JNIEnv *env, jobject obj, jlong jg";
9879       List.iter (
9880         function
9881         | Pathname n
9882         | Device n | Dev_or_Path n
9883         | String n
9884         | OptString n
9885         | FileIn n
9886         | FileOut n ->
9887             pr ", jstring j%s" n
9888         | StringList n | DeviceList n ->
9889             pr ", jobjectArray j%s" n
9890         | Bool n ->
9891             pr ", jboolean j%s" n
9892         | Int n ->
9893             pr ", jint j%s" n
9894         | Int64 n ->
9895             pr ", jlong j%s" n
9896       ) (snd style);
9897       pr ")\n";
9898       pr "{\n";
9899       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9900       let error_code, no_ret =
9901         match fst style with
9902         | RErr -> pr "  int r;\n"; "-1", ""
9903         | RBool _
9904         | RInt _ -> pr "  int r;\n"; "-1", "0"
9905         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9906         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9907         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9908         | RString _ ->
9909             pr "  jstring jr;\n";
9910             pr "  char *r;\n"; "NULL", "NULL"
9911         | RStringList _ ->
9912             pr "  jobjectArray jr;\n";
9913             pr "  int r_len;\n";
9914             pr "  jclass cl;\n";
9915             pr "  jstring jstr;\n";
9916             pr "  char **r;\n"; "NULL", "NULL"
9917         | RStruct (_, typ) ->
9918             pr "  jobject jr;\n";
9919             pr "  jclass cl;\n";
9920             pr "  jfieldID fl;\n";
9921             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9922         | RStructList (_, typ) ->
9923             pr "  jobjectArray jr;\n";
9924             pr "  jclass cl;\n";
9925             pr "  jfieldID fl;\n";
9926             pr "  jobject jfl;\n";
9927             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9928         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9929         | RBufferOut _ ->
9930             pr "  jstring jr;\n";
9931             pr "  char *r;\n";
9932             pr "  size_t size;\n";
9933             "NULL", "NULL" in
9934       List.iter (
9935         function
9936         | Pathname n
9937         | Device n | Dev_or_Path n
9938         | String n
9939         | OptString n
9940         | FileIn n
9941         | FileOut n ->
9942             pr "  const char *%s;\n" n
9943         | StringList n | DeviceList n ->
9944             pr "  int %s_len;\n" n;
9945             pr "  const char **%s;\n" n
9946         | Bool n
9947         | Int n ->
9948             pr "  int %s;\n" n
9949         | Int64 n ->
9950             pr "  int64_t %s;\n" n
9951       ) (snd style);
9952
9953       let needs_i =
9954         (match fst style with
9955          | RStringList _ | RStructList _ -> true
9956          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9957          | RConstOptString _
9958          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9959           List.exists (function
9960                        | StringList _ -> true
9961                        | DeviceList _ -> true
9962                        | _ -> false) (snd style) in
9963       if needs_i then
9964         pr "  int i;\n";
9965
9966       pr "\n";
9967
9968       (* Get the parameters. *)
9969       List.iter (
9970         function
9971         | Pathname n
9972         | Device n | Dev_or_Path n
9973         | String n
9974         | FileIn n
9975         | FileOut n ->
9976             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9977         | OptString n ->
9978             (* This is completely undocumented, but Java null becomes
9979              * a NULL parameter.
9980              *)
9981             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9982         | StringList n | DeviceList n ->
9983             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9984             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9985             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9986             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9987               n;
9988             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9989             pr "  }\n";
9990             pr "  %s[%s_len] = NULL;\n" n n;
9991         | Bool n
9992         | Int n
9993         | Int64 n ->
9994             pr "  %s = j%s;\n" n n
9995       ) (snd style);
9996
9997       (* Make the call. *)
9998       pr "  r = guestfs_%s " name;
9999       generate_c_call_args ~handle:"g" style;
10000       pr ";\n";
10001
10002       (* Release the parameters. *)
10003       List.iter (
10004         function
10005         | Pathname n
10006         | Device n | Dev_or_Path n
10007         | String n
10008         | FileIn n
10009         | FileOut n ->
10010             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10011         | OptString n ->
10012             pr "  if (j%s)\n" n;
10013             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10014         | StringList n | DeviceList n ->
10015             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10016             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10017               n;
10018             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10019             pr "  }\n";
10020             pr "  free (%s);\n" n
10021         | Bool n
10022         | Int n
10023         | Int64 n -> ()
10024       ) (snd style);
10025
10026       (* Check for errors. *)
10027       pr "  if (r == %s) {\n" error_code;
10028       pr "    throw_exception (env, guestfs_last_error (g));\n";
10029       pr "    return %s;\n" no_ret;
10030       pr "  }\n";
10031
10032       (* Return value. *)
10033       (match fst style with
10034        | RErr -> ()
10035        | RInt _ -> pr "  return (jint) r;\n"
10036        | RBool _ -> pr "  return (jboolean) r;\n"
10037        | RInt64 _ -> pr "  return (jlong) r;\n"
10038        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10039        | RConstOptString _ ->
10040            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10041        | RString _ ->
10042            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10043            pr "  free (r);\n";
10044            pr "  return jr;\n"
10045        | RStringList _ ->
10046            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10047            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10048            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10049            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10050            pr "  for (i = 0; i < r_len; ++i) {\n";
10051            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10052            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10053            pr "    free (r[i]);\n";
10054            pr "  }\n";
10055            pr "  free (r);\n";
10056            pr "  return jr;\n"
10057        | RStruct (_, typ) ->
10058            let jtyp = java_name_of_struct typ in
10059            let cols = cols_of_struct typ in
10060            generate_java_struct_return typ jtyp cols
10061        | RStructList (_, typ) ->
10062            let jtyp = java_name_of_struct typ in
10063            let cols = cols_of_struct typ in
10064            generate_java_struct_list_return typ jtyp cols
10065        | RHashtable _ ->
10066            (* XXX *)
10067            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10068            pr "  return NULL;\n"
10069        | RBufferOut _ ->
10070            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10071            pr "  free (r);\n";
10072            pr "  return jr;\n"
10073       );
10074
10075       pr "}\n";
10076       pr "\n"
10077   ) all_functions
10078
10079 and generate_java_struct_return typ jtyp cols =
10080   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10081   pr "  jr = (*env)->AllocObject (env, cl);\n";
10082   List.iter (
10083     function
10084     | name, FString ->
10085         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10086         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10087     | name, FUUID ->
10088         pr "  {\n";
10089         pr "    char s[33];\n";
10090         pr "    memcpy (s, r->%s, 32);\n" name;
10091         pr "    s[32] = 0;\n";
10092         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10093         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10094         pr "  }\n";
10095     | name, FBuffer ->
10096         pr "  {\n";
10097         pr "    int len = r->%s_len;\n" name;
10098         pr "    char s[len+1];\n";
10099         pr "    memcpy (s, r->%s, len);\n" name;
10100         pr "    s[len] = 0;\n";
10101         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10102         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10103         pr "  }\n";
10104     | name, (FBytes|FUInt64|FInt64) ->
10105         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10106         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10107     | name, (FUInt32|FInt32) ->
10108         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10109         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10110     | name, FOptPercent ->
10111         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10112         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10113     | name, FChar ->
10114         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10115         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10116   ) cols;
10117   pr "  free (r);\n";
10118   pr "  return jr;\n"
10119
10120 and generate_java_struct_list_return typ jtyp cols =
10121   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10122   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10123   pr "  for (i = 0; i < r->len; ++i) {\n";
10124   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10125   List.iter (
10126     function
10127     | name, FString ->
10128         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10129         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10130     | name, FUUID ->
10131         pr "    {\n";
10132         pr "      char s[33];\n";
10133         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10134         pr "      s[32] = 0;\n";
10135         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10136         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10137         pr "    }\n";
10138     | name, FBuffer ->
10139         pr "    {\n";
10140         pr "      int len = r->val[i].%s_len;\n" name;
10141         pr "      char s[len+1];\n";
10142         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10143         pr "      s[len] = 0;\n";
10144         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10145         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10146         pr "    }\n";
10147     | name, (FBytes|FUInt64|FInt64) ->
10148         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10149         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10150     | name, (FUInt32|FInt32) ->
10151         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10152         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10153     | name, FOptPercent ->
10154         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10155         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10156     | name, FChar ->
10157         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10158         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10159   ) cols;
10160   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10161   pr "  }\n";
10162   pr "  guestfs_free_%s_list (r);\n" typ;
10163   pr "  return jr;\n"
10164
10165 and generate_java_makefile_inc () =
10166   generate_header HashStyle GPLv2plus;
10167
10168   pr "java_built_sources = \\\n";
10169   List.iter (
10170     fun (typ, jtyp) ->
10171         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10172   ) java_structs;
10173   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10174
10175 and generate_haskell_hs () =
10176   generate_header HaskellStyle LGPLv2plus;
10177
10178   (* XXX We only know how to generate partial FFI for Haskell
10179    * at the moment.  Please help out!
10180    *)
10181   let can_generate style =
10182     match style with
10183     | RErr, _
10184     | RInt _, _
10185     | RInt64 _, _ -> true
10186     | RBool _, _
10187     | RConstString _, _
10188     | RConstOptString _, _
10189     | RString _, _
10190     | RStringList _, _
10191     | RStruct _, _
10192     | RStructList _, _
10193     | RHashtable _, _
10194     | RBufferOut _, _ -> false in
10195
10196   pr "\
10197 {-# INCLUDE <guestfs.h> #-}
10198 {-# LANGUAGE ForeignFunctionInterface #-}
10199
10200 module Guestfs (
10201   create";
10202
10203   (* List out the names of the actions we want to export. *)
10204   List.iter (
10205     fun (name, style, _, _, _, _, _) ->
10206       if can_generate style then pr ",\n  %s" name
10207   ) all_functions;
10208
10209   pr "
10210   ) where
10211
10212 -- Unfortunately some symbols duplicate ones already present
10213 -- in Prelude.  We don't know which, so we hard-code a list
10214 -- here.
10215 import Prelude hiding (truncate)
10216
10217 import Foreign
10218 import Foreign.C
10219 import Foreign.C.Types
10220 import IO
10221 import Control.Exception
10222 import Data.Typeable
10223
10224 data GuestfsS = GuestfsS            -- represents the opaque C struct
10225 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10226 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10227
10228 -- XXX define properly later XXX
10229 data PV = PV
10230 data VG = VG
10231 data LV = LV
10232 data IntBool = IntBool
10233 data Stat = Stat
10234 data StatVFS = StatVFS
10235 data Hashtable = Hashtable
10236
10237 foreign import ccall unsafe \"guestfs_create\" c_create
10238   :: IO GuestfsP
10239 foreign import ccall unsafe \"&guestfs_close\" c_close
10240   :: FunPtr (GuestfsP -> IO ())
10241 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10242   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10243
10244 create :: IO GuestfsH
10245 create = do
10246   p <- c_create
10247   c_set_error_handler p nullPtr nullPtr
10248   h <- newForeignPtr c_close p
10249   return h
10250
10251 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10252   :: GuestfsP -> IO CString
10253
10254 -- last_error :: GuestfsH -> IO (Maybe String)
10255 -- last_error h = do
10256 --   str <- withForeignPtr h (\\p -> c_last_error p)
10257 --   maybePeek peekCString str
10258
10259 last_error :: GuestfsH -> IO (String)
10260 last_error h = do
10261   str <- withForeignPtr h (\\p -> c_last_error p)
10262   if (str == nullPtr)
10263     then return \"no error\"
10264     else peekCString str
10265
10266 ";
10267
10268   (* Generate wrappers for each foreign function. *)
10269   List.iter (
10270     fun (name, style, _, _, _, _, _) ->
10271       if can_generate style then (
10272         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10273         pr "  :: ";
10274         generate_haskell_prototype ~handle:"GuestfsP" style;
10275         pr "\n";
10276         pr "\n";
10277         pr "%s :: " name;
10278         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10279         pr "\n";
10280         pr "%s %s = do\n" name
10281           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10282         pr "  r <- ";
10283         (* Convert pointer arguments using with* functions. *)
10284         List.iter (
10285           function
10286           | FileIn n
10287           | FileOut n
10288           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10289           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10290           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10291           | Bool _ | Int _ | Int64 _ -> ()
10292         ) (snd style);
10293         (* Convert integer arguments. *)
10294         let args =
10295           List.map (
10296             function
10297             | Bool n -> sprintf "(fromBool %s)" n
10298             | Int n -> sprintf "(fromIntegral %s)" n
10299             | Int64 n -> sprintf "(fromIntegral %s)" n
10300             | FileIn n | FileOut n
10301             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10302           ) (snd style) in
10303         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10304           (String.concat " " ("p" :: args));
10305         (match fst style with
10306          | RErr | RInt _ | RInt64 _ | RBool _ ->
10307              pr "  if (r == -1)\n";
10308              pr "    then do\n";
10309              pr "      err <- last_error h\n";
10310              pr "      fail err\n";
10311          | RConstString _ | RConstOptString _ | RString _
10312          | RStringList _ | RStruct _
10313          | RStructList _ | RHashtable _ | RBufferOut _ ->
10314              pr "  if (r == nullPtr)\n";
10315              pr "    then do\n";
10316              pr "      err <- last_error h\n";
10317              pr "      fail err\n";
10318         );
10319         (match fst style with
10320          | RErr ->
10321              pr "    else return ()\n"
10322          | RInt _ ->
10323              pr "    else return (fromIntegral r)\n"
10324          | RInt64 _ ->
10325              pr "    else return (fromIntegral r)\n"
10326          | RBool _ ->
10327              pr "    else return (toBool r)\n"
10328          | RConstString _
10329          | RConstOptString _
10330          | RString _
10331          | RStringList _
10332          | RStruct _
10333          | RStructList _
10334          | RHashtable _
10335          | RBufferOut _ ->
10336              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10337         );
10338         pr "\n";
10339       )
10340   ) all_functions
10341
10342 and generate_haskell_prototype ~handle ?(hs = false) style =
10343   pr "%s -> " handle;
10344   let string = if hs then "String" else "CString" in
10345   let int = if hs then "Int" else "CInt" in
10346   let bool = if hs then "Bool" else "CInt" in
10347   let int64 = if hs then "Integer" else "Int64" in
10348   List.iter (
10349     fun arg ->
10350       (match arg with
10351        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10352        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10353        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10354        | Bool _ -> pr "%s" bool
10355        | Int _ -> pr "%s" int
10356        | Int64 _ -> pr "%s" int
10357        | FileIn _ -> pr "%s" string
10358        | FileOut _ -> pr "%s" string
10359       );
10360       pr " -> ";
10361   ) (snd style);
10362   pr "IO (";
10363   (match fst style with
10364    | RErr -> if not hs then pr "CInt"
10365    | RInt _ -> pr "%s" int
10366    | RInt64 _ -> pr "%s" int64
10367    | RBool _ -> pr "%s" bool
10368    | RConstString _ -> pr "%s" string
10369    | RConstOptString _ -> pr "Maybe %s" string
10370    | RString _ -> pr "%s" string
10371    | RStringList _ -> pr "[%s]" string
10372    | RStruct (_, typ) ->
10373        let name = java_name_of_struct typ in
10374        pr "%s" name
10375    | RStructList (_, typ) ->
10376        let name = java_name_of_struct typ in
10377        pr "[%s]" name
10378    | RHashtable _ -> pr "Hashtable"
10379    | RBufferOut _ -> pr "%s" string
10380   );
10381   pr ")"
10382
10383 and generate_csharp () =
10384   generate_header CPlusPlusStyle LGPLv2plus;
10385
10386   (* XXX Make this configurable by the C# assembly users. *)
10387   let library = "libguestfs.so.0" in
10388
10389   pr "\
10390 // These C# bindings are highly experimental at present.
10391 //
10392 // Firstly they only work on Linux (ie. Mono).  In order to get them
10393 // to work on Windows (ie. .Net) you would need to port the library
10394 // itself to Windows first.
10395 //
10396 // The second issue is that some calls are known to be incorrect and
10397 // can cause Mono to segfault.  Particularly: calls which pass or
10398 // return string[], or return any structure value.  This is because
10399 // we haven't worked out the correct way to do this from C#.
10400 //
10401 // The third issue is that when compiling you get a lot of warnings.
10402 // We are not sure whether the warnings are important or not.
10403 //
10404 // Fourthly we do not routinely build or test these bindings as part
10405 // of the make && make check cycle, which means that regressions might
10406 // go unnoticed.
10407 //
10408 // Suggestions and patches are welcome.
10409
10410 // To compile:
10411 //
10412 // gmcs Libguestfs.cs
10413 // mono Libguestfs.exe
10414 //
10415 // (You'll probably want to add a Test class / static main function
10416 // otherwise this won't do anything useful).
10417
10418 using System;
10419 using System.IO;
10420 using System.Runtime.InteropServices;
10421 using System.Runtime.Serialization;
10422 using System.Collections;
10423
10424 namespace Guestfs
10425 {
10426   class Error : System.ApplicationException
10427   {
10428     public Error (string message) : base (message) {}
10429     protected Error (SerializationInfo info, StreamingContext context) {}
10430   }
10431
10432   class Guestfs
10433   {
10434     IntPtr _handle;
10435
10436     [DllImport (\"%s\")]
10437     static extern IntPtr guestfs_create ();
10438
10439     public Guestfs ()
10440     {
10441       _handle = guestfs_create ();
10442       if (_handle == IntPtr.Zero)
10443         throw new Error (\"could not create guestfs handle\");
10444     }
10445
10446     [DllImport (\"%s\")]
10447     static extern void guestfs_close (IntPtr h);
10448
10449     ~Guestfs ()
10450     {
10451       guestfs_close (_handle);
10452     }
10453
10454     [DllImport (\"%s\")]
10455     static extern string guestfs_last_error (IntPtr h);
10456
10457 " library library library;
10458
10459   (* Generate C# structure bindings.  We prefix struct names with
10460    * underscore because C# cannot have conflicting struct names and
10461    * method names (eg. "class stat" and "stat").
10462    *)
10463   List.iter (
10464     fun (typ, cols) ->
10465       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10466       pr "    public class _%s {\n" typ;
10467       List.iter (
10468         function
10469         | name, FChar -> pr "      char %s;\n" name
10470         | name, FString -> pr "      string %s;\n" name
10471         | name, FBuffer ->
10472             pr "      uint %s_len;\n" name;
10473             pr "      string %s;\n" name
10474         | name, FUUID ->
10475             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10476             pr "      string %s;\n" name
10477         | name, FUInt32 -> pr "      uint %s;\n" name
10478         | name, FInt32 -> pr "      int %s;\n" name
10479         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10480         | name, FInt64 -> pr "      long %s;\n" name
10481         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10482       ) cols;
10483       pr "    }\n";
10484       pr "\n"
10485   ) structs;
10486
10487   (* Generate C# function bindings. *)
10488   List.iter (
10489     fun (name, style, _, _, _, shortdesc, _) ->
10490       let rec csharp_return_type () =
10491         match fst style with
10492         | RErr -> "void"
10493         | RBool n -> "bool"
10494         | RInt n -> "int"
10495         | RInt64 n -> "long"
10496         | RConstString n
10497         | RConstOptString n
10498         | RString n
10499         | RBufferOut n -> "string"
10500         | RStruct (_,n) -> "_" ^ n
10501         | RHashtable n -> "Hashtable"
10502         | RStringList n -> "string[]"
10503         | RStructList (_,n) -> sprintf "_%s[]" n
10504
10505       and c_return_type () =
10506         match fst style with
10507         | RErr
10508         | RBool _
10509         | RInt _ -> "int"
10510         | RInt64 _ -> "long"
10511         | RConstString _
10512         | RConstOptString _
10513         | RString _
10514         | RBufferOut _ -> "string"
10515         | RStruct (_,n) -> "_" ^ n
10516         | RHashtable _
10517         | RStringList _ -> "string[]"
10518         | RStructList (_,n) -> sprintf "_%s[]" n
10519
10520       and c_error_comparison () =
10521         match fst style with
10522         | RErr
10523         | RBool _
10524         | RInt _
10525         | RInt64 _ -> "== -1"
10526         | RConstString _
10527         | RConstOptString _
10528         | RString _
10529         | RBufferOut _
10530         | RStruct (_,_)
10531         | RHashtable _
10532         | RStringList _
10533         | RStructList (_,_) -> "== null"
10534
10535       and generate_extern_prototype () =
10536         pr "    static extern %s guestfs_%s (IntPtr h"
10537           (c_return_type ()) name;
10538         List.iter (
10539           function
10540           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10541           | FileIn n | FileOut n ->
10542               pr ", [In] string %s" n
10543           | StringList n | DeviceList n ->
10544               pr ", [In] string[] %s" n
10545           | Bool n ->
10546               pr ", bool %s" n
10547           | Int n ->
10548               pr ", int %s" n
10549           | Int64 n ->
10550               pr ", long %s" n
10551         ) (snd style);
10552         pr ");\n"
10553
10554       and generate_public_prototype () =
10555         pr "    public %s %s (" (csharp_return_type ()) name;
10556         let comma = ref false in
10557         let next () =
10558           if !comma then pr ", ";
10559           comma := true
10560         in
10561         List.iter (
10562           function
10563           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10564           | FileIn n | FileOut n ->
10565               next (); pr "string %s" n
10566           | StringList n | DeviceList n ->
10567               next (); pr "string[] %s" n
10568           | Bool n ->
10569               next (); pr "bool %s" n
10570           | Int n ->
10571               next (); pr "int %s" n
10572           | Int64 n ->
10573               next (); pr "long %s" n
10574         ) (snd style);
10575         pr ")\n"
10576
10577       and generate_call () =
10578         pr "guestfs_%s (_handle" name;
10579         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10580         pr ");\n";
10581       in
10582
10583       pr "    [DllImport (\"%s\")]\n" library;
10584       generate_extern_prototype ();
10585       pr "\n";
10586       pr "    /// <summary>\n";
10587       pr "    /// %s\n" shortdesc;
10588       pr "    /// </summary>\n";
10589       generate_public_prototype ();
10590       pr "    {\n";
10591       pr "      %s r;\n" (c_return_type ());
10592       pr "      r = ";
10593       generate_call ();
10594       pr "      if (r %s)\n" (c_error_comparison ());
10595       pr "        throw new Error (guestfs_last_error (_handle));\n";
10596       (match fst style with
10597        | RErr -> ()
10598        | RBool _ ->
10599            pr "      return r != 0 ? true : false;\n"
10600        | RHashtable _ ->
10601            pr "      Hashtable rr = new Hashtable ();\n";
10602            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10603            pr "        rr.Add (r[i], r[i+1]);\n";
10604            pr "      return rr;\n"
10605        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10606        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10607        | RStructList _ ->
10608            pr "      return r;\n"
10609       );
10610       pr "    }\n";
10611       pr "\n";
10612   ) all_functions_sorted;
10613
10614   pr "  }
10615 }
10616 "
10617
10618 and generate_bindtests () =
10619   generate_header CStyle LGPLv2plus;
10620
10621   pr "\
10622 #include <stdio.h>
10623 #include <stdlib.h>
10624 #include <inttypes.h>
10625 #include <string.h>
10626
10627 #include \"guestfs.h\"
10628 #include \"guestfs-internal.h\"
10629 #include \"guestfs-internal-actions.h\"
10630 #include \"guestfs_protocol.h\"
10631
10632 #define error guestfs_error
10633 #define safe_calloc guestfs_safe_calloc
10634 #define safe_malloc guestfs_safe_malloc
10635
10636 static void
10637 print_strings (char *const *argv)
10638 {
10639   int argc;
10640
10641   printf (\"[\");
10642   for (argc = 0; argv[argc] != NULL; ++argc) {
10643     if (argc > 0) printf (\", \");
10644     printf (\"\\\"%%s\\\"\", argv[argc]);
10645   }
10646   printf (\"]\\n\");
10647 }
10648
10649 /* The test0 function prints its parameters to stdout. */
10650 ";
10651
10652   let test0, tests =
10653     match test_functions with
10654     | [] -> assert false
10655     | test0 :: tests -> test0, tests in
10656
10657   let () =
10658     let (name, style, _, _, _, _, _) = test0 in
10659     generate_prototype ~extern:false ~semicolon:false ~newline:true
10660       ~handle:"g" ~prefix:"guestfs__" name style;
10661     pr "{\n";
10662     List.iter (
10663       function
10664       | Pathname n
10665       | Device n | Dev_or_Path n
10666       | String n
10667       | FileIn n
10668       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10669       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10670       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10671       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10672       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10673       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10674     ) (snd style);
10675     pr "  /* Java changes stdout line buffering so we need this: */\n";
10676     pr "  fflush (stdout);\n";
10677     pr "  return 0;\n";
10678     pr "}\n";
10679     pr "\n" in
10680
10681   List.iter (
10682     fun (name, style, _, _, _, _, _) ->
10683       if String.sub name (String.length name - 3) 3 <> "err" then (
10684         pr "/* Test normal return. */\n";
10685         generate_prototype ~extern:false ~semicolon:false ~newline:true
10686           ~handle:"g" ~prefix:"guestfs__" name style;
10687         pr "{\n";
10688         (match fst style with
10689          | RErr ->
10690              pr "  return 0;\n"
10691          | RInt _ ->
10692              pr "  int r;\n";
10693              pr "  sscanf (val, \"%%d\", &r);\n";
10694              pr "  return r;\n"
10695          | RInt64 _ ->
10696              pr "  int64_t r;\n";
10697              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10698              pr "  return r;\n"
10699          | RBool _ ->
10700              pr "  return STREQ (val, \"true\");\n"
10701          | RConstString _
10702          | RConstOptString _ ->
10703              (* Can't return the input string here.  Return a static
10704               * string so we ensure we get a segfault if the caller
10705               * tries to free it.
10706               *)
10707              pr "  return \"static string\";\n"
10708          | RString _ ->
10709              pr "  return strdup (val);\n"
10710          | RStringList _ ->
10711              pr "  char **strs;\n";
10712              pr "  int n, i;\n";
10713              pr "  sscanf (val, \"%%d\", &n);\n";
10714              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10715              pr "  for (i = 0; i < n; ++i) {\n";
10716              pr "    strs[i] = safe_malloc (g, 16);\n";
10717              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10718              pr "  }\n";
10719              pr "  strs[n] = NULL;\n";
10720              pr "  return strs;\n"
10721          | RStruct (_, typ) ->
10722              pr "  struct guestfs_%s *r;\n" typ;
10723              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10724              pr "  return r;\n"
10725          | RStructList (_, typ) ->
10726              pr "  struct guestfs_%s_list *r;\n" typ;
10727              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10728              pr "  sscanf (val, \"%%d\", &r->len);\n";
10729              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10730              pr "  return r;\n"
10731          | RHashtable _ ->
10732              pr "  char **strs;\n";
10733              pr "  int n, i;\n";
10734              pr "  sscanf (val, \"%%d\", &n);\n";
10735              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10736              pr "  for (i = 0; i < n; ++i) {\n";
10737              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10738              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10739              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10740              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10741              pr "  }\n";
10742              pr "  strs[n*2] = NULL;\n";
10743              pr "  return strs;\n"
10744          | RBufferOut _ ->
10745              pr "  return strdup (val);\n"
10746         );
10747         pr "}\n";
10748         pr "\n"
10749       ) else (
10750         pr "/* Test error return. */\n";
10751         generate_prototype ~extern:false ~semicolon:false ~newline:true
10752           ~handle:"g" ~prefix:"guestfs__" name style;
10753         pr "{\n";
10754         pr "  error (g, \"error\");\n";
10755         (match fst style with
10756          | RErr | RInt _ | RInt64 _ | RBool _ ->
10757              pr "  return -1;\n"
10758          | RConstString _ | RConstOptString _
10759          | RString _ | RStringList _ | RStruct _
10760          | RStructList _
10761          | RHashtable _
10762          | RBufferOut _ ->
10763              pr "  return NULL;\n"
10764         );
10765         pr "}\n";
10766         pr "\n"
10767       )
10768   ) tests
10769
10770 and generate_ocaml_bindtests () =
10771   generate_header OCamlStyle GPLv2plus;
10772
10773   pr "\
10774 let () =
10775   let g = Guestfs.create () in
10776 ";
10777
10778   let mkargs args =
10779     String.concat " " (
10780       List.map (
10781         function
10782         | CallString s -> "\"" ^ s ^ "\""
10783         | CallOptString None -> "None"
10784         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10785         | CallStringList xs ->
10786             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10787         | CallInt i when i >= 0 -> string_of_int i
10788         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10789         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10790         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10791         | CallBool b -> string_of_bool b
10792       ) args
10793     )
10794   in
10795
10796   generate_lang_bindtests (
10797     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10798   );
10799
10800   pr "print_endline \"EOF\"\n"
10801
10802 and generate_perl_bindtests () =
10803   pr "#!/usr/bin/perl -w\n";
10804   generate_header HashStyle GPLv2plus;
10805
10806   pr "\
10807 use strict;
10808
10809 use Sys::Guestfs;
10810
10811 my $g = Sys::Guestfs->new ();
10812 ";
10813
10814   let mkargs args =
10815     String.concat ", " (
10816       List.map (
10817         function
10818         | CallString s -> "\"" ^ s ^ "\""
10819         | CallOptString None -> "undef"
10820         | CallOptString (Some s) -> sprintf "\"%s\"" s
10821         | CallStringList xs ->
10822             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10823         | CallInt i -> string_of_int i
10824         | CallInt64 i -> Int64.to_string i
10825         | CallBool b -> if b then "1" else "0"
10826       ) args
10827     )
10828   in
10829
10830   generate_lang_bindtests (
10831     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10832   );
10833
10834   pr "print \"EOF\\n\"\n"
10835
10836 and generate_python_bindtests () =
10837   generate_header HashStyle GPLv2plus;
10838
10839   pr "\
10840 import guestfs
10841
10842 g = guestfs.GuestFS ()
10843 ";
10844
10845   let mkargs args =
10846     String.concat ", " (
10847       List.map (
10848         function
10849         | CallString s -> "\"" ^ s ^ "\""
10850         | CallOptString None -> "None"
10851         | CallOptString (Some s) -> sprintf "\"%s\"" s
10852         | CallStringList xs ->
10853             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10854         | CallInt i -> string_of_int i
10855         | CallInt64 i -> Int64.to_string i
10856         | CallBool b -> if b then "1" else "0"
10857       ) args
10858     )
10859   in
10860
10861   generate_lang_bindtests (
10862     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10863   );
10864
10865   pr "print \"EOF\"\n"
10866
10867 and generate_ruby_bindtests () =
10868   generate_header HashStyle GPLv2plus;
10869
10870   pr "\
10871 require 'guestfs'
10872
10873 g = Guestfs::create()
10874 ";
10875
10876   let mkargs args =
10877     String.concat ", " (
10878       List.map (
10879         function
10880         | CallString s -> "\"" ^ s ^ "\""
10881         | CallOptString None -> "nil"
10882         | CallOptString (Some s) -> sprintf "\"%s\"" s
10883         | CallStringList xs ->
10884             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10885         | CallInt i -> string_of_int i
10886         | CallInt64 i -> Int64.to_string i
10887         | CallBool b -> string_of_bool b
10888       ) args
10889     )
10890   in
10891
10892   generate_lang_bindtests (
10893     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10894   );
10895
10896   pr "print \"EOF\\n\"\n"
10897
10898 and generate_java_bindtests () =
10899   generate_header CStyle GPLv2plus;
10900
10901   pr "\
10902 import com.redhat.et.libguestfs.*;
10903
10904 public class Bindtests {
10905     public static void main (String[] argv)
10906     {
10907         try {
10908             GuestFS g = new GuestFS ();
10909 ";
10910
10911   let mkargs args =
10912     String.concat ", " (
10913       List.map (
10914         function
10915         | CallString s -> "\"" ^ s ^ "\""
10916         | CallOptString None -> "null"
10917         | CallOptString (Some s) -> sprintf "\"%s\"" s
10918         | CallStringList xs ->
10919             "new String[]{" ^
10920               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10921         | CallInt i -> string_of_int i
10922         | CallInt64 i -> Int64.to_string i
10923         | CallBool b -> string_of_bool b
10924       ) args
10925     )
10926   in
10927
10928   generate_lang_bindtests (
10929     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10930   );
10931
10932   pr "
10933             System.out.println (\"EOF\");
10934         }
10935         catch (Exception exn) {
10936             System.err.println (exn);
10937             System.exit (1);
10938         }
10939     }
10940 }
10941 "
10942
10943 and generate_haskell_bindtests () =
10944   generate_header HaskellStyle GPLv2plus;
10945
10946   pr "\
10947 module Bindtests where
10948 import qualified Guestfs
10949
10950 main = do
10951   g <- Guestfs.create
10952 ";
10953
10954   let mkargs args =
10955     String.concat " " (
10956       List.map (
10957         function
10958         | CallString s -> "\"" ^ s ^ "\""
10959         | CallOptString None -> "Nothing"
10960         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10961         | CallStringList xs ->
10962             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10963         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10964         | CallInt i -> string_of_int i
10965         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10966         | CallInt64 i -> Int64.to_string i
10967         | CallBool true -> "True"
10968         | CallBool false -> "False"
10969       ) args
10970     )
10971   in
10972
10973   generate_lang_bindtests (
10974     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10975   );
10976
10977   pr "  putStrLn \"EOF\"\n"
10978
10979 (* Language-independent bindings tests - we do it this way to
10980  * ensure there is parity in testing bindings across all languages.
10981  *)
10982 and generate_lang_bindtests call =
10983   call "test0" [CallString "abc"; CallOptString (Some "def");
10984                 CallStringList []; CallBool false;
10985                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10986   call "test0" [CallString "abc"; CallOptString None;
10987                 CallStringList []; CallBool false;
10988                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10989   call "test0" [CallString ""; CallOptString (Some "def");
10990                 CallStringList []; CallBool false;
10991                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10992   call "test0" [CallString ""; CallOptString (Some "");
10993                 CallStringList []; CallBool false;
10994                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10995   call "test0" [CallString "abc"; CallOptString (Some "def");
10996                 CallStringList ["1"]; CallBool false;
10997                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10998   call "test0" [CallString "abc"; CallOptString (Some "def");
10999                 CallStringList ["1"; "2"]; CallBool false;
11000                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11001   call "test0" [CallString "abc"; CallOptString (Some "def");
11002                 CallStringList ["1"]; CallBool true;
11003                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11004   call "test0" [CallString "abc"; CallOptString (Some "def");
11005                 CallStringList ["1"]; CallBool false;
11006                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
11007   call "test0" [CallString "abc"; CallOptString (Some "def");
11008                 CallStringList ["1"]; CallBool false;
11009                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
11010   call "test0" [CallString "abc"; CallOptString (Some "def");
11011                 CallStringList ["1"]; CallBool false;
11012                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
11013   call "test0" [CallString "abc"; CallOptString (Some "def");
11014                 CallStringList ["1"]; CallBool false;
11015                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11016   call "test0" [CallString "abc"; CallOptString (Some "def");
11017                 CallStringList ["1"]; CallBool false;
11018                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11019   call "test0" [CallString "abc"; CallOptString (Some "def");
11020                 CallStringList ["1"]; CallBool false;
11021                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11022
11023 (* XXX Add here tests of the return and error functions. *)
11024
11025 (* Code to generator bindings for virt-inspector.  Currently only
11026  * implemented for OCaml code (for virt-p2v 2.0).
11027  *)
11028 let rng_input = "inspector/virt-inspector.rng"
11029
11030 (* Read the input file and parse it into internal structures.  This is
11031  * by no means a complete RELAX NG parser, but is just enough to be
11032  * able to parse the specific input file.
11033  *)
11034 type rng =
11035   | Element of string * rng list        (* <element name=name/> *)
11036   | Attribute of string * rng list        (* <attribute name=name/> *)
11037   | Interleave of rng list                (* <interleave/> *)
11038   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11039   | OneOrMore of rng                        (* <oneOrMore/> *)
11040   | Optional of rng                        (* <optional/> *)
11041   | Choice of string list                (* <choice><value/>*</choice> *)
11042   | Value of string                        (* <value>str</value> *)
11043   | Text                                (* <text/> *)
11044
11045 let rec string_of_rng = function
11046   | Element (name, xs) ->
11047       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11048   | Attribute (name, xs) ->
11049       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11050   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11051   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11052   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11053   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11054   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11055   | Value value -> "Value \"" ^ value ^ "\""
11056   | Text -> "Text"
11057
11058 and string_of_rng_list xs =
11059   String.concat ", " (List.map string_of_rng xs)
11060
11061 let rec parse_rng ?defines context = function
11062   | [] -> []
11063   | Xml.Element ("element", ["name", name], children) :: rest ->
11064       Element (name, parse_rng ?defines context children)
11065       :: parse_rng ?defines context rest
11066   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11067       Attribute (name, parse_rng ?defines context children)
11068       :: parse_rng ?defines context rest
11069   | Xml.Element ("interleave", [], children) :: rest ->
11070       Interleave (parse_rng ?defines context children)
11071       :: parse_rng ?defines context rest
11072   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11073       let rng = parse_rng ?defines context [child] in
11074       (match rng with
11075        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11076        | _ ->
11077            failwithf "%s: <zeroOrMore> contains more than one child element"
11078              context
11079       )
11080   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11081       let rng = parse_rng ?defines context [child] in
11082       (match rng with
11083        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11084        | _ ->
11085            failwithf "%s: <oneOrMore> contains more than one child element"
11086              context
11087       )
11088   | Xml.Element ("optional", [], [child]) :: rest ->
11089       let rng = parse_rng ?defines context [child] in
11090       (match rng with
11091        | [child] -> Optional child :: parse_rng ?defines context rest
11092        | _ ->
11093            failwithf "%s: <optional> contains more than one child element"
11094              context
11095       )
11096   | Xml.Element ("choice", [], children) :: rest ->
11097       let values = List.map (
11098         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11099         | _ ->
11100             failwithf "%s: can't handle anything except <value> in <choice>"
11101               context
11102       ) children in
11103       Choice values
11104       :: parse_rng ?defines context rest
11105   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11106       Value value :: parse_rng ?defines context rest
11107   | Xml.Element ("text", [], []) :: rest ->
11108       Text :: parse_rng ?defines context rest
11109   | Xml.Element ("ref", ["name", name], []) :: rest ->
11110       (* Look up the reference.  Because of limitations in this parser,
11111        * we can't handle arbitrarily nested <ref> yet.  You can only
11112        * use <ref> from inside <start>.
11113        *)
11114       (match defines with
11115        | None ->
11116            failwithf "%s: contains <ref>, but no refs are defined yet" context
11117        | Some map ->
11118            let rng = StringMap.find name map in
11119            rng @ parse_rng ?defines context rest
11120       )
11121   | x :: _ ->
11122       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11123
11124 let grammar =
11125   let xml = Xml.parse_file rng_input in
11126   match xml with
11127   | Xml.Element ("grammar", _,
11128                  Xml.Element ("start", _, gram) :: defines) ->
11129       (* The <define/> elements are referenced in the <start> section,
11130        * so build a map of those first.
11131        *)
11132       let defines = List.fold_left (
11133         fun map ->
11134           function Xml.Element ("define", ["name", name], defn) ->
11135             StringMap.add name defn map
11136           | _ ->
11137               failwithf "%s: expected <define name=name/>" rng_input
11138       ) StringMap.empty defines in
11139       let defines = StringMap.mapi parse_rng defines in
11140
11141       (* Parse the <start> clause, passing the defines. *)
11142       parse_rng ~defines "<start>" gram
11143   | _ ->
11144       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11145         rng_input
11146
11147 let name_of_field = function
11148   | Element (name, _) | Attribute (name, _)
11149   | ZeroOrMore (Element (name, _))
11150   | OneOrMore (Element (name, _))
11151   | Optional (Element (name, _)) -> name
11152   | Optional (Attribute (name, _)) -> name
11153   | Text -> (* an unnamed field in an element *)
11154       "data"
11155   | rng ->
11156       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11157
11158 (* At the moment this function only generates OCaml types.  However we
11159  * should parameterize it later so it can generate types/structs in a
11160  * variety of languages.
11161  *)
11162 let generate_types xs =
11163   (* A simple type is one that can be printed out directly, eg.
11164    * "string option".  A complex type is one which has a name and has
11165    * to be defined via another toplevel definition, eg. a struct.
11166    *
11167    * generate_type generates code for either simple or complex types.
11168    * In the simple case, it returns the string ("string option").  In
11169    * the complex case, it returns the name ("mountpoint").  In the
11170    * complex case it has to print out the definition before returning,
11171    * so it should only be called when we are at the beginning of a
11172    * new line (BOL context).
11173    *)
11174   let rec generate_type = function
11175     | Text ->                                (* string *)
11176         "string", true
11177     | Choice values ->                        (* [`val1|`val2|...] *)
11178         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11179     | ZeroOrMore rng ->                        (* <rng> list *)
11180         let t, is_simple = generate_type rng in
11181         t ^ " list (* 0 or more *)", is_simple
11182     | OneOrMore rng ->                        (* <rng> list *)
11183         let t, is_simple = generate_type rng in
11184         t ^ " list (* 1 or more *)", is_simple
11185                                         (* virt-inspector hack: bool *)
11186     | Optional (Attribute (name, [Value "1"])) ->
11187         "bool", true
11188     | Optional rng ->                        (* <rng> list *)
11189         let t, is_simple = generate_type rng in
11190         t ^ " option", is_simple
11191                                         (* type name = { fields ... } *)
11192     | Element (name, fields) when is_attrs_interleave fields ->
11193         generate_type_struct name (get_attrs_interleave fields)
11194     | Element (name, [field])                (* type name = field *)
11195     | Attribute (name, [field]) ->
11196         let t, is_simple = generate_type field in
11197         if is_simple then (t, true)
11198         else (
11199           pr "type %s = %s\n" name t;
11200           name, false
11201         )
11202     | Element (name, fields) ->              (* type name = { fields ... } *)
11203         generate_type_struct name fields
11204     | rng ->
11205         failwithf "generate_type failed at: %s" (string_of_rng rng)
11206
11207   and is_attrs_interleave = function
11208     | [Interleave _] -> true
11209     | Attribute _ :: fields -> is_attrs_interleave fields
11210     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11211     | _ -> false
11212
11213   and get_attrs_interleave = function
11214     | [Interleave fields] -> fields
11215     | ((Attribute _) as field) :: fields
11216     | ((Optional (Attribute _)) as field) :: fields ->
11217         field :: get_attrs_interleave fields
11218     | _ -> assert false
11219
11220   and generate_types xs =
11221     List.iter (fun x -> ignore (generate_type x)) xs
11222
11223   and generate_type_struct name fields =
11224     (* Calculate the types of the fields first.  We have to do this
11225      * before printing anything so we are still in BOL context.
11226      *)
11227     let types = List.map fst (List.map generate_type fields) in
11228
11229     (* Special case of a struct containing just a string and another
11230      * field.  Turn it into an assoc list.
11231      *)
11232     match types with
11233     | ["string"; other] ->
11234         let fname1, fname2 =
11235           match fields with
11236           | [f1; f2] -> name_of_field f1, name_of_field f2
11237           | _ -> assert false in
11238         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11239         name, false
11240
11241     | types ->
11242         pr "type %s = {\n" name;
11243         List.iter (
11244           fun (field, ftype) ->
11245             let fname = name_of_field field in
11246             pr "  %s_%s : %s;\n" name fname ftype
11247         ) (List.combine fields types);
11248         pr "}\n";
11249         (* Return the name of this type, and
11250          * false because it's not a simple type.
11251          *)
11252         name, false
11253   in
11254
11255   generate_types xs
11256
11257 let generate_parsers xs =
11258   (* As for generate_type above, generate_parser makes a parser for
11259    * some type, and returns the name of the parser it has generated.
11260    * Because it (may) need to print something, it should always be
11261    * called in BOL context.
11262    *)
11263   let rec generate_parser = function
11264     | Text ->                                (* string *)
11265         "string_child_or_empty"
11266     | Choice values ->                        (* [`val1|`val2|...] *)
11267         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11268           (String.concat "|"
11269              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11270     | ZeroOrMore rng ->                        (* <rng> list *)
11271         let pa = generate_parser rng in
11272         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11273     | OneOrMore rng ->                        (* <rng> list *)
11274         let pa = generate_parser rng in
11275         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11276                                         (* virt-inspector hack: bool *)
11277     | Optional (Attribute (name, [Value "1"])) ->
11278         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11279     | Optional rng ->                        (* <rng> list *)
11280         let pa = generate_parser rng in
11281         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11282                                         (* type name = { fields ... } *)
11283     | Element (name, fields) when is_attrs_interleave fields ->
11284         generate_parser_struct name (get_attrs_interleave fields)
11285     | Element (name, [field]) ->        (* type name = field *)
11286         let pa = generate_parser field in
11287         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11288         pr "let %s =\n" parser_name;
11289         pr "  %s\n" pa;
11290         pr "let parse_%s = %s\n" name parser_name;
11291         parser_name
11292     | Attribute (name, [field]) ->
11293         let pa = generate_parser field in
11294         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11295         pr "let %s =\n" parser_name;
11296         pr "  %s\n" pa;
11297         pr "let parse_%s = %s\n" name parser_name;
11298         parser_name
11299     | Element (name, fields) ->              (* type name = { fields ... } *)
11300         generate_parser_struct name ([], fields)
11301     | rng ->
11302         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11303
11304   and is_attrs_interleave = function
11305     | [Interleave _] -> true
11306     | Attribute _ :: fields -> is_attrs_interleave fields
11307     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11308     | _ -> false
11309
11310   and get_attrs_interleave = function
11311     | [Interleave fields] -> [], fields
11312     | ((Attribute _) as field) :: fields
11313     | ((Optional (Attribute _)) as field) :: fields ->
11314         let attrs, interleaves = get_attrs_interleave fields in
11315         (field :: attrs), interleaves
11316     | _ -> assert false
11317
11318   and generate_parsers xs =
11319     List.iter (fun x -> ignore (generate_parser x)) xs
11320
11321   and generate_parser_struct name (attrs, interleaves) =
11322     (* Generate parsers for the fields first.  We have to do this
11323      * before printing anything so we are still in BOL context.
11324      *)
11325     let fields = attrs @ interleaves in
11326     let pas = List.map generate_parser fields in
11327
11328     (* Generate an intermediate tuple from all the fields first.
11329      * If the type is just a string + another field, then we will
11330      * return this directly, otherwise it is turned into a record.
11331      *
11332      * RELAX NG note: This code treats <interleave> and plain lists of
11333      * fields the same.  In other words, it doesn't bother enforcing
11334      * any ordering of fields in the XML.
11335      *)
11336     pr "let parse_%s x =\n" name;
11337     pr "  let t = (\n    ";
11338     let comma = ref false in
11339     List.iter (
11340       fun x ->
11341         if !comma then pr ",\n    ";
11342         comma := true;
11343         match x with
11344         | Optional (Attribute (fname, [field])), pa ->
11345             pr "%s x" pa
11346         | Optional (Element (fname, [field])), pa ->
11347             pr "%s (optional_child %S x)" pa fname
11348         | Attribute (fname, [Text]), _ ->
11349             pr "attribute %S x" fname
11350         | (ZeroOrMore _ | OneOrMore _), pa ->
11351             pr "%s x" pa
11352         | Text, pa ->
11353             pr "%s x" pa
11354         | (field, pa) ->
11355             let fname = name_of_field field in
11356             pr "%s (child %S x)" pa fname
11357     ) (List.combine fields pas);
11358     pr "\n  ) in\n";
11359
11360     (match fields with
11361      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11362          pr "  t\n"
11363
11364      | _ ->
11365          pr "  (Obj.magic t : %s)\n" name
11366 (*
11367          List.iter (
11368            function
11369            | (Optional (Attribute (fname, [field])), pa) ->
11370                pr "  %s_%s =\n" name fname;
11371                pr "    %s x;\n" pa
11372            | (Optional (Element (fname, [field])), pa) ->
11373                pr "  %s_%s =\n" name fname;
11374                pr "    (let x = optional_child %S x in\n" fname;
11375                pr "     %s x);\n" pa
11376            | (field, pa) ->
11377                let fname = name_of_field field in
11378                pr "  %s_%s =\n" name fname;
11379                pr "    (let x = child %S x in\n" fname;
11380                pr "     %s x);\n" pa
11381          ) (List.combine fields pas);
11382          pr "}\n"
11383 *)
11384     );
11385     sprintf "parse_%s" name
11386   in
11387
11388   generate_parsers xs
11389
11390 (* Generate ocaml/guestfs_inspector.mli. *)
11391 let generate_ocaml_inspector_mli () =
11392   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11393
11394   pr "\
11395 (** This is an OCaml language binding to the external [virt-inspector]
11396     program.
11397
11398     For more information, please read the man page [virt-inspector(1)].
11399 *)
11400
11401 ";
11402
11403   generate_types grammar;
11404   pr "(** The nested information returned from the {!inspect} function. *)\n";
11405   pr "\n";
11406
11407   pr "\
11408 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11409 (** To inspect a libvirt domain called [name], pass a singleton
11410     list: [inspect [name]].  When using libvirt only, you may
11411     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11412
11413     To inspect a disk image or images, pass a list of the filenames
11414     of the disk images: [inspect filenames]
11415
11416     This function inspects the given guest or disk images and
11417     returns a list of operating system(s) found and a large amount
11418     of information about them.  In the vast majority of cases,
11419     a virtual machine only contains a single operating system.
11420
11421     If the optional [~xml] parameter is given, then this function
11422     skips running the external virt-inspector program and just
11423     parses the given XML directly (which is expected to be XML
11424     produced from a previous run of virt-inspector).  The list of
11425     names and connect URI are ignored in this case.
11426
11427     This function can throw a wide variety of exceptions, for example
11428     if the external virt-inspector program cannot be found, or if
11429     it doesn't generate valid XML.
11430 *)
11431 "
11432
11433 (* Generate ocaml/guestfs_inspector.ml. *)
11434 let generate_ocaml_inspector_ml () =
11435   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11436
11437   pr "open Unix\n";
11438   pr "\n";
11439
11440   generate_types grammar;
11441   pr "\n";
11442
11443   pr "\
11444 (* Misc functions which are used by the parser code below. *)
11445 let first_child = function
11446   | Xml.Element (_, _, c::_) -> c
11447   | Xml.Element (name, _, []) ->
11448       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11449   | Xml.PCData str ->
11450       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11451
11452 let string_child_or_empty = function
11453   | Xml.Element (_, _, [Xml.PCData s]) -> s
11454   | Xml.Element (_, _, []) -> \"\"
11455   | Xml.Element (x, _, _) ->
11456       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11457                 x ^ \" instead\")
11458   | Xml.PCData str ->
11459       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11460
11461 let optional_child name xml =
11462   let children = Xml.children xml in
11463   try
11464     Some (List.find (function
11465                      | Xml.Element (n, _, _) when n = name -> true
11466                      | _ -> false) children)
11467   with
11468     Not_found -> None
11469
11470 let child name xml =
11471   match optional_child name xml with
11472   | Some c -> c
11473   | None ->
11474       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11475
11476 let attribute name xml =
11477   try Xml.attrib xml name
11478   with Xml.No_attribute _ ->
11479     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11480
11481 ";
11482
11483   generate_parsers grammar;
11484   pr "\n";
11485
11486   pr "\
11487 (* Run external virt-inspector, then use parser to parse the XML. *)
11488 let inspect ?connect ?xml names =
11489   let xml =
11490     match xml with
11491     | None ->
11492         if names = [] then invalid_arg \"inspect: no names given\";
11493         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11494           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11495           names in
11496         let cmd = List.map Filename.quote cmd in
11497         let cmd = String.concat \" \" cmd in
11498         let chan = open_process_in cmd in
11499         let xml = Xml.parse_in chan in
11500         (match close_process_in chan with
11501          | WEXITED 0 -> ()
11502          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11503          | WSIGNALED i | WSTOPPED i ->
11504              failwith (\"external virt-inspector command died or stopped on sig \" ^
11505                        string_of_int i)
11506         );
11507         xml
11508     | Some doc ->
11509         Xml.parse_string doc in
11510   parse_operatingsystems xml
11511 "
11512
11513 (* This is used to generate the src/MAX_PROC_NR file which
11514  * contains the maximum procedure number, a surrogate for the
11515  * ABI version number.  See src/Makefile.am for the details.
11516  *)
11517 and generate_max_proc_nr () =
11518   let proc_nrs = List.map (
11519     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11520   ) daemon_functions in
11521
11522   let max_proc_nr = List.fold_left max 0 proc_nrs in
11523
11524   pr "%d\n" max_proc_nr
11525
11526 let output_to filename k =
11527   let filename_new = filename ^ ".new" in
11528   chan := open_out filename_new;
11529   k ();
11530   close_out !chan;
11531   chan := Pervasives.stdout;
11532
11533   (* Is the new file different from the current file? *)
11534   if Sys.file_exists filename && files_equal filename filename_new then
11535     unlink filename_new                 (* same, so skip it *)
11536   else (
11537     (* different, overwrite old one *)
11538     (try chmod filename 0o644 with Unix_error _ -> ());
11539     rename filename_new filename;
11540     chmod filename 0o444;
11541     printf "written %s\n%!" filename;
11542   )
11543
11544 let perror msg = function
11545   | Unix_error (err, _, _) ->
11546       eprintf "%s: %s\n" msg (error_message err)
11547   | exn ->
11548       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11549
11550 (* Main program. *)
11551 let () =
11552   let lock_fd =
11553     try openfile "HACKING" [O_RDWR] 0
11554     with
11555     | Unix_error (ENOENT, _, _) ->
11556         eprintf "\
11557 You are probably running this from the wrong directory.
11558 Run it from the top source directory using the command
11559   src/generator.ml
11560 ";
11561         exit 1
11562     | exn ->
11563         perror "open: HACKING" exn;
11564         exit 1 in
11565
11566   (* Acquire a lock so parallel builds won't try to run the generator
11567    * twice at the same time.  Subsequent builds will wait for the first
11568    * one to finish.  Note the lock is released implicitly when the
11569    * program exits.
11570    *)
11571   (try lockf lock_fd F_LOCK 1
11572    with exn ->
11573      perror "lock: HACKING" exn;
11574      exit 1);
11575
11576   check_functions ();
11577
11578   output_to "src/guestfs_protocol.x" generate_xdr;
11579   output_to "src/guestfs-structs.h" generate_structs_h;
11580   output_to "src/guestfs-actions.h" generate_actions_h;
11581   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11582   output_to "src/guestfs-actions.c" generate_client_actions;
11583   output_to "src/guestfs-bindtests.c" generate_bindtests;
11584   output_to "src/guestfs-structs.pod" generate_structs_pod;
11585   output_to "src/guestfs-actions.pod" generate_actions_pod;
11586   output_to "src/guestfs-availability.pod" generate_availability_pod;
11587   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11588   output_to "src/libguestfs.syms" generate_linker_script;
11589   output_to "daemon/actions.h" generate_daemon_actions_h;
11590   output_to "daemon/stubs.c" generate_daemon_actions;
11591   output_to "daemon/names.c" generate_daemon_names;
11592   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11593   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11594   output_to "capitests/tests.c" generate_tests;
11595   output_to "fish/cmds.c" generate_fish_cmds;
11596   output_to "fish/completion.c" generate_fish_completion;
11597   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11598   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11599   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11600   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11601   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11602   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11603   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11604   output_to "perl/Guestfs.xs" generate_perl_xs;
11605   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11606   output_to "perl/bindtests.pl" generate_perl_bindtests;
11607   output_to "python/guestfs-py.c" generate_python_c;
11608   output_to "python/guestfs.py" generate_python_py;
11609   output_to "python/bindtests.py" generate_python_bindtests;
11610   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11611   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11612   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11613
11614   List.iter (
11615     fun (typ, jtyp) ->
11616       let cols = cols_of_struct typ in
11617       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11618       output_to filename (generate_java_struct jtyp cols);
11619   ) java_structs;
11620
11621   output_to "java/Makefile.inc" generate_java_makefile_inc;
11622   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11623   output_to "java/Bindtests.java" generate_java_bindtests;
11624   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11625   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11626   output_to "csharp/Libguestfs.cs" generate_csharp;
11627
11628   (* Always generate this file last, and unconditionally.  It's used
11629    * by the Makefile to know when we must re-run the generator.
11630    *)
11631   let chan = open_out "src/stamp-generator" in
11632   fprintf chan "1\n";
11633   close_out chan;
11634
11635   printf "generated %d lines of code\n" !lines