generator: Fix typo in error message for RConstOptString.
[libguestfs.git] / src / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009-2010 Red Hat Inc.
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18  *)
19
20 (* This script generates a large amount of code and documentation for
21  * all the daemon actions.
22  *
23  * To add a new action there are only two files you need to change,
24  * this one to describe the interface (see the big table of
25  * 'daemon_functions' below), and daemon/<somefile>.c to write the
26  * implementation.
27  *
28  * After editing this file, run it (./src/generator.ml) to regenerate
29  * all the output files.  'make' will rerun this automatically when
30  * necessary.  Note that if you are using a separate build directory
31  * you must run generator.ml from the _source_ directory.
32  *
33  * IMPORTANT: This script should NOT print any warnings.  If it prints
34  * warnings, you should treat them as errors.
35  *
36  * OCaml tips:
37  * (1) In emacs, install tuareg-mode to display and format OCaml code
38  * correctly.  'vim' comes with a good OCaml editing mode by default.
39  * (2) Read the resources at http://ocaml-tutorial.org/
40  *)
41
42 #load "unix.cma";;
43 #load "str.cma";;
44 #directory "+xml-light";;
45 #directory "+../pkg-lib/xml-light";; (* for GODI users *)
46 #load "xml-light.cma";;
47
48 open Unix
49 open Printf
50
51 type style = ret * args
52 and ret =
53     (* "RErr" as a return value means an int used as a simple error
54      * indication, ie. 0 or -1.
55      *)
56   | RErr
57
58     (* "RInt" as a return value means an int which is -1 for error
59      * or any value >= 0 on success.  Only use this for smallish
60      * positive ints (0 <= i < 2^30).
61      *)
62   | RInt of string
63
64     (* "RInt64" is the same as RInt, but is guaranteed to be able
65      * to return a full 64 bit value, _except_ that -1 means error
66      * (so -1 cannot be a valid, non-error return value).
67      *)
68   | RInt64 of string
69
70     (* "RBool" is a bool return value which can be true/false or
71      * -1 for error.
72      *)
73   | RBool of string
74
75     (* "RConstString" is a string that refers to a constant value.
76      * The return value must NOT be NULL (since NULL indicates
77      * an error).
78      *
79      * Try to avoid using this.  In particular you cannot use this
80      * for values returned from the daemon, because there is no
81      * thread-safe way to return them in the C API.
82      *)
83   | RConstString of string
84
85     (* "RConstOptString" is an even more broken version of
86      * "RConstString".  The returned string may be NULL and there
87      * is no way to return an error indication.  Avoid using this!
88      *)
89   | RConstOptString of string
90
91     (* "RString" is a returned string.  It must NOT be NULL, since
92      * a NULL return indicates an error.  The caller frees this.
93      *)
94   | RString of string
95
96     (* "RStringList" is a list of strings.  No string in the list
97      * can be NULL.  The caller frees the strings and the array.
98      *)
99   | RStringList of string
100
101     (* "RStruct" is a function which returns a single named structure
102      * or an error indication (in C, a struct, and in other languages
103      * with varying representations, but usually very efficient).  See
104      * after the function list below for the structures.
105      *)
106   | RStruct of string * string          (* name of retval, name of struct *)
107
108     (* "RStructList" is a function which returns either a list/array
109      * of structures (could be zero-length), or an error indication.
110      *)
111   | RStructList of string * string      (* name of retval, name of struct *)
112
113     (* Key-value pairs of untyped strings.  Turns into a hashtable or
114      * dictionary in languages which support it.  DON'T use this as a
115      * general "bucket" for results.  Prefer a stronger typed return
116      * value if one is available, or write a custom struct.  Don't use
117      * this if the list could potentially be very long, since it is
118      * inefficient.  Keys should be unique.  NULLs are not permitted.
119      *)
120   | RHashtable of string
121
122     (* "RBufferOut" is handled almost exactly like RString, but
123      * it allows the string to contain arbitrary 8 bit data including
124      * ASCII NUL.  In the C API this causes an implicit extra parameter
125      * to be added of type <size_t *size_r>.  The extra parameter
126      * returns the actual size of the return buffer in bytes.
127      *
128      * Other programming languages support strings with arbitrary 8 bit
129      * data.
130      *
131      * At the RPC layer we have to use the opaque<> type instead of
132      * string<>.  Returned data is still limited to the max message
133      * size (ie. ~ 2 MB).
134      *)
135   | RBufferOut of string
136
137 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
138
139     (* Note in future we should allow a "variable args" parameter as
140      * the final parameter, to allow commands like
141      *   chmod mode file [file(s)...]
142      * This is not implemented yet, but many commands (such as chmod)
143      * are currently defined with the argument order keeping this future
144      * possibility in mind.
145      *)
146 and argt =
147   | String of string    (* const char *name, cannot be NULL *)
148   | Device of string    (* /dev device name, cannot be NULL *)
149   | Pathname of string  (* file name, cannot be NULL *)
150   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
151   | OptString of string (* const char *name, may be NULL *)
152   | StringList of string(* list of strings (each string cannot be NULL) *)
153   | DeviceList of string(* list of Device names (each cannot be NULL) *)
154   | Bool of string      (* boolean *)
155   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
156   | Int64 of string     (* any 64 bit int *)
157     (* These are treated as filenames (simple string parameters) in
158      * the C API and bindings.  But in the RPC protocol, we transfer
159      * the actual file content up to or down from the daemon.
160      * FileIn: local machine -> daemon (in request)
161      * FileOut: daemon -> local machine (in reply)
162      * In guestfish (only), the special name "-" means read from
163      * stdin or write to stdout.
164      *)
165   | FileIn of string
166   | FileOut of string
167 (* Not implemented:
168     (* Opaque buffer which can contain arbitrary 8 bit data.
169      * In the C API, this is expressed as <char *, int> pair.
170      * Most other languages have a string type which can contain
171      * ASCII NUL.  We use whatever type is appropriate for each
172      * language.
173      * Buffers are limited by the total message size.  To transfer
174      * large blocks of data, use FileIn/FileOut parameters instead.
175      * To return an arbitrary buffer, use RBufferOut.
176      *)
177   | BufferIn of string
178 *)
179
180 type flags =
181   | ProtocolLimitWarning  (* display warning about protocol size limits *)
182   | DangerWillRobinson    (* flags particularly dangerous commands *)
183   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
184   | FishAction of string  (* call this function in guestfish *)
185   | NotInFish             (* do not export via guestfish *)
186   | NotInDocs             (* do not add this function to documentation *)
187   | DeprecatedBy of string (* function is deprecated, use .. instead *)
188   | Optional of string    (* function is part of an optional group *)
189
190 (* You can supply zero or as many tests as you want per API call.
191  *
192  * Note that the test environment has 3 block devices, of size 500MB,
193  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
194  * a fourth ISO block device with some known files on it (/dev/sdd).
195  *
196  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
197  * Number of cylinders was 63 for IDE emulated disks with precisely
198  * the same size.  How exactly this is calculated is a mystery.
199  *
200  * The ISO block device (/dev/sdd) comes from images/test.iso.
201  *
202  * To be able to run the tests in a reasonable amount of time,
203  * the virtual machine and block devices are reused between tests.
204  * So don't try testing kill_subprocess :-x
205  *
206  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
207  *
208  * Don't assume anything about the previous contents of the block
209  * devices.  Use 'Init*' to create some initial scenarios.
210  *
211  * You can add a prerequisite clause to any individual test.  This
212  * is a run-time check, which, if it fails, causes the test to be
213  * skipped.  Useful if testing a command which might not work on
214  * all variations of libguestfs builds.  A test that has prerequisite
215  * of 'Always' is run unconditionally.
216  *
217  * In addition, packagers can skip individual tests by setting the
218  * environment variables:     eg:
219  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
220  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
221  *)
222 type tests = (test_init * test_prereq * test) list
223 and test =
224     (* Run the command sequence and just expect nothing to fail. *)
225   | TestRun of seq
226
227     (* Run the command sequence and expect the output of the final
228      * command to be the string.
229      *)
230   | TestOutput of seq * string
231
232     (* Run the command sequence and expect the output of the final
233      * command to be the list of strings.
234      *)
235   | TestOutputList of seq * string list
236
237     (* Run the command sequence and expect the output of the final
238      * command to be the list of block devices (could be either
239      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
240      * character of each string).
241      *)
242   | TestOutputListOfDevices of seq * string list
243
244     (* Run the command sequence and expect the output of the final
245      * command to be the integer.
246      *)
247   | TestOutputInt of seq * int
248
249     (* Run the command sequence and expect the output of the final
250      * command to be <op> <int>, eg. ">=", "1".
251      *)
252   | TestOutputIntOp of seq * string * int
253
254     (* Run the command sequence and expect the output of the final
255      * command to be a true value (!= 0 or != NULL).
256      *)
257   | TestOutputTrue of seq
258
259     (* Run the command sequence and expect the output of the final
260      * command to be a false value (== 0 or == NULL, but not an error).
261      *)
262   | TestOutputFalse of seq
263
264     (* Run the command sequence and expect the output of the final
265      * command to be a list of the given length (but don't care about
266      * content).
267      *)
268   | TestOutputLength of seq * int
269
270     (* Run the command sequence and expect the output of the final
271      * command to be a buffer (RBufferOut), ie. string + size.
272      *)
273   | TestOutputBuffer of seq * string
274
275     (* Run the command sequence and expect the output of the final
276      * command to be a structure.
277      *)
278   | TestOutputStruct of seq * test_field_compare list
279
280     (* Run the command sequence and expect the final command (only)
281      * to fail.
282      *)
283   | TestLastFail of seq
284
285 and test_field_compare =
286   | CompareWithInt of string * int
287   | CompareWithIntOp of string * string * int
288   | CompareWithString of string * string
289   | CompareFieldsIntEq of string * string
290   | CompareFieldsStrEq of string * string
291
292 (* Test prerequisites. *)
293 and test_prereq =
294     (* Test always runs. *)
295   | Always
296
297     (* Test is currently disabled - eg. it fails, or it tests some
298      * unimplemented feature.
299      *)
300   | Disabled
301
302     (* 'string' is some C code (a function body) that should return
303      * true or false.  The test will run if the code returns true.
304      *)
305   | If of string
306
307     (* As for 'If' but the test runs _unless_ the code returns true. *)
308   | Unless of string
309
310     (* Run the test only if 'string' is available in the daemon. *)
311   | IfAvailable of string
312
313 (* Some initial scenarios for testing. *)
314 and test_init =
315     (* Do nothing, block devices could contain random stuff including
316      * LVM PVs, and some filesystems might be mounted.  This is usually
317      * a bad idea.
318      *)
319   | InitNone
320
321     (* Block devices are empty and no filesystems are mounted. *)
322   | InitEmpty
323
324     (* /dev/sda contains a single partition /dev/sda1, with random
325      * content.  /dev/sdb and /dev/sdc may have random content.
326      * No LVM.
327      *)
328   | InitPartition
329
330     (* /dev/sda contains a single partition /dev/sda1, which is formatted
331      * as ext2, empty [except for lost+found] and mounted on /.
332      * /dev/sdb and /dev/sdc may have random content.
333      * No LVM.
334      *)
335   | InitBasicFS
336
337     (* /dev/sda:
338      *   /dev/sda1 (is a PV):
339      *     /dev/VG/LV (size 8MB):
340      *       formatted as ext2, empty [except for lost+found], mounted on /
341      * /dev/sdb and /dev/sdc may have random content.
342      *)
343   | InitBasicFSonLVM
344
345     (* /dev/sdd (the ISO, see images/ directory in source)
346      * is mounted on /
347      *)
348   | InitISOFS
349
350 (* Sequence of commands for testing. *)
351 and seq = cmd list
352 and cmd = string list
353
354 (* Note about long descriptions: When referring to another
355  * action, use the format C<guestfs_other> (ie. the full name of
356  * the C function).  This will be replaced as appropriate in other
357  * language bindings.
358  *
359  * Apart from that, long descriptions are just perldoc paragraphs.
360  *)
361
362 (* Generate a random UUID (used in tests). *)
363 let uuidgen () =
364   let chan = open_process_in "uuidgen" in
365   let uuid = input_line chan in
366   (match close_process_in chan with
367    | WEXITED 0 -> ()
368    | WEXITED _ ->
369        failwith "uuidgen: process exited with non-zero status"
370    | WSIGNALED _ | WSTOPPED _ ->
371        failwith "uuidgen: process signalled or stopped by signal"
372   );
373   uuid
374
375 (* These test functions are used in the language binding tests. *)
376
377 let test_all_args = [
378   String "str";
379   OptString "optstr";
380   StringList "strlist";
381   Bool "b";
382   Int "integer";
383   Int64 "integer64";
384   FileIn "filein";
385   FileOut "fileout";
386 ]
387
388 let test_all_rets = [
389   (* except for RErr, which is tested thoroughly elsewhere *)
390   "test0rint",         RInt "valout";
391   "test0rint64",       RInt64 "valout";
392   "test0rbool",        RBool "valout";
393   "test0rconststring", RConstString "valout";
394   "test0rconstoptstring", RConstOptString "valout";
395   "test0rstring",      RString "valout";
396   "test0rstringlist",  RStringList "valout";
397   "test0rstruct",      RStruct ("valout", "lvm_pv");
398   "test0rstructlist",  RStructList ("valout", "lvm_pv");
399   "test0rhashtable",   RHashtable "valout";
400 ]
401
402 let test_functions = [
403   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
404    [],
405    "internal test function - do not use",
406    "\
407 This is an internal test function which is used to test whether
408 the automatically generated bindings can handle every possible
409 parameter type correctly.
410
411 It echos the contents of each parameter to stdout.
412
413 You probably don't want to call this function.");
414 ] @ List.flatten (
415   List.map (
416     fun (name, ret) ->
417       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
418         [],
419         "internal test function - do not use",
420         "\
421 This is an internal test function which is used to test whether
422 the automatically generated bindings can handle every possible
423 return type correctly.
424
425 It converts string C<val> to the return type.
426
427 You probably don't want to call this function.");
428        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
429         [],
430         "internal test function - do not use",
431         "\
432 This is an internal test function which is used to test whether
433 the automatically generated bindings can handle every possible
434 return type correctly.
435
436 This function always returns an error.
437
438 You probably don't want to call this function.")]
439   ) test_all_rets
440 )
441
442 (* non_daemon_functions are any functions which don't get processed
443  * in the daemon, eg. functions for setting and getting local
444  * configuration values.
445  *)
446
447 let non_daemon_functions = test_functions @ [
448   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
449    [],
450    "launch the qemu subprocess",
451    "\
452 Internally libguestfs is implemented by running a virtual machine
453 using L<qemu(1)>.
454
455 You should call this after configuring the handle
456 (eg. adding drives) but before performing any actions.");
457
458   ("wait_ready", (RErr, []), -1, [NotInFish],
459    [],
460    "wait until the qemu subprocess launches (no op)",
461    "\
462 This function is a no op.
463
464 In versions of the API E<lt> 1.0.71 you had to call this function
465 just after calling C<guestfs_launch> to wait for the launch
466 to complete.  However this is no longer necessary because
467 C<guestfs_launch> now does the waiting.
468
469 If you see any calls to this function in code then you can just
470 remove them, unless you want to retain compatibility with older
471 versions of the API.");
472
473   ("kill_subprocess", (RErr, []), -1, [],
474    [],
475    "kill the qemu subprocess",
476    "\
477 This kills the qemu subprocess.  You should never need to call this.");
478
479   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
480    [],
481    "add an image to examine or modify",
482    "\
483 This function adds a virtual machine disk image C<filename> to the
484 guest.  The first time you call this function, the disk appears as IDE
485 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
486 so on.
487
488 You don't necessarily need to be root when using libguestfs.  However
489 you obviously do need sufficient permissions to access the filename
490 for whatever operations you want to perform (ie. read access if you
491 just want to read the image or write access if you want to modify the
492 image).
493
494 This is equivalent to the qemu parameter
495 C<-drive file=filename,cache=off,if=...>.
496
497 C<cache=off> is omitted in cases where it is not supported by
498 the underlying filesystem.
499
500 C<if=...> is set at compile time by the configuration option
501 C<./configure --with-drive-if=...>.  In the rare case where you
502 might need to change this at run time, use C<guestfs_add_drive_with_if>
503 or C<guestfs_add_drive_ro_with_if>.
504
505 Note that this call checks for the existence of C<filename>.  This
506 stops you from specifying other types of drive which are supported
507 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
508 the general C<guestfs_config> call instead.");
509
510   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
511    [],
512    "add a CD-ROM disk image to examine",
513    "\
514 This function adds a virtual CD-ROM disk image to the guest.
515
516 This is equivalent to the qemu parameter C<-cdrom filename>.
517
518 Notes:
519
520 =over 4
521
522 =item *
523
524 This call checks for the existence of C<filename>.  This
525 stops you from specifying other types of drive which are supported
526 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
527 the general C<guestfs_config> call instead.
528
529 =item *
530
531 If you just want to add an ISO file (often you use this as an
532 efficient way to transfer large files into the guest), then you
533 should probably use C<guestfs_add_drive_ro> instead.
534
535 =back");
536
537   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
538    [],
539    "add a drive in snapshot mode (read-only)",
540    "\
541 This adds a drive in snapshot mode, making it effectively
542 read-only.
543
544 Note that writes to the device are allowed, and will be seen for
545 the duration of the guestfs handle, but they are written
546 to a temporary file which is discarded as soon as the guestfs
547 handle is closed.  We don't currently have any method to enable
548 changes to be committed, although qemu can support this.
549
550 This is equivalent to the qemu parameter
551 C<-drive file=filename,snapshot=on,if=...>.
552
553 C<if=...> is set at compile time by the configuration option
554 C<./configure --with-drive-if=...>.  In the rare case where you
555 might need to change this at run time, use C<guestfs_add_drive_with_if>
556 or C<guestfs_add_drive_ro_with_if>.
557
558 Note that this call checks for the existence of C<filename>.  This
559 stops you from specifying other types of drive which are supported
560 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
561 the general C<guestfs_config> call instead.");
562
563   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
564    [],
565    "add qemu parameters",
566    "\
567 This can be used to add arbitrary qemu command line parameters
568 of the form C<-param value>.  Actually it's not quite arbitrary - we
569 prevent you from setting some parameters which would interfere with
570 parameters that we use.
571
572 The first character of C<param> string must be a C<-> (dash).
573
574 C<value> can be NULL.");
575
576   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
577    [],
578    "set the qemu binary",
579    "\
580 Set the qemu binary that we will use.
581
582 The default is chosen when the library was compiled by the
583 configure script.
584
585 You can also override this by setting the C<LIBGUESTFS_QEMU>
586 environment variable.
587
588 Setting C<qemu> to C<NULL> restores the default qemu binary.
589
590 Note that you should call this function as early as possible
591 after creating the handle.  This is because some pre-launch
592 operations depend on testing qemu features (by running C<qemu -help>).
593 If the qemu binary changes, we don't retest features, and
594 so you might see inconsistent results.  Using the environment
595 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
596 the qemu binary at the same time as the handle is created.");
597
598   ("get_qemu", (RConstString "qemu", []), -1, [],
599    [InitNone, Always, TestRun (
600       [["get_qemu"]])],
601    "get the qemu binary",
602    "\
603 Return the current qemu binary.
604
605 This is always non-NULL.  If it wasn't set already, then this will
606 return the default qemu binary name.");
607
608   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
609    [],
610    "set the search path",
611    "\
612 Set the path that libguestfs searches for kernel and initrd.img.
613
614 The default is C<$libdir/guestfs> unless overridden by setting
615 C<LIBGUESTFS_PATH> environment variable.
616
617 Setting C<path> to C<NULL> restores the default path.");
618
619   ("get_path", (RConstString "path", []), -1, [],
620    [InitNone, Always, TestRun (
621       [["get_path"]])],
622    "get the search path",
623    "\
624 Return the current search path.
625
626 This is always non-NULL.  If it wasn't set already, then this will
627 return the default path.");
628
629   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
630    [],
631    "add options to kernel command line",
632    "\
633 This function is used to add additional options to the
634 guest kernel command line.
635
636 The default is C<NULL> unless overridden by setting
637 C<LIBGUESTFS_APPEND> environment variable.
638
639 Setting C<append> to C<NULL> means I<no> additional options
640 are passed (libguestfs always adds a few of its own).");
641
642   ("get_append", (RConstOptString "append", []), -1, [],
643    (* This cannot be tested with the current framework.  The
644     * function can return NULL in normal operations, which the
645     * test framework interprets as an error.
646     *)
647    [],
648    "get the additional kernel options",
649    "\
650 Return the additional kernel options which are added to the
651 guest kernel command line.
652
653 If C<NULL> then no options are added.");
654
655   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
656    [],
657    "set autosync mode",
658    "\
659 If C<autosync> is true, this enables autosync.  Libguestfs will make a
660 best effort attempt to run C<guestfs_umount_all> followed by
661 C<guestfs_sync> when the handle is closed
662 (also if the program exits without closing handles).
663
664 This is disabled by default (except in guestfish where it is
665 enabled by default).");
666
667   ("get_autosync", (RBool "autosync", []), -1, [],
668    [InitNone, Always, TestRun (
669       [["get_autosync"]])],
670    "get autosync mode",
671    "\
672 Get the autosync flag.");
673
674   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
675    [],
676    "set verbose mode",
677    "\
678 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
679
680 Verbose messages are disabled unless the environment variable
681 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
682
683   ("get_verbose", (RBool "verbose", []), -1, [],
684    [],
685    "get verbose mode",
686    "\
687 This returns the verbose messages flag.");
688
689   ("is_ready", (RBool "ready", []), -1, [],
690    [InitNone, Always, TestOutputTrue (
691       [["is_ready"]])],
692    "is ready to accept commands",
693    "\
694 This returns true iff this handle is ready to accept commands
695 (in the C<READY> state).
696
697 For more information on states, see L<guestfs(3)>.");
698
699   ("is_config", (RBool "config", []), -1, [],
700    [InitNone, Always, TestOutputFalse (
701       [["is_config"]])],
702    "is in configuration state",
703    "\
704 This returns true iff this handle is being configured
705 (in the C<CONFIG> state).
706
707 For more information on states, see L<guestfs(3)>.");
708
709   ("is_launching", (RBool "launching", []), -1, [],
710    [InitNone, Always, TestOutputFalse (
711       [["is_launching"]])],
712    "is launching subprocess",
713    "\
714 This returns true iff this handle is launching the subprocess
715 (in the C<LAUNCHING> state).
716
717 For more information on states, see L<guestfs(3)>.");
718
719   ("is_busy", (RBool "busy", []), -1, [],
720    [InitNone, Always, TestOutputFalse (
721       [["is_busy"]])],
722    "is busy processing a command",
723    "\
724 This returns true iff this handle is busy processing a command
725 (in the C<BUSY> state).
726
727 For more information on states, see L<guestfs(3)>.");
728
729   ("get_state", (RInt "state", []), -1, [],
730    [],
731    "get the current state",
732    "\
733 This returns the current state as an opaque integer.  This is
734 only useful for printing debug and internal error messages.
735
736 For more information on states, see L<guestfs(3)>.");
737
738   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
739    [InitNone, Always, TestOutputInt (
740       [["set_memsize"; "500"];
741        ["get_memsize"]], 500)],
742    "set memory allocated to the qemu subprocess",
743    "\
744 This sets the memory size in megabytes allocated to the
745 qemu subprocess.  This only has any effect if called before
746 C<guestfs_launch>.
747
748 You can also change this by setting the environment
749 variable C<LIBGUESTFS_MEMSIZE> before the handle is
750 created.
751
752 For more information on the architecture of libguestfs,
753 see L<guestfs(3)>.");
754
755   ("get_memsize", (RInt "memsize", []), -1, [],
756    [InitNone, Always, TestOutputIntOp (
757       [["get_memsize"]], ">=", 256)],
758    "get memory allocated to the qemu subprocess",
759    "\
760 This gets the memory size in megabytes allocated to the
761 qemu subprocess.
762
763 If C<guestfs_set_memsize> was not called
764 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
765 then this returns the compiled-in default value for memsize.
766
767 For more information on the architecture of libguestfs,
768 see L<guestfs(3)>.");
769
770   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
771    [InitNone, Always, TestOutputIntOp (
772       [["get_pid"]], ">=", 1)],
773    "get PID of qemu subprocess",
774    "\
775 Return the process ID of the qemu subprocess.  If there is no
776 qemu subprocess, then this will return an error.
777
778 This is an internal call used for debugging and testing.");
779
780   ("version", (RStruct ("version", "version"), []), -1, [],
781    [InitNone, Always, TestOutputStruct (
782       [["version"]], [CompareWithInt ("major", 1)])],
783    "get the library version number",
784    "\
785 Return the libguestfs version number that the program is linked
786 against.
787
788 Note that because of dynamic linking this is not necessarily
789 the version of libguestfs that you compiled against.  You can
790 compile the program, and then at runtime dynamically link
791 against a completely different C<libguestfs.so> library.
792
793 This call was added in version C<1.0.58>.  In previous
794 versions of libguestfs there was no way to get the version
795 number.  From C code you can use dynamic linker functions
796 to find out if this symbol exists (if it doesn't, then
797 it's an earlier version).
798
799 The call returns a structure with four elements.  The first
800 three (C<major>, C<minor> and C<release>) are numbers and
801 correspond to the usual version triplet.  The fourth element
802 (C<extra>) is a string and is normally empty, but may be
803 used for distro-specific information.
804
805 To construct the original version string:
806 C<$major.$minor.$release$extra>
807
808 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
809
810 I<Note:> Don't use this call to test for availability
811 of features.  In enterprise distributions we backport
812 features from later versions into earlier versions,
813 making this an unreliable way to test for features.
814 Use C<guestfs_available> instead.");
815
816   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
817    [InitNone, Always, TestOutputTrue (
818       [["set_selinux"; "true"];
819        ["get_selinux"]])],
820    "set SELinux enabled or disabled at appliance boot",
821    "\
822 This sets the selinux flag that is passed to the appliance
823 at boot time.  The default is C<selinux=0> (disabled).
824
825 Note that if SELinux is enabled, it is always in
826 Permissive mode (C<enforcing=0>).
827
828 For more information on the architecture of libguestfs,
829 see L<guestfs(3)>.");
830
831   ("get_selinux", (RBool "selinux", []), -1, [],
832    [],
833    "get SELinux enabled flag",
834    "\
835 This returns the current setting of the selinux flag which
836 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
837
838 For more information on the architecture of libguestfs,
839 see L<guestfs(3)>.");
840
841   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
842    [InitNone, Always, TestOutputFalse (
843       [["set_trace"; "false"];
844        ["get_trace"]])],
845    "enable or disable command traces",
846    "\
847 If the command trace flag is set to 1, then commands are
848 printed on stdout before they are executed in a format
849 which is very similar to the one used by guestfish.  In
850 other words, you can run a program with this enabled, and
851 you will get out a script which you can feed to guestfish
852 to perform the same set of actions.
853
854 If you want to trace C API calls into libguestfs (and
855 other libraries) then possibly a better way is to use
856 the external ltrace(1) command.
857
858 Command traces are disabled unless the environment variable
859 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
860
861   ("get_trace", (RBool "trace", []), -1, [],
862    [],
863    "get command trace enabled flag",
864    "\
865 Return the command trace flag.");
866
867   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
868    [InitNone, Always, TestOutputFalse (
869       [["set_direct"; "false"];
870        ["get_direct"]])],
871    "enable or disable direct appliance mode",
872    "\
873 If the direct appliance mode flag is enabled, then stdin and
874 stdout are passed directly through to the appliance once it
875 is launched.
876
877 One consequence of this is that log messages aren't caught
878 by the library and handled by C<guestfs_set_log_message_callback>,
879 but go straight to stdout.
880
881 You probably don't want to use this unless you know what you
882 are doing.
883
884 The default is disabled.");
885
886   ("get_direct", (RBool "direct", []), -1, [],
887    [],
888    "get direct appliance mode flag",
889    "\
890 Return the direct appliance mode flag.");
891
892   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
893    [InitNone, Always, TestOutputTrue (
894       [["set_recovery_proc"; "true"];
895        ["get_recovery_proc"]])],
896    "enable or disable the recovery process",
897    "\
898 If this is called with the parameter C<false> then
899 C<guestfs_launch> does not create a recovery process.  The
900 purpose of the recovery process is to stop runaway qemu
901 processes in the case where the main program aborts abruptly.
902
903 This only has any effect if called before C<guestfs_launch>,
904 and the default is true.
905
906 About the only time when you would want to disable this is
907 if the main process will fork itself into the background
908 (\"daemonize\" itself).  In this case the recovery process
909 thinks that the main program has disappeared and so kills
910 qemu, which is not very helpful.");
911
912   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
913    [],
914    "get recovery process enabled flag",
915    "\
916 Return the recovery process enabled flag.");
917
918   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
919    [],
920    "add a drive specifying the QEMU block emulation to use",
921    "\
922 This is the same as C<guestfs_add_drive> but it allows you
923 to specify the QEMU interface emulation to use at run time.");
924
925   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
926    [],
927    "add a drive read-only specifying the QEMU block emulation to use",
928    "\
929 This is the same as C<guestfs_add_drive_ro> but it allows you
930 to specify the QEMU interface emulation to use at run time.");
931
932 ]
933
934 (* daemon_functions are any functions which cause some action
935  * to take place in the daemon.
936  *)
937
938 let daemon_functions = [
939   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
940    [InitEmpty, Always, TestOutput (
941       [["part_disk"; "/dev/sda"; "mbr"];
942        ["mkfs"; "ext2"; "/dev/sda1"];
943        ["mount"; "/dev/sda1"; "/"];
944        ["write_file"; "/new"; "new file contents"; "0"];
945        ["cat"; "/new"]], "new file contents")],
946    "mount a guest disk at a position in the filesystem",
947    "\
948 Mount a guest disk at a position in the filesystem.  Block devices
949 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
950 the guest.  If those block devices contain partitions, they will have
951 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
952 names can be used.
953
954 The rules are the same as for L<mount(2)>:  A filesystem must
955 first be mounted on C</> before others can be mounted.  Other
956 filesystems can only be mounted on directories which already
957 exist.
958
959 The mounted filesystem is writable, if we have sufficient permissions
960 on the underlying device.
961
962 B<Important note:>
963 When you use this call, the filesystem options C<sync> and C<noatime>
964 are set implicitly.  This was originally done because we thought it
965 would improve reliability, but it turns out that I<-o sync> has a
966 very large negative performance impact and negligible effect on
967 reliability.  Therefore we recommend that you avoid using
968 C<guestfs_mount> in any code that needs performance, and instead
969 use C<guestfs_mount_options> (use an empty string for the first
970 parameter if you don't want any options).");
971
972   ("sync", (RErr, []), 2, [],
973    [ InitEmpty, Always, TestRun [["sync"]]],
974    "sync disks, writes are flushed through to the disk image",
975    "\
976 This syncs the disk, so that any writes are flushed through to the
977 underlying disk image.
978
979 You should always call this if you have modified a disk image, before
980 closing the handle.");
981
982   ("touch", (RErr, [Pathname "path"]), 3, [],
983    [InitBasicFS, Always, TestOutputTrue (
984       [["touch"; "/new"];
985        ["exists"; "/new"]])],
986    "update file timestamps or create a new file",
987    "\
988 Touch acts like the L<touch(1)> command.  It can be used to
989 update the timestamps on a file, or, if the file does not exist,
990 to create a new zero-length file.");
991
992   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
993    [InitISOFS, Always, TestOutput (
994       [["cat"; "/known-2"]], "abcdef\n")],
995    "list the contents of a file",
996    "\
997 Return the contents of the file named C<path>.
998
999 Note that this function cannot correctly handle binary files
1000 (specifically, files containing C<\\0> character which is treated
1001 as end of string).  For those you need to use the C<guestfs_read_file>
1002 or C<guestfs_download> functions which have a more complex interface.");
1003
1004   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1005    [], (* XXX Tricky to test because it depends on the exact format
1006         * of the 'ls -l' command, which changes between F10 and F11.
1007         *)
1008    "list the files in a directory (long format)",
1009    "\
1010 List the files in C<directory> (relative to the root directory,
1011 there is no cwd) in the format of 'ls -la'.
1012
1013 This command is mostly useful for interactive sessions.  It
1014 is I<not> intended that you try to parse the output string.");
1015
1016   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1017    [InitBasicFS, Always, TestOutputList (
1018       [["touch"; "/new"];
1019        ["touch"; "/newer"];
1020        ["touch"; "/newest"];
1021        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1022    "list the files in a directory",
1023    "\
1024 List the files in C<directory> (relative to the root directory,
1025 there is no cwd).  The '.' and '..' entries are not returned, but
1026 hidden files are shown.
1027
1028 This command is mostly useful for interactive sessions.  Programs
1029 should probably use C<guestfs_readdir> instead.");
1030
1031   ("list_devices", (RStringList "devices", []), 7, [],
1032    [InitEmpty, Always, TestOutputListOfDevices (
1033       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1034    "list the block devices",
1035    "\
1036 List all the block devices.
1037
1038 The full block device names are returned, eg. C</dev/sda>");
1039
1040   ("list_partitions", (RStringList "partitions", []), 8, [],
1041    [InitBasicFS, Always, TestOutputListOfDevices (
1042       [["list_partitions"]], ["/dev/sda1"]);
1043     InitEmpty, Always, TestOutputListOfDevices (
1044       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1045        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1046    "list the partitions",
1047    "\
1048 List all the partitions detected on all block devices.
1049
1050 The full partition device names are returned, eg. C</dev/sda1>
1051
1052 This does not return logical volumes.  For that you will need to
1053 call C<guestfs_lvs>.");
1054
1055   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1056    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1057       [["pvs"]], ["/dev/sda1"]);
1058     InitEmpty, Always, TestOutputListOfDevices (
1059       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1060        ["pvcreate"; "/dev/sda1"];
1061        ["pvcreate"; "/dev/sda2"];
1062        ["pvcreate"; "/dev/sda3"];
1063        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1064    "list the LVM physical volumes (PVs)",
1065    "\
1066 List all the physical volumes detected.  This is the equivalent
1067 of the L<pvs(8)> command.
1068
1069 This returns a list of just the device names that contain
1070 PVs (eg. C</dev/sda2>).
1071
1072 See also C<guestfs_pvs_full>.");
1073
1074   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1075    [InitBasicFSonLVM, Always, TestOutputList (
1076       [["vgs"]], ["VG"]);
1077     InitEmpty, Always, TestOutputList (
1078       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1079        ["pvcreate"; "/dev/sda1"];
1080        ["pvcreate"; "/dev/sda2"];
1081        ["pvcreate"; "/dev/sda3"];
1082        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1083        ["vgcreate"; "VG2"; "/dev/sda3"];
1084        ["vgs"]], ["VG1"; "VG2"])],
1085    "list the LVM volume groups (VGs)",
1086    "\
1087 List all the volumes groups detected.  This is the equivalent
1088 of the L<vgs(8)> command.
1089
1090 This returns a list of just the volume group names that were
1091 detected (eg. C<VolGroup00>).
1092
1093 See also C<guestfs_vgs_full>.");
1094
1095   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1096    [InitBasicFSonLVM, Always, TestOutputList (
1097       [["lvs"]], ["/dev/VG/LV"]);
1098     InitEmpty, Always, TestOutputList (
1099       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1100        ["pvcreate"; "/dev/sda1"];
1101        ["pvcreate"; "/dev/sda2"];
1102        ["pvcreate"; "/dev/sda3"];
1103        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1104        ["vgcreate"; "VG2"; "/dev/sda3"];
1105        ["lvcreate"; "LV1"; "VG1"; "50"];
1106        ["lvcreate"; "LV2"; "VG1"; "50"];
1107        ["lvcreate"; "LV3"; "VG2"; "50"];
1108        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1109    "list the LVM logical volumes (LVs)",
1110    "\
1111 List all the logical volumes detected.  This is the equivalent
1112 of the L<lvs(8)> command.
1113
1114 This returns a list of the logical volume device names
1115 (eg. C</dev/VolGroup00/LogVol00>).
1116
1117 See also C<guestfs_lvs_full>.");
1118
1119   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1120    [], (* XXX how to test? *)
1121    "list the LVM physical volumes (PVs)",
1122    "\
1123 List all the physical volumes detected.  This is the equivalent
1124 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1125
1126   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1127    [], (* XXX how to test? *)
1128    "list the LVM volume groups (VGs)",
1129    "\
1130 List all the volumes groups detected.  This is the equivalent
1131 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1132
1133   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1134    [], (* XXX how to test? *)
1135    "list the LVM logical volumes (LVs)",
1136    "\
1137 List all the logical volumes detected.  This is the equivalent
1138 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1139
1140   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1141    [InitISOFS, Always, TestOutputList (
1142       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1143     InitISOFS, Always, TestOutputList (
1144       [["read_lines"; "/empty"]], [])],
1145    "read file as lines",
1146    "\
1147 Return the contents of the file named C<path>.
1148
1149 The file contents are returned as a list of lines.  Trailing
1150 C<LF> and C<CRLF> character sequences are I<not> returned.
1151
1152 Note that this function cannot correctly handle binary files
1153 (specifically, files containing C<\\0> character which is treated
1154 as end of line).  For those you need to use the C<guestfs_read_file>
1155 function which has a more complex interface.");
1156
1157   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1158    [], (* XXX Augeas code needs tests. *)
1159    "create a new Augeas handle",
1160    "\
1161 Create a new Augeas handle for editing configuration files.
1162 If there was any previous Augeas handle associated with this
1163 guestfs session, then it is closed.
1164
1165 You must call this before using any other C<guestfs_aug_*>
1166 commands.
1167
1168 C<root> is the filesystem root.  C<root> must not be NULL,
1169 use C</> instead.
1170
1171 The flags are the same as the flags defined in
1172 E<lt>augeas.hE<gt>, the logical I<or> of the following
1173 integers:
1174
1175 =over 4
1176
1177 =item C<AUG_SAVE_BACKUP> = 1
1178
1179 Keep the original file with a C<.augsave> extension.
1180
1181 =item C<AUG_SAVE_NEWFILE> = 2
1182
1183 Save changes into a file with extension C<.augnew>, and
1184 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1185
1186 =item C<AUG_TYPE_CHECK> = 4
1187
1188 Typecheck lenses (can be expensive).
1189
1190 =item C<AUG_NO_STDINC> = 8
1191
1192 Do not use standard load path for modules.
1193
1194 =item C<AUG_SAVE_NOOP> = 16
1195
1196 Make save a no-op, just record what would have been changed.
1197
1198 =item C<AUG_NO_LOAD> = 32
1199
1200 Do not load the tree in C<guestfs_aug_init>.
1201
1202 =back
1203
1204 To close the handle, you can call C<guestfs_aug_close>.
1205
1206 To find out more about Augeas, see L<http://augeas.net/>.");
1207
1208   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1209    [], (* XXX Augeas code needs tests. *)
1210    "close the current Augeas handle",
1211    "\
1212 Close the current Augeas handle and free up any resources
1213 used by it.  After calling this, you have to call
1214 C<guestfs_aug_init> again before you can use any other
1215 Augeas functions.");
1216
1217   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1218    [], (* XXX Augeas code needs tests. *)
1219    "define an Augeas variable",
1220    "\
1221 Defines an Augeas variable C<name> whose value is the result
1222 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1223 undefined.
1224
1225 On success this returns the number of nodes in C<expr>, or
1226 C<0> if C<expr> evaluates to something which is not a nodeset.");
1227
1228   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1229    [], (* XXX Augeas code needs tests. *)
1230    "define an Augeas node",
1231    "\
1232 Defines a variable C<name> whose value is the result of
1233 evaluating C<expr>.
1234
1235 If C<expr> evaluates to an empty nodeset, a node is created,
1236 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1237 C<name> will be the nodeset containing that single node.
1238
1239 On success this returns a pair containing the
1240 number of nodes in the nodeset, and a boolean flag
1241 if a node was created.");
1242
1243   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1244    [], (* XXX Augeas code needs tests. *)
1245    "look up the value of an Augeas path",
1246    "\
1247 Look up the value associated with C<path>.  If C<path>
1248 matches exactly one node, the C<value> is returned.");
1249
1250   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1251    [], (* XXX Augeas code needs tests. *)
1252    "set Augeas path to value",
1253    "\
1254 Set the value associated with C<path> to C<value>.");
1255
1256   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1257    [], (* XXX Augeas code needs tests. *)
1258    "insert a sibling Augeas node",
1259    "\
1260 Create a new sibling C<label> for C<path>, inserting it into
1261 the tree before or after C<path> (depending on the boolean
1262 flag C<before>).
1263
1264 C<path> must match exactly one existing node in the tree, and
1265 C<label> must be a label, ie. not contain C</>, C<*> or end
1266 with a bracketed index C<[N]>.");
1267
1268   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1269    [], (* XXX Augeas code needs tests. *)
1270    "remove an Augeas path",
1271    "\
1272 Remove C<path> and all of its children.
1273
1274 On success this returns the number of entries which were removed.");
1275
1276   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1277    [], (* XXX Augeas code needs tests. *)
1278    "move Augeas node",
1279    "\
1280 Move the node C<src> to C<dest>.  C<src> must match exactly
1281 one node.  C<dest> is overwritten if it exists.");
1282
1283   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1284    [], (* XXX Augeas code needs tests. *)
1285    "return Augeas nodes which match augpath",
1286    "\
1287 Returns a list of paths which match the path expression C<path>.
1288 The returned paths are sufficiently qualified so that they match
1289 exactly one node in the current tree.");
1290
1291   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1292    [], (* XXX Augeas code needs tests. *)
1293    "write all pending Augeas changes to disk",
1294    "\
1295 This writes all pending changes to disk.
1296
1297 The flags which were passed to C<guestfs_aug_init> affect exactly
1298 how files are saved.");
1299
1300   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1301    [], (* XXX Augeas code needs tests. *)
1302    "load files into the tree",
1303    "\
1304 Load files into the tree.
1305
1306 See C<aug_load> in the Augeas documentation for the full gory
1307 details.");
1308
1309   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1310    [], (* XXX Augeas code needs tests. *)
1311    "list Augeas nodes under augpath",
1312    "\
1313 This is just a shortcut for listing C<guestfs_aug_match>
1314 C<path/*> and sorting the resulting nodes into alphabetical order.");
1315
1316   ("rm", (RErr, [Pathname "path"]), 29, [],
1317    [InitBasicFS, Always, TestRun
1318       [["touch"; "/new"];
1319        ["rm"; "/new"]];
1320     InitBasicFS, Always, TestLastFail
1321       [["rm"; "/new"]];
1322     InitBasicFS, Always, TestLastFail
1323       [["mkdir"; "/new"];
1324        ["rm"; "/new"]]],
1325    "remove a file",
1326    "\
1327 Remove the single file C<path>.");
1328
1329   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1330    [InitBasicFS, Always, TestRun
1331       [["mkdir"; "/new"];
1332        ["rmdir"; "/new"]];
1333     InitBasicFS, Always, TestLastFail
1334       [["rmdir"; "/new"]];
1335     InitBasicFS, Always, TestLastFail
1336       [["touch"; "/new"];
1337        ["rmdir"; "/new"]]],
1338    "remove a directory",
1339    "\
1340 Remove the single directory C<path>.");
1341
1342   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1343    [InitBasicFS, Always, TestOutputFalse
1344       [["mkdir"; "/new"];
1345        ["mkdir"; "/new/foo"];
1346        ["touch"; "/new/foo/bar"];
1347        ["rm_rf"; "/new"];
1348        ["exists"; "/new"]]],
1349    "remove a file or directory recursively",
1350    "\
1351 Remove the file or directory C<path>, recursively removing the
1352 contents if its a directory.  This is like the C<rm -rf> shell
1353 command.");
1354
1355   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1356    [InitBasicFS, Always, TestOutputTrue
1357       [["mkdir"; "/new"];
1358        ["is_dir"; "/new"]];
1359     InitBasicFS, Always, TestLastFail
1360       [["mkdir"; "/new/foo/bar"]]],
1361    "create a directory",
1362    "\
1363 Create a directory named C<path>.");
1364
1365   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1366    [InitBasicFS, Always, TestOutputTrue
1367       [["mkdir_p"; "/new/foo/bar"];
1368        ["is_dir"; "/new/foo/bar"]];
1369     InitBasicFS, Always, TestOutputTrue
1370       [["mkdir_p"; "/new/foo/bar"];
1371        ["is_dir"; "/new/foo"]];
1372     InitBasicFS, Always, TestOutputTrue
1373       [["mkdir_p"; "/new/foo/bar"];
1374        ["is_dir"; "/new"]];
1375     (* Regression tests for RHBZ#503133: *)
1376     InitBasicFS, Always, TestRun
1377       [["mkdir"; "/new"];
1378        ["mkdir_p"; "/new"]];
1379     InitBasicFS, Always, TestLastFail
1380       [["touch"; "/new"];
1381        ["mkdir_p"; "/new"]]],
1382    "create a directory and parents",
1383    "\
1384 Create a directory named C<path>, creating any parent directories
1385 as necessary.  This is like the C<mkdir -p> shell command.");
1386
1387   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1388    [], (* XXX Need stat command to test *)
1389    "change file mode",
1390    "\
1391 Change the mode (permissions) of C<path> to C<mode>.  Only
1392 numeric modes are supported.
1393
1394 I<Note>: When using this command from guestfish, C<mode>
1395 by default would be decimal, unless you prefix it with
1396 C<0> to get octal, ie. use C<0700> not C<700>.
1397
1398 The mode actually set is affected by the umask.");
1399
1400   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1401    [], (* XXX Need stat command to test *)
1402    "change file owner and group",
1403    "\
1404 Change the file owner to C<owner> and group to C<group>.
1405
1406 Only numeric uid and gid are supported.  If you want to use
1407 names, you will need to locate and parse the password file
1408 yourself (Augeas support makes this relatively easy).");
1409
1410   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1411    [InitISOFS, Always, TestOutputTrue (
1412       [["exists"; "/empty"]]);
1413     InitISOFS, Always, TestOutputTrue (
1414       [["exists"; "/directory"]])],
1415    "test if file or directory exists",
1416    "\
1417 This returns C<true> if and only if there is a file, directory
1418 (or anything) with the given C<path> name.
1419
1420 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1421
1422   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1423    [InitISOFS, Always, TestOutputTrue (
1424       [["is_file"; "/known-1"]]);
1425     InitISOFS, Always, TestOutputFalse (
1426       [["is_file"; "/directory"]])],
1427    "test if file exists",
1428    "\
1429 This returns C<true> if and only if there is a file
1430 with the given C<path> name.  Note that it returns false for
1431 other objects like directories.
1432
1433 See also C<guestfs_stat>.");
1434
1435   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1436    [InitISOFS, Always, TestOutputFalse (
1437       [["is_dir"; "/known-3"]]);
1438     InitISOFS, Always, TestOutputTrue (
1439       [["is_dir"; "/directory"]])],
1440    "test if file exists",
1441    "\
1442 This returns C<true> if and only if there is a directory
1443 with the given C<path> name.  Note that it returns false for
1444 other objects like files.
1445
1446 See also C<guestfs_stat>.");
1447
1448   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1449    [InitEmpty, Always, TestOutputListOfDevices (
1450       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1451        ["pvcreate"; "/dev/sda1"];
1452        ["pvcreate"; "/dev/sda2"];
1453        ["pvcreate"; "/dev/sda3"];
1454        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1455    "create an LVM physical volume",
1456    "\
1457 This creates an LVM physical volume on the named C<device>,
1458 where C<device> should usually be a partition name such
1459 as C</dev/sda1>.");
1460
1461   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1462    [InitEmpty, Always, TestOutputList (
1463       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1464        ["pvcreate"; "/dev/sda1"];
1465        ["pvcreate"; "/dev/sda2"];
1466        ["pvcreate"; "/dev/sda3"];
1467        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1468        ["vgcreate"; "VG2"; "/dev/sda3"];
1469        ["vgs"]], ["VG1"; "VG2"])],
1470    "create an LVM volume group",
1471    "\
1472 This creates an LVM volume group called C<volgroup>
1473 from the non-empty list of physical volumes C<physvols>.");
1474
1475   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1476    [InitEmpty, Always, TestOutputList (
1477       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1478        ["pvcreate"; "/dev/sda1"];
1479        ["pvcreate"; "/dev/sda2"];
1480        ["pvcreate"; "/dev/sda3"];
1481        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1482        ["vgcreate"; "VG2"; "/dev/sda3"];
1483        ["lvcreate"; "LV1"; "VG1"; "50"];
1484        ["lvcreate"; "LV2"; "VG1"; "50"];
1485        ["lvcreate"; "LV3"; "VG2"; "50"];
1486        ["lvcreate"; "LV4"; "VG2"; "50"];
1487        ["lvcreate"; "LV5"; "VG2"; "50"];
1488        ["lvs"]],
1489       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1490        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1491    "create an LVM logical volume",
1492    "\
1493 This creates an LVM logical volume called C<logvol>
1494 on the volume group C<volgroup>, with C<size> megabytes.");
1495
1496   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1497    [InitEmpty, Always, TestOutput (
1498       [["part_disk"; "/dev/sda"; "mbr"];
1499        ["mkfs"; "ext2"; "/dev/sda1"];
1500        ["mount_options"; ""; "/dev/sda1"; "/"];
1501        ["write_file"; "/new"; "new file contents"; "0"];
1502        ["cat"; "/new"]], "new file contents")],
1503    "make a filesystem",
1504    "\
1505 This creates a filesystem on C<device> (usually a partition
1506 or LVM logical volume).  The filesystem type is C<fstype>, for
1507 example C<ext3>.");
1508
1509   ("sfdisk", (RErr, [Device "device";
1510                      Int "cyls"; Int "heads"; Int "sectors";
1511                      StringList "lines"]), 43, [DangerWillRobinson],
1512    [],
1513    "create partitions on a block device",
1514    "\
1515 This is a direct interface to the L<sfdisk(8)> program for creating
1516 partitions on block devices.
1517
1518 C<device> should be a block device, for example C</dev/sda>.
1519
1520 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1521 and sectors on the device, which are passed directly to sfdisk as
1522 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1523 of these, then the corresponding parameter is omitted.  Usually for
1524 'large' disks, you can just pass C<0> for these, but for small
1525 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1526 out the right geometry and you will need to tell it.
1527
1528 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1529 information refer to the L<sfdisk(8)> manpage.
1530
1531 To create a single partition occupying the whole disk, you would
1532 pass C<lines> as a single element list, when the single element being
1533 the string C<,> (comma).
1534
1535 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1536 C<guestfs_part_init>");
1537
1538   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1539    [InitBasicFS, Always, TestOutput (
1540       [["write_file"; "/new"; "new file contents"; "0"];
1541        ["cat"; "/new"]], "new file contents");
1542     InitBasicFS, Always, TestOutput (
1543       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1544        ["cat"; "/new"]], "\nnew file contents\n");
1545     InitBasicFS, Always, TestOutput (
1546       [["write_file"; "/new"; "\n\n"; "0"];
1547        ["cat"; "/new"]], "\n\n");
1548     InitBasicFS, Always, TestOutput (
1549       [["write_file"; "/new"; ""; "0"];
1550        ["cat"; "/new"]], "");
1551     InitBasicFS, Always, TestOutput (
1552       [["write_file"; "/new"; "\n\n\n"; "0"];
1553        ["cat"; "/new"]], "\n\n\n");
1554     InitBasicFS, Always, TestOutput (
1555       [["write_file"; "/new"; "\n"; "0"];
1556        ["cat"; "/new"]], "\n");
1557     (* Regression test for RHBZ#597135. *)
1558     InitBasicFS, Always, TestLastFail
1559       [["write_file"; "/new"; "abc"; "10000"]]],
1560    "create a file",
1561    "\
1562 This call creates a file called C<path>.  The contents of the
1563 file is the string C<content> (which can contain any 8 bit data),
1564 with length C<size>.
1565
1566 As a special case, if C<size> is C<0>
1567 then the length is calculated using C<strlen> (so in this case
1568 the content cannot contain embedded ASCII NULs).
1569
1570 I<NB.> Owing to a bug, writing content containing ASCII NUL
1571 characters does I<not> work, even if the length is specified.
1572 We hope to resolve this bug in a future version.  In the meantime
1573 use C<guestfs_upload>.");
1574
1575   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1576    [InitEmpty, Always, TestOutputListOfDevices (
1577       [["part_disk"; "/dev/sda"; "mbr"];
1578        ["mkfs"; "ext2"; "/dev/sda1"];
1579        ["mount_options"; ""; "/dev/sda1"; "/"];
1580        ["mounts"]], ["/dev/sda1"]);
1581     InitEmpty, Always, TestOutputList (
1582       [["part_disk"; "/dev/sda"; "mbr"];
1583        ["mkfs"; "ext2"; "/dev/sda1"];
1584        ["mount_options"; ""; "/dev/sda1"; "/"];
1585        ["umount"; "/"];
1586        ["mounts"]], [])],
1587    "unmount a filesystem",
1588    "\
1589 This unmounts the given filesystem.  The filesystem may be
1590 specified either by its mountpoint (path) or the device which
1591 contains the filesystem.");
1592
1593   ("mounts", (RStringList "devices", []), 46, [],
1594    [InitBasicFS, Always, TestOutputListOfDevices (
1595       [["mounts"]], ["/dev/sda1"])],
1596    "show mounted filesystems",
1597    "\
1598 This returns the list of currently mounted filesystems.  It returns
1599 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1600
1601 Some internal mounts are not shown.
1602
1603 See also: C<guestfs_mountpoints>");
1604
1605   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1606    [InitBasicFS, Always, TestOutputList (
1607       [["umount_all"];
1608        ["mounts"]], []);
1609     (* check that umount_all can unmount nested mounts correctly: *)
1610     InitEmpty, Always, TestOutputList (
1611       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1612        ["mkfs"; "ext2"; "/dev/sda1"];
1613        ["mkfs"; "ext2"; "/dev/sda2"];
1614        ["mkfs"; "ext2"; "/dev/sda3"];
1615        ["mount_options"; ""; "/dev/sda1"; "/"];
1616        ["mkdir"; "/mp1"];
1617        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1618        ["mkdir"; "/mp1/mp2"];
1619        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1620        ["mkdir"; "/mp1/mp2/mp3"];
1621        ["umount_all"];
1622        ["mounts"]], [])],
1623    "unmount all filesystems",
1624    "\
1625 This unmounts all mounted filesystems.
1626
1627 Some internal mounts are not unmounted by this call.");
1628
1629   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1630    [],
1631    "remove all LVM LVs, VGs and PVs",
1632    "\
1633 This command removes all LVM logical volumes, volume groups
1634 and physical volumes.");
1635
1636   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1637    [InitISOFS, Always, TestOutput (
1638       [["file"; "/empty"]], "empty");
1639     InitISOFS, Always, TestOutput (
1640       [["file"; "/known-1"]], "ASCII text");
1641     InitISOFS, Always, TestLastFail (
1642       [["file"; "/notexists"]])],
1643    "determine file type",
1644    "\
1645 This call uses the standard L<file(1)> command to determine
1646 the type or contents of the file.  This also works on devices,
1647 for example to find out whether a partition contains a filesystem.
1648
1649 This call will also transparently look inside various types
1650 of compressed file.
1651
1652 The exact command which runs is C<file -zbsL path>.  Note in
1653 particular that the filename is not prepended to the output
1654 (the C<-b> option).");
1655
1656   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1657    [InitBasicFS, Always, TestOutput (
1658       [["upload"; "test-command"; "/test-command"];
1659        ["chmod"; "0o755"; "/test-command"];
1660        ["command"; "/test-command 1"]], "Result1");
1661     InitBasicFS, Always, TestOutput (
1662       [["upload"; "test-command"; "/test-command"];
1663        ["chmod"; "0o755"; "/test-command"];
1664        ["command"; "/test-command 2"]], "Result2\n");
1665     InitBasicFS, Always, TestOutput (
1666       [["upload"; "test-command"; "/test-command"];
1667        ["chmod"; "0o755"; "/test-command"];
1668        ["command"; "/test-command 3"]], "\nResult3");
1669     InitBasicFS, Always, TestOutput (
1670       [["upload"; "test-command"; "/test-command"];
1671        ["chmod"; "0o755"; "/test-command"];
1672        ["command"; "/test-command 4"]], "\nResult4\n");
1673     InitBasicFS, Always, TestOutput (
1674       [["upload"; "test-command"; "/test-command"];
1675        ["chmod"; "0o755"; "/test-command"];
1676        ["command"; "/test-command 5"]], "\nResult5\n\n");
1677     InitBasicFS, Always, TestOutput (
1678       [["upload"; "test-command"; "/test-command"];
1679        ["chmod"; "0o755"; "/test-command"];
1680        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1681     InitBasicFS, Always, TestOutput (
1682       [["upload"; "test-command"; "/test-command"];
1683        ["chmod"; "0o755"; "/test-command"];
1684        ["command"; "/test-command 7"]], "");
1685     InitBasicFS, Always, TestOutput (
1686       [["upload"; "test-command"; "/test-command"];
1687        ["chmod"; "0o755"; "/test-command"];
1688        ["command"; "/test-command 8"]], "\n");
1689     InitBasicFS, Always, TestOutput (
1690       [["upload"; "test-command"; "/test-command"];
1691        ["chmod"; "0o755"; "/test-command"];
1692        ["command"; "/test-command 9"]], "\n\n");
1693     InitBasicFS, Always, TestOutput (
1694       [["upload"; "test-command"; "/test-command"];
1695        ["chmod"; "0o755"; "/test-command"];
1696        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1697     InitBasicFS, Always, TestOutput (
1698       [["upload"; "test-command"; "/test-command"];
1699        ["chmod"; "0o755"; "/test-command"];
1700        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1701     InitBasicFS, Always, TestLastFail (
1702       [["upload"; "test-command"; "/test-command"];
1703        ["chmod"; "0o755"; "/test-command"];
1704        ["command"; "/test-command"]])],
1705    "run a command from the guest filesystem",
1706    "\
1707 This call runs a command from the guest filesystem.  The
1708 filesystem must be mounted, and must contain a compatible
1709 operating system (ie. something Linux, with the same
1710 or compatible processor architecture).
1711
1712 The single parameter is an argv-style list of arguments.
1713 The first element is the name of the program to run.
1714 Subsequent elements are parameters.  The list must be
1715 non-empty (ie. must contain a program name).  Note that
1716 the command runs directly, and is I<not> invoked via
1717 the shell (see C<guestfs_sh>).
1718
1719 The return value is anything printed to I<stdout> by
1720 the command.
1721
1722 If the command returns a non-zero exit status, then
1723 this function returns an error message.  The error message
1724 string is the content of I<stderr> from the command.
1725
1726 The C<$PATH> environment variable will contain at least
1727 C</usr/bin> and C</bin>.  If you require a program from
1728 another location, you should provide the full path in the
1729 first parameter.
1730
1731 Shared libraries and data files required by the program
1732 must be available on filesystems which are mounted in the
1733 correct places.  It is the caller's responsibility to ensure
1734 all filesystems that are needed are mounted at the right
1735 locations.");
1736
1737   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1738    [InitBasicFS, Always, TestOutputList (
1739       [["upload"; "test-command"; "/test-command"];
1740        ["chmod"; "0o755"; "/test-command"];
1741        ["command_lines"; "/test-command 1"]], ["Result1"]);
1742     InitBasicFS, Always, TestOutputList (
1743       [["upload"; "test-command"; "/test-command"];
1744        ["chmod"; "0o755"; "/test-command"];
1745        ["command_lines"; "/test-command 2"]], ["Result2"]);
1746     InitBasicFS, Always, TestOutputList (
1747       [["upload"; "test-command"; "/test-command"];
1748        ["chmod"; "0o755"; "/test-command"];
1749        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1750     InitBasicFS, Always, TestOutputList (
1751       [["upload"; "test-command"; "/test-command"];
1752        ["chmod"; "0o755"; "/test-command"];
1753        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1754     InitBasicFS, Always, TestOutputList (
1755       [["upload"; "test-command"; "/test-command"];
1756        ["chmod"; "0o755"; "/test-command"];
1757        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1758     InitBasicFS, Always, TestOutputList (
1759       [["upload"; "test-command"; "/test-command"];
1760        ["chmod"; "0o755"; "/test-command"];
1761        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1762     InitBasicFS, Always, TestOutputList (
1763       [["upload"; "test-command"; "/test-command"];
1764        ["chmod"; "0o755"; "/test-command"];
1765        ["command_lines"; "/test-command 7"]], []);
1766     InitBasicFS, Always, TestOutputList (
1767       [["upload"; "test-command"; "/test-command"];
1768        ["chmod"; "0o755"; "/test-command"];
1769        ["command_lines"; "/test-command 8"]], [""]);
1770     InitBasicFS, Always, TestOutputList (
1771       [["upload"; "test-command"; "/test-command"];
1772        ["chmod"; "0o755"; "/test-command"];
1773        ["command_lines"; "/test-command 9"]], ["";""]);
1774     InitBasicFS, Always, TestOutputList (
1775       [["upload"; "test-command"; "/test-command"];
1776        ["chmod"; "0o755"; "/test-command"];
1777        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1778     InitBasicFS, Always, TestOutputList (
1779       [["upload"; "test-command"; "/test-command"];
1780        ["chmod"; "0o755"; "/test-command"];
1781        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1782    "run a command, returning lines",
1783    "\
1784 This is the same as C<guestfs_command>, but splits the
1785 result into a list of lines.
1786
1787 See also: C<guestfs_sh_lines>");
1788
1789   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1790    [InitISOFS, Always, TestOutputStruct (
1791       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1792    "get file information",
1793    "\
1794 Returns file information for the given C<path>.
1795
1796 This is the same as the C<stat(2)> system call.");
1797
1798   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1799    [InitISOFS, Always, TestOutputStruct (
1800       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1801    "get file information for a symbolic link",
1802    "\
1803 Returns file information for the given C<path>.
1804
1805 This is the same as C<guestfs_stat> except that if C<path>
1806 is a symbolic link, then the link is stat-ed, not the file it
1807 refers to.
1808
1809 This is the same as the C<lstat(2)> system call.");
1810
1811   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1812    [InitISOFS, Always, TestOutputStruct (
1813       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1814    "get file system statistics",
1815    "\
1816 Returns file system statistics for any mounted file system.
1817 C<path> should be a file or directory in the mounted file system
1818 (typically it is the mount point itself, but it doesn't need to be).
1819
1820 This is the same as the C<statvfs(2)> system call.");
1821
1822   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1823    [], (* XXX test *)
1824    "get ext2/ext3/ext4 superblock details",
1825    "\
1826 This returns the contents of the ext2, ext3 or ext4 filesystem
1827 superblock on C<device>.
1828
1829 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1830 manpage for more details.  The list of fields returned isn't
1831 clearly defined, and depends on both the version of C<tune2fs>
1832 that libguestfs was built against, and the filesystem itself.");
1833
1834   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1835    [InitEmpty, Always, TestOutputTrue (
1836       [["blockdev_setro"; "/dev/sda"];
1837        ["blockdev_getro"; "/dev/sda"]])],
1838    "set block device to read-only",
1839    "\
1840 Sets the block device named C<device> to read-only.
1841
1842 This uses the L<blockdev(8)> command.");
1843
1844   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1845    [InitEmpty, Always, TestOutputFalse (
1846       [["blockdev_setrw"; "/dev/sda"];
1847        ["blockdev_getro"; "/dev/sda"]])],
1848    "set block device to read-write",
1849    "\
1850 Sets the block device named C<device> to read-write.
1851
1852 This uses the L<blockdev(8)> command.");
1853
1854   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1855    [InitEmpty, Always, TestOutputTrue (
1856       [["blockdev_setro"; "/dev/sda"];
1857        ["blockdev_getro"; "/dev/sda"]])],
1858    "is block device set to read-only",
1859    "\
1860 Returns a boolean indicating if the block device is read-only
1861 (true if read-only, false if not).
1862
1863 This uses the L<blockdev(8)> command.");
1864
1865   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1866    [InitEmpty, Always, TestOutputInt (
1867       [["blockdev_getss"; "/dev/sda"]], 512)],
1868    "get sectorsize of block device",
1869    "\
1870 This returns the size of sectors on a block device.
1871 Usually 512, but can be larger for modern devices.
1872
1873 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1874 for that).
1875
1876 This uses the L<blockdev(8)> command.");
1877
1878   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1879    [InitEmpty, Always, TestOutputInt (
1880       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1881    "get blocksize of block device",
1882    "\
1883 This returns the block size of a device.
1884
1885 (Note this is different from both I<size in blocks> and
1886 I<filesystem block size>).
1887
1888 This uses the L<blockdev(8)> command.");
1889
1890   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1891    [], (* XXX test *)
1892    "set blocksize of block device",
1893    "\
1894 This sets the block size of a device.
1895
1896 (Note this is different from both I<size in blocks> and
1897 I<filesystem block size>).
1898
1899 This uses the L<blockdev(8)> command.");
1900
1901   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1902    [InitEmpty, Always, TestOutputInt (
1903       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1904    "get total size of device in 512-byte sectors",
1905    "\
1906 This returns the size of the device in units of 512-byte sectors
1907 (even if the sectorsize isn't 512 bytes ... weird).
1908
1909 See also C<guestfs_blockdev_getss> for the real sector size of
1910 the device, and C<guestfs_blockdev_getsize64> for the more
1911 useful I<size in bytes>.
1912
1913 This uses the L<blockdev(8)> command.");
1914
1915   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1916    [InitEmpty, Always, TestOutputInt (
1917       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1918    "get total size of device in bytes",
1919    "\
1920 This returns the size of the device in bytes.
1921
1922 See also C<guestfs_blockdev_getsz>.
1923
1924 This uses the L<blockdev(8)> command.");
1925
1926   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1927    [InitEmpty, Always, TestRun
1928       [["blockdev_flushbufs"; "/dev/sda"]]],
1929    "flush device buffers",
1930    "\
1931 This tells the kernel to flush internal buffers associated
1932 with C<device>.
1933
1934 This uses the L<blockdev(8)> command.");
1935
1936   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1937    [InitEmpty, Always, TestRun
1938       [["blockdev_rereadpt"; "/dev/sda"]]],
1939    "reread partition table",
1940    "\
1941 Reread the partition table on C<device>.
1942
1943 This uses the L<blockdev(8)> command.");
1944
1945   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1946    [InitBasicFS, Always, TestOutput (
1947       (* Pick a file from cwd which isn't likely to change. *)
1948       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1949        ["checksum"; "md5"; "/COPYING.LIB"]],
1950       Digest.to_hex (Digest.file "COPYING.LIB"))],
1951    "upload a file from the local machine",
1952    "\
1953 Upload local file C<filename> to C<remotefilename> on the
1954 filesystem.
1955
1956 C<filename> can also be a named pipe.
1957
1958 See also C<guestfs_download>.");
1959
1960   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1961    [InitBasicFS, Always, TestOutput (
1962       (* Pick a file from cwd which isn't likely to change. *)
1963       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1964        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1965        ["upload"; "testdownload.tmp"; "/upload"];
1966        ["checksum"; "md5"; "/upload"]],
1967       Digest.to_hex (Digest.file "COPYING.LIB"))],
1968    "download a file to the local machine",
1969    "\
1970 Download file C<remotefilename> and save it as C<filename>
1971 on the local machine.
1972
1973 C<filename> can also be a named pipe.
1974
1975 See also C<guestfs_upload>, C<guestfs_cat>.");
1976
1977   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1978    [InitISOFS, Always, TestOutput (
1979       [["checksum"; "crc"; "/known-3"]], "2891671662");
1980     InitISOFS, Always, TestLastFail (
1981       [["checksum"; "crc"; "/notexists"]]);
1982     InitISOFS, Always, TestOutput (
1983       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1984     InitISOFS, Always, TestOutput (
1985       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1986     InitISOFS, Always, TestOutput (
1987       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1988     InitISOFS, Always, TestOutput (
1989       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1990     InitISOFS, Always, TestOutput (
1991       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1992     InitISOFS, Always, TestOutput (
1993       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1994    "compute MD5, SHAx or CRC checksum of file",
1995    "\
1996 This call computes the MD5, SHAx or CRC checksum of the
1997 file named C<path>.
1998
1999 The type of checksum to compute is given by the C<csumtype>
2000 parameter which must have one of the following values:
2001
2002 =over 4
2003
2004 =item C<crc>
2005
2006 Compute the cyclic redundancy check (CRC) specified by POSIX
2007 for the C<cksum> command.
2008
2009 =item C<md5>
2010
2011 Compute the MD5 hash (using the C<md5sum> program).
2012
2013 =item C<sha1>
2014
2015 Compute the SHA1 hash (using the C<sha1sum> program).
2016
2017 =item C<sha224>
2018
2019 Compute the SHA224 hash (using the C<sha224sum> program).
2020
2021 =item C<sha256>
2022
2023 Compute the SHA256 hash (using the C<sha256sum> program).
2024
2025 =item C<sha384>
2026
2027 Compute the SHA384 hash (using the C<sha384sum> program).
2028
2029 =item C<sha512>
2030
2031 Compute the SHA512 hash (using the C<sha512sum> program).
2032
2033 =back
2034
2035 The checksum is returned as a printable string.");
2036
2037   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2038    [InitBasicFS, Always, TestOutput (
2039       [["tar_in"; "../images/helloworld.tar"; "/"];
2040        ["cat"; "/hello"]], "hello\n")],
2041    "unpack tarfile to directory",
2042    "\
2043 This command uploads and unpacks local file C<tarfile> (an
2044 I<uncompressed> tar file) into C<directory>.
2045
2046 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2047
2048   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2049    [],
2050    "pack directory into tarfile",
2051    "\
2052 This command packs the contents of C<directory> and downloads
2053 it to local file C<tarfile>.
2054
2055 To download a compressed tarball, use C<guestfs_tgz_out>.");
2056
2057   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2058    [InitBasicFS, Always, TestOutput (
2059       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2060        ["cat"; "/hello"]], "hello\n")],
2061    "unpack compressed tarball to directory",
2062    "\
2063 This command uploads and unpacks local file C<tarball> (a
2064 I<gzip compressed> tar file) into C<directory>.
2065
2066 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2067
2068   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2069    [],
2070    "pack directory into compressed tarball",
2071    "\
2072 This command packs the contents of C<directory> and downloads
2073 it to local file C<tarball>.
2074
2075 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2076
2077   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2078    [InitBasicFS, Always, TestLastFail (
2079       [["umount"; "/"];
2080        ["mount_ro"; "/dev/sda1"; "/"];
2081        ["touch"; "/new"]]);
2082     InitBasicFS, Always, TestOutput (
2083       [["write_file"; "/new"; "data"; "0"];
2084        ["umount"; "/"];
2085        ["mount_ro"; "/dev/sda1"; "/"];
2086        ["cat"; "/new"]], "data")],
2087    "mount a guest disk, read-only",
2088    "\
2089 This is the same as the C<guestfs_mount> command, but it
2090 mounts the filesystem with the read-only (I<-o ro>) flag.");
2091
2092   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2093    [],
2094    "mount a guest disk with mount options",
2095    "\
2096 This is the same as the C<guestfs_mount> command, but it
2097 allows you to set the mount options as for the
2098 L<mount(8)> I<-o> flag.
2099
2100 If the C<options> parameter is an empty string, then
2101 no options are passed (all options default to whatever
2102 the filesystem uses).");
2103
2104   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2105    [],
2106    "mount a guest disk with mount options and vfstype",
2107    "\
2108 This is the same as the C<guestfs_mount> command, but it
2109 allows you to set both the mount options and the vfstype
2110 as for the L<mount(8)> I<-o> and I<-t> flags.");
2111
2112   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2113    [],
2114    "debugging and internals",
2115    "\
2116 The C<guestfs_debug> command exposes some internals of
2117 C<guestfsd> (the guestfs daemon) that runs inside the
2118 qemu subprocess.
2119
2120 There is no comprehensive help for this command.  You have
2121 to look at the file C<daemon/debug.c> in the libguestfs source
2122 to find out what you can do.");
2123
2124   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2125    [InitEmpty, Always, TestOutputList (
2126       [["part_disk"; "/dev/sda"; "mbr"];
2127        ["pvcreate"; "/dev/sda1"];
2128        ["vgcreate"; "VG"; "/dev/sda1"];
2129        ["lvcreate"; "LV1"; "VG"; "50"];
2130        ["lvcreate"; "LV2"; "VG"; "50"];
2131        ["lvremove"; "/dev/VG/LV1"];
2132        ["lvs"]], ["/dev/VG/LV2"]);
2133     InitEmpty, Always, TestOutputList (
2134       [["part_disk"; "/dev/sda"; "mbr"];
2135        ["pvcreate"; "/dev/sda1"];
2136        ["vgcreate"; "VG"; "/dev/sda1"];
2137        ["lvcreate"; "LV1"; "VG"; "50"];
2138        ["lvcreate"; "LV2"; "VG"; "50"];
2139        ["lvremove"; "/dev/VG"];
2140        ["lvs"]], []);
2141     InitEmpty, Always, TestOutputList (
2142       [["part_disk"; "/dev/sda"; "mbr"];
2143        ["pvcreate"; "/dev/sda1"];
2144        ["vgcreate"; "VG"; "/dev/sda1"];
2145        ["lvcreate"; "LV1"; "VG"; "50"];
2146        ["lvcreate"; "LV2"; "VG"; "50"];
2147        ["lvremove"; "/dev/VG"];
2148        ["vgs"]], ["VG"])],
2149    "remove an LVM logical volume",
2150    "\
2151 Remove an LVM logical volume C<device>, where C<device> is
2152 the path to the LV, such as C</dev/VG/LV>.
2153
2154 You can also remove all LVs in a volume group by specifying
2155 the VG name, C</dev/VG>.");
2156
2157   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2158    [InitEmpty, Always, TestOutputList (
2159       [["part_disk"; "/dev/sda"; "mbr"];
2160        ["pvcreate"; "/dev/sda1"];
2161        ["vgcreate"; "VG"; "/dev/sda1"];
2162        ["lvcreate"; "LV1"; "VG"; "50"];
2163        ["lvcreate"; "LV2"; "VG"; "50"];
2164        ["vgremove"; "VG"];
2165        ["lvs"]], []);
2166     InitEmpty, Always, TestOutputList (
2167       [["part_disk"; "/dev/sda"; "mbr"];
2168        ["pvcreate"; "/dev/sda1"];
2169        ["vgcreate"; "VG"; "/dev/sda1"];
2170        ["lvcreate"; "LV1"; "VG"; "50"];
2171        ["lvcreate"; "LV2"; "VG"; "50"];
2172        ["vgremove"; "VG"];
2173        ["vgs"]], [])],
2174    "remove an LVM volume group",
2175    "\
2176 Remove an LVM volume group C<vgname>, (for example C<VG>).
2177
2178 This also forcibly removes all logical volumes in the volume
2179 group (if any).");
2180
2181   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2182    [InitEmpty, Always, TestOutputListOfDevices (
2183       [["part_disk"; "/dev/sda"; "mbr"];
2184        ["pvcreate"; "/dev/sda1"];
2185        ["vgcreate"; "VG"; "/dev/sda1"];
2186        ["lvcreate"; "LV1"; "VG"; "50"];
2187        ["lvcreate"; "LV2"; "VG"; "50"];
2188        ["vgremove"; "VG"];
2189        ["pvremove"; "/dev/sda1"];
2190        ["lvs"]], []);
2191     InitEmpty, Always, TestOutputListOfDevices (
2192       [["part_disk"; "/dev/sda"; "mbr"];
2193        ["pvcreate"; "/dev/sda1"];
2194        ["vgcreate"; "VG"; "/dev/sda1"];
2195        ["lvcreate"; "LV1"; "VG"; "50"];
2196        ["lvcreate"; "LV2"; "VG"; "50"];
2197        ["vgremove"; "VG"];
2198        ["pvremove"; "/dev/sda1"];
2199        ["vgs"]], []);
2200     InitEmpty, Always, TestOutputListOfDevices (
2201       [["part_disk"; "/dev/sda"; "mbr"];
2202        ["pvcreate"; "/dev/sda1"];
2203        ["vgcreate"; "VG"; "/dev/sda1"];
2204        ["lvcreate"; "LV1"; "VG"; "50"];
2205        ["lvcreate"; "LV2"; "VG"; "50"];
2206        ["vgremove"; "VG"];
2207        ["pvremove"; "/dev/sda1"];
2208        ["pvs"]], [])],
2209    "remove an LVM physical volume",
2210    "\
2211 This wipes a physical volume C<device> so that LVM will no longer
2212 recognise it.
2213
2214 The implementation uses the C<pvremove> command which refuses to
2215 wipe physical volumes that contain any volume groups, so you have
2216 to remove those first.");
2217
2218   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2219    [InitBasicFS, Always, TestOutput (
2220       [["set_e2label"; "/dev/sda1"; "testlabel"];
2221        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2222    "set the ext2/3/4 filesystem label",
2223    "\
2224 This sets the ext2/3/4 filesystem label of the filesystem on
2225 C<device> to C<label>.  Filesystem labels are limited to
2226 16 characters.
2227
2228 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2229 to return the existing label on a filesystem.");
2230
2231   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2232    [],
2233    "get the ext2/3/4 filesystem label",
2234    "\
2235 This returns the ext2/3/4 filesystem label of the filesystem on
2236 C<device>.");
2237
2238   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2239    (let uuid = uuidgen () in
2240     [InitBasicFS, Always, TestOutput (
2241        [["set_e2uuid"; "/dev/sda1"; uuid];
2242         ["get_e2uuid"; "/dev/sda1"]], uuid);
2243      InitBasicFS, Always, TestOutput (
2244        [["set_e2uuid"; "/dev/sda1"; "clear"];
2245         ["get_e2uuid"; "/dev/sda1"]], "");
2246      (* We can't predict what UUIDs will be, so just check the commands run. *)
2247      InitBasicFS, Always, TestRun (
2248        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2249      InitBasicFS, Always, TestRun (
2250        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2251    "set the ext2/3/4 filesystem UUID",
2252    "\
2253 This sets the ext2/3/4 filesystem UUID of the filesystem on
2254 C<device> to C<uuid>.  The format of the UUID and alternatives
2255 such as C<clear>, C<random> and C<time> are described in the
2256 L<tune2fs(8)> manpage.
2257
2258 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2259 to return the existing UUID of a filesystem.");
2260
2261   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2262    [],
2263    "get the ext2/3/4 filesystem UUID",
2264    "\
2265 This returns the ext2/3/4 filesystem UUID of the filesystem on
2266 C<device>.");
2267
2268   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2269    [InitBasicFS, Always, TestOutputInt (
2270       [["umount"; "/dev/sda1"];
2271        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2272     InitBasicFS, Always, TestOutputInt (
2273       [["umount"; "/dev/sda1"];
2274        ["zero"; "/dev/sda1"];
2275        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2276    "run the filesystem checker",
2277    "\
2278 This runs the filesystem checker (fsck) on C<device> which
2279 should have filesystem type C<fstype>.
2280
2281 The returned integer is the status.  See L<fsck(8)> for the
2282 list of status codes from C<fsck>.
2283
2284 Notes:
2285
2286 =over 4
2287
2288 =item *
2289
2290 Multiple status codes can be summed together.
2291
2292 =item *
2293
2294 A non-zero return code can mean \"success\", for example if
2295 errors have been corrected on the filesystem.
2296
2297 =item *
2298
2299 Checking or repairing NTFS volumes is not supported
2300 (by linux-ntfs).
2301
2302 =back
2303
2304 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2305
2306   ("zero", (RErr, [Device "device"]), 85, [],
2307    [InitBasicFS, Always, TestOutput (
2308       [["umount"; "/dev/sda1"];
2309        ["zero"; "/dev/sda1"];
2310        ["file"; "/dev/sda1"]], "data")],
2311    "write zeroes to the device",
2312    "\
2313 This command writes zeroes over the first few blocks of C<device>.
2314
2315 How many blocks are zeroed isn't specified (but it's I<not> enough
2316 to securely wipe the device).  It should be sufficient to remove
2317 any partition tables, filesystem superblocks and so on.
2318
2319 See also: C<guestfs_scrub_device>.");
2320
2321   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2322    (* Test disabled because grub-install incompatible with virtio-blk driver.
2323     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2324     *)
2325    [InitBasicFS, Disabled, TestOutputTrue (
2326       [["grub_install"; "/"; "/dev/sda1"];
2327        ["is_dir"; "/boot"]])],
2328    "install GRUB",
2329    "\
2330 This command installs GRUB (the Grand Unified Bootloader) on
2331 C<device>, with the root directory being C<root>.
2332
2333 Note: If grub-install reports the error
2334 \"No suitable drive was found in the generated device map.\"
2335 it may be that you need to create a C</boot/grub/device.map>
2336 file first that contains the mapping between grub device names
2337 and Linux device names.  It is usually sufficient to create
2338 a file containing:
2339
2340  (hd0) /dev/vda
2341
2342 replacing C</dev/vda> with the name of the installation device.");
2343
2344   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2345    [InitBasicFS, Always, TestOutput (
2346       [["write_file"; "/old"; "file content"; "0"];
2347        ["cp"; "/old"; "/new"];
2348        ["cat"; "/new"]], "file content");
2349     InitBasicFS, Always, TestOutputTrue (
2350       [["write_file"; "/old"; "file content"; "0"];
2351        ["cp"; "/old"; "/new"];
2352        ["is_file"; "/old"]]);
2353     InitBasicFS, Always, TestOutput (
2354       [["write_file"; "/old"; "file content"; "0"];
2355        ["mkdir"; "/dir"];
2356        ["cp"; "/old"; "/dir/new"];
2357        ["cat"; "/dir/new"]], "file content")],
2358    "copy a file",
2359    "\
2360 This copies a file from C<src> to C<dest> where C<dest> is
2361 either a destination filename or destination directory.");
2362
2363   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2364    [InitBasicFS, Always, TestOutput (
2365       [["mkdir"; "/olddir"];
2366        ["mkdir"; "/newdir"];
2367        ["write_file"; "/olddir/file"; "file content"; "0"];
2368        ["cp_a"; "/olddir"; "/newdir"];
2369        ["cat"; "/newdir/olddir/file"]], "file content")],
2370    "copy a file or directory recursively",
2371    "\
2372 This copies a file or directory from C<src> to C<dest>
2373 recursively using the C<cp -a> command.");
2374
2375   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2376    [InitBasicFS, Always, TestOutput (
2377       [["write_file"; "/old"; "file content"; "0"];
2378        ["mv"; "/old"; "/new"];
2379        ["cat"; "/new"]], "file content");
2380     InitBasicFS, Always, TestOutputFalse (
2381       [["write_file"; "/old"; "file content"; "0"];
2382        ["mv"; "/old"; "/new"];
2383        ["is_file"; "/old"]])],
2384    "move a file",
2385    "\
2386 This moves a file from C<src> to C<dest> where C<dest> is
2387 either a destination filename or destination directory.");
2388
2389   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2390    [InitEmpty, Always, TestRun (
2391       [["drop_caches"; "3"]])],
2392    "drop kernel page cache, dentries and inodes",
2393    "\
2394 This instructs the guest kernel to drop its page cache,
2395 and/or dentries and inode caches.  The parameter C<whattodrop>
2396 tells the kernel what precisely to drop, see
2397 L<http://linux-mm.org/Drop_Caches>
2398
2399 Setting C<whattodrop> to 3 should drop everything.
2400
2401 This automatically calls L<sync(2)> before the operation,
2402 so that the maximum guest memory is freed.");
2403
2404   ("dmesg", (RString "kmsgs", []), 91, [],
2405    [InitEmpty, Always, TestRun (
2406       [["dmesg"]])],
2407    "return kernel messages",
2408    "\
2409 This returns the kernel messages (C<dmesg> output) from
2410 the guest kernel.  This is sometimes useful for extended
2411 debugging of problems.
2412
2413 Another way to get the same information is to enable
2414 verbose messages with C<guestfs_set_verbose> or by setting
2415 the environment variable C<LIBGUESTFS_DEBUG=1> before
2416 running the program.");
2417
2418   ("ping_daemon", (RErr, []), 92, [],
2419    [InitEmpty, Always, TestRun (
2420       [["ping_daemon"]])],
2421    "ping the guest daemon",
2422    "\
2423 This is a test probe into the guestfs daemon running inside
2424 the qemu subprocess.  Calling this function checks that the
2425 daemon responds to the ping message, without affecting the daemon
2426 or attached block device(s) in any other way.");
2427
2428   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2429    [InitBasicFS, Always, TestOutputTrue (
2430       [["write_file"; "/file1"; "contents of a file"; "0"];
2431        ["cp"; "/file1"; "/file2"];
2432        ["equal"; "/file1"; "/file2"]]);
2433     InitBasicFS, Always, TestOutputFalse (
2434       [["write_file"; "/file1"; "contents of a file"; "0"];
2435        ["write_file"; "/file2"; "contents of another file"; "0"];
2436        ["equal"; "/file1"; "/file2"]]);
2437     InitBasicFS, Always, TestLastFail (
2438       [["equal"; "/file1"; "/file2"]])],
2439    "test if two files have equal contents",
2440    "\
2441 This compares the two files C<file1> and C<file2> and returns
2442 true if their content is exactly equal, or false otherwise.
2443
2444 The external L<cmp(1)> program is used for the comparison.");
2445
2446   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2447    [InitISOFS, Always, TestOutputList (
2448       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2449     InitISOFS, Always, TestOutputList (
2450       [["strings"; "/empty"]], [])],
2451    "print the printable strings in a file",
2452    "\
2453 This runs the L<strings(1)> command on a file and returns
2454 the list of printable strings found.");
2455
2456   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2457    [InitISOFS, Always, TestOutputList (
2458       [["strings_e"; "b"; "/known-5"]], []);
2459     InitBasicFS, Disabled, TestOutputList (
2460       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2461        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2462    "print the printable strings in a file",
2463    "\
2464 This is like the C<guestfs_strings> command, but allows you to
2465 specify the encoding of strings that are looked for in
2466 the source file C<path>.
2467
2468 Allowed encodings are:
2469
2470 =over 4
2471
2472 =item s
2473
2474 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2475 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2476
2477 =item S
2478
2479 Single 8-bit-byte characters.
2480
2481 =item b
2482
2483 16-bit big endian strings such as those encoded in
2484 UTF-16BE or UCS-2BE.
2485
2486 =item l (lower case letter L)
2487
2488 16-bit little endian such as UTF-16LE and UCS-2LE.
2489 This is useful for examining binaries in Windows guests.
2490
2491 =item B
2492
2493 32-bit big endian such as UCS-4BE.
2494
2495 =item L
2496
2497 32-bit little endian such as UCS-4LE.
2498
2499 =back
2500
2501 The returned strings are transcoded to UTF-8.");
2502
2503   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2504    [InitISOFS, Always, TestOutput (
2505       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2506     (* Test for RHBZ#501888c2 regression which caused large hexdump
2507      * commands to segfault.
2508      *)
2509     InitISOFS, Always, TestRun (
2510       [["hexdump"; "/100krandom"]])],
2511    "dump a file in hexadecimal",
2512    "\
2513 This runs C<hexdump -C> on the given C<path>.  The result is
2514 the human-readable, canonical hex dump of the file.");
2515
2516   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2517    [InitNone, Always, TestOutput (
2518       [["part_disk"; "/dev/sda"; "mbr"];
2519        ["mkfs"; "ext3"; "/dev/sda1"];
2520        ["mount_options"; ""; "/dev/sda1"; "/"];
2521        ["write_file"; "/new"; "test file"; "0"];
2522        ["umount"; "/dev/sda1"];
2523        ["zerofree"; "/dev/sda1"];
2524        ["mount_options"; ""; "/dev/sda1"; "/"];
2525        ["cat"; "/new"]], "test file")],
2526    "zero unused inodes and disk blocks on ext2/3 filesystem",
2527    "\
2528 This runs the I<zerofree> program on C<device>.  This program
2529 claims to zero unused inodes and disk blocks on an ext2/3
2530 filesystem, thus making it possible to compress the filesystem
2531 more effectively.
2532
2533 You should B<not> run this program if the filesystem is
2534 mounted.
2535
2536 It is possible that using this program can damage the filesystem
2537 or data on the filesystem.");
2538
2539   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2540    [],
2541    "resize an LVM physical volume",
2542    "\
2543 This resizes (expands or shrinks) an existing LVM physical
2544 volume to match the new size of the underlying device.");
2545
2546   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2547                        Int "cyls"; Int "heads"; Int "sectors";
2548                        String "line"]), 99, [DangerWillRobinson],
2549    [],
2550    "modify a single partition on a block device",
2551    "\
2552 This runs L<sfdisk(8)> option to modify just the single
2553 partition C<n> (note: C<n> counts from 1).
2554
2555 For other parameters, see C<guestfs_sfdisk>.  You should usually
2556 pass C<0> for the cyls/heads/sectors parameters.
2557
2558 See also: C<guestfs_part_add>");
2559
2560   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2561    [],
2562    "display the partition table",
2563    "\
2564 This displays the partition table on C<device>, in the
2565 human-readable output of the L<sfdisk(8)> command.  It is
2566 not intended to be parsed.
2567
2568 See also: C<guestfs_part_list>");
2569
2570   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2571    [],
2572    "display the kernel geometry",
2573    "\
2574 This displays the kernel's idea of the geometry of C<device>.
2575
2576 The result is in human-readable format, and not designed to
2577 be parsed.");
2578
2579   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2580    [],
2581    "display the disk geometry from the partition table",
2582    "\
2583 This displays the disk geometry of C<device> read from the
2584 partition table.  Especially in the case where the underlying
2585 block device has been resized, this can be different from the
2586 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2587
2588 The result is in human-readable format, and not designed to
2589 be parsed.");
2590
2591   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2592    [],
2593    "activate or deactivate all volume groups",
2594    "\
2595 This command activates or (if C<activate> is false) deactivates
2596 all logical volumes in all volume groups.
2597 If activated, then they are made known to the
2598 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2599 then those devices disappear.
2600
2601 This command is the same as running C<vgchange -a y|n>");
2602
2603   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2604    [],
2605    "activate or deactivate some volume groups",
2606    "\
2607 This command activates or (if C<activate> is false) deactivates
2608 all logical volumes in the listed volume groups C<volgroups>.
2609 If activated, then they are made known to the
2610 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2611 then those devices disappear.
2612
2613 This command is the same as running C<vgchange -a y|n volgroups...>
2614
2615 Note that if C<volgroups> is an empty list then B<all> volume groups
2616 are activated or deactivated.");
2617
2618   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2619    [InitNone, Always, TestOutput (
2620       [["part_disk"; "/dev/sda"; "mbr"];
2621        ["pvcreate"; "/dev/sda1"];
2622        ["vgcreate"; "VG"; "/dev/sda1"];
2623        ["lvcreate"; "LV"; "VG"; "10"];
2624        ["mkfs"; "ext2"; "/dev/VG/LV"];
2625        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2626        ["write_file"; "/new"; "test content"; "0"];
2627        ["umount"; "/"];
2628        ["lvresize"; "/dev/VG/LV"; "20"];
2629        ["e2fsck_f"; "/dev/VG/LV"];
2630        ["resize2fs"; "/dev/VG/LV"];
2631        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2632        ["cat"; "/new"]], "test content");
2633     InitNone, Always, TestRun (
2634       (* Make an LV smaller to test RHBZ#587484. *)
2635       [["part_disk"; "/dev/sda"; "mbr"];
2636        ["pvcreate"; "/dev/sda1"];
2637        ["vgcreate"; "VG"; "/dev/sda1"];
2638        ["lvcreate"; "LV"; "VG"; "20"];
2639        ["lvresize"; "/dev/VG/LV"; "10"]])],
2640    "resize an LVM logical volume",
2641    "\
2642 This resizes (expands or shrinks) an existing LVM logical
2643 volume to C<mbytes>.  When reducing, data in the reduced part
2644 is lost.");
2645
2646   ("resize2fs", (RErr, [Device "device"]), 106, [],
2647    [], (* lvresize tests this *)
2648    "resize an ext2, ext3 or ext4 filesystem",
2649    "\
2650 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2651 the underlying device.
2652
2653 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2654 on the C<device> before calling this command.  For unknown reasons
2655 C<resize2fs> sometimes gives an error about this and sometimes not.
2656 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2657 calling this function.");
2658
2659   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2660    [InitBasicFS, Always, TestOutputList (
2661       [["find"; "/"]], ["lost+found"]);
2662     InitBasicFS, Always, TestOutputList (
2663       [["touch"; "/a"];
2664        ["mkdir"; "/b"];
2665        ["touch"; "/b/c"];
2666        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2667     InitBasicFS, Always, TestOutputList (
2668       [["mkdir_p"; "/a/b/c"];
2669        ["touch"; "/a/b/c/d"];
2670        ["find"; "/a/b/"]], ["c"; "c/d"])],
2671    "find all files and directories",
2672    "\
2673 This command lists out all files and directories, recursively,
2674 starting at C<directory>.  It is essentially equivalent to
2675 running the shell command C<find directory -print> but some
2676 post-processing happens on the output, described below.
2677
2678 This returns a list of strings I<without any prefix>.  Thus
2679 if the directory structure was:
2680
2681  /tmp/a
2682  /tmp/b
2683  /tmp/c/d
2684
2685 then the returned list from C<guestfs_find> C</tmp> would be
2686 4 elements:
2687
2688  a
2689  b
2690  c
2691  c/d
2692
2693 If C<directory> is not a directory, then this command returns
2694 an error.
2695
2696 The returned list is sorted.
2697
2698 See also C<guestfs_find0>.");
2699
2700   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2701    [], (* lvresize tests this *)
2702    "check an ext2/ext3 filesystem",
2703    "\
2704 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2705 filesystem checker on C<device>, noninteractively (C<-p>),
2706 even if the filesystem appears to be clean (C<-f>).
2707
2708 This command is only needed because of C<guestfs_resize2fs>
2709 (q.v.).  Normally you should use C<guestfs_fsck>.");
2710
2711   ("sleep", (RErr, [Int "secs"]), 109, [],
2712    [InitNone, Always, TestRun (
2713       [["sleep"; "1"]])],
2714    "sleep for some seconds",
2715    "\
2716 Sleep for C<secs> seconds.");
2717
2718   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2719    [InitNone, Always, TestOutputInt (
2720       [["part_disk"; "/dev/sda"; "mbr"];
2721        ["mkfs"; "ntfs"; "/dev/sda1"];
2722        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2723     InitNone, Always, TestOutputInt (
2724       [["part_disk"; "/dev/sda"; "mbr"];
2725        ["mkfs"; "ext2"; "/dev/sda1"];
2726        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2727    "probe NTFS volume",
2728    "\
2729 This command runs the L<ntfs-3g.probe(8)> command which probes
2730 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2731 be mounted read-write, and some cannot be mounted at all).
2732
2733 C<rw> is a boolean flag.  Set it to true if you want to test
2734 if the volume can be mounted read-write.  Set it to false if
2735 you want to test if the volume can be mounted read-only.
2736
2737 The return value is an integer which C<0> if the operation
2738 would succeed, or some non-zero value documented in the
2739 L<ntfs-3g.probe(8)> manual page.");
2740
2741   ("sh", (RString "output", [String "command"]), 111, [],
2742    [], (* XXX needs tests *)
2743    "run a command via the shell",
2744    "\
2745 This call runs a command from the guest filesystem via the
2746 guest's C</bin/sh>.
2747
2748 This is like C<guestfs_command>, but passes the command to:
2749
2750  /bin/sh -c \"command\"
2751
2752 Depending on the guest's shell, this usually results in
2753 wildcards being expanded, shell expressions being interpolated
2754 and so on.
2755
2756 All the provisos about C<guestfs_command> apply to this call.");
2757
2758   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2759    [], (* XXX needs tests *)
2760    "run a command via the shell returning lines",
2761    "\
2762 This is the same as C<guestfs_sh>, but splits the result
2763 into a list of lines.
2764
2765 See also: C<guestfs_command_lines>");
2766
2767   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2768    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2769     * code in stubs.c, since all valid glob patterns must start with "/".
2770     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2771     *)
2772    [InitBasicFS, Always, TestOutputList (
2773       [["mkdir_p"; "/a/b/c"];
2774        ["touch"; "/a/b/c/d"];
2775        ["touch"; "/a/b/c/e"];
2776        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2777     InitBasicFS, Always, TestOutputList (
2778       [["mkdir_p"; "/a/b/c"];
2779        ["touch"; "/a/b/c/d"];
2780        ["touch"; "/a/b/c/e"];
2781        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2782     InitBasicFS, Always, TestOutputList (
2783       [["mkdir_p"; "/a/b/c"];
2784        ["touch"; "/a/b/c/d"];
2785        ["touch"; "/a/b/c/e"];
2786        ["glob_expand"; "/a/*/x/*"]], [])],
2787    "expand a wildcard path",
2788    "\
2789 This command searches for all the pathnames matching
2790 C<pattern> according to the wildcard expansion rules
2791 used by the shell.
2792
2793 If no paths match, then this returns an empty list
2794 (note: not an error).
2795
2796 It is just a wrapper around the C L<glob(3)> function
2797 with flags C<GLOB_MARK|GLOB_BRACE>.
2798 See that manual page for more details.");
2799
2800   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2801    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2802       [["scrub_device"; "/dev/sdc"]])],
2803    "scrub (securely wipe) a device",
2804    "\
2805 This command writes patterns over C<device> to make data retrieval
2806 more difficult.
2807
2808 It is an interface to the L<scrub(1)> program.  See that
2809 manual page for more details.");
2810
2811   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2812    [InitBasicFS, Always, TestRun (
2813       [["write_file"; "/file"; "content"; "0"];
2814        ["scrub_file"; "/file"]])],
2815    "scrub (securely wipe) a file",
2816    "\
2817 This command writes patterns over a file to make data retrieval
2818 more difficult.
2819
2820 The file is I<removed> after scrubbing.
2821
2822 It is an interface to the L<scrub(1)> program.  See that
2823 manual page for more details.");
2824
2825   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2826    [], (* XXX needs testing *)
2827    "scrub (securely wipe) free space",
2828    "\
2829 This command creates the directory C<dir> and then fills it
2830 with files until the filesystem is full, and scrubs the files
2831 as for C<guestfs_scrub_file>, and deletes them.
2832 The intention is to scrub any free space on the partition
2833 containing C<dir>.
2834
2835 It is an interface to the L<scrub(1)> program.  See that
2836 manual page for more details.");
2837
2838   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2839    [InitBasicFS, Always, TestRun (
2840       [["mkdir"; "/tmp"];
2841        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2842    "create a temporary directory",
2843    "\
2844 This command creates a temporary directory.  The
2845 C<template> parameter should be a full pathname for the
2846 temporary directory name with the final six characters being
2847 \"XXXXXX\".
2848
2849 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2850 the second one being suitable for Windows filesystems.
2851
2852 The name of the temporary directory that was created
2853 is returned.
2854
2855 The temporary directory is created with mode 0700
2856 and is owned by root.
2857
2858 The caller is responsible for deleting the temporary
2859 directory and its contents after use.
2860
2861 See also: L<mkdtemp(3)>");
2862
2863   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2864    [InitISOFS, Always, TestOutputInt (
2865       [["wc_l"; "/10klines"]], 10000)],
2866    "count lines in a file",
2867    "\
2868 This command counts the lines in a file, using the
2869 C<wc -l> external command.");
2870
2871   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2872    [InitISOFS, Always, TestOutputInt (
2873       [["wc_w"; "/10klines"]], 10000)],
2874    "count words in a file",
2875    "\
2876 This command counts the words in a file, using the
2877 C<wc -w> external command.");
2878
2879   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2880    [InitISOFS, Always, TestOutputInt (
2881       [["wc_c"; "/100kallspaces"]], 102400)],
2882    "count characters in a file",
2883    "\
2884 This command counts the characters in a file, using the
2885 C<wc -c> external command.");
2886
2887   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2888    [InitISOFS, Always, TestOutputList (
2889       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2890    "return first 10 lines of a file",
2891    "\
2892 This command returns up to the first 10 lines of a file as
2893 a list of strings.");
2894
2895   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2896    [InitISOFS, Always, TestOutputList (
2897       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2898     InitISOFS, Always, TestOutputList (
2899       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2900     InitISOFS, Always, TestOutputList (
2901       [["head_n"; "0"; "/10klines"]], [])],
2902    "return first N lines of a file",
2903    "\
2904 If the parameter C<nrlines> is a positive number, this returns the first
2905 C<nrlines> lines of the file C<path>.
2906
2907 If the parameter C<nrlines> is a negative number, this returns lines
2908 from the file C<path>, excluding the last C<nrlines> lines.
2909
2910 If the parameter C<nrlines> is zero, this returns an empty list.");
2911
2912   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2913    [InitISOFS, Always, TestOutputList (
2914       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2915    "return last 10 lines of a file",
2916    "\
2917 This command returns up to the last 10 lines of a file as
2918 a list of strings.");
2919
2920   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2921    [InitISOFS, Always, TestOutputList (
2922       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2923     InitISOFS, Always, TestOutputList (
2924       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2925     InitISOFS, Always, TestOutputList (
2926       [["tail_n"; "0"; "/10klines"]], [])],
2927    "return last N lines of a file",
2928    "\
2929 If the parameter C<nrlines> is a positive number, this returns the last
2930 C<nrlines> lines of the file C<path>.
2931
2932 If the parameter C<nrlines> is a negative number, this returns lines
2933 from the file C<path>, starting with the C<-nrlines>th line.
2934
2935 If the parameter C<nrlines> is zero, this returns an empty list.");
2936
2937   ("df", (RString "output", []), 125, [],
2938    [], (* XXX Tricky to test because it depends on the exact format
2939         * of the 'df' command and other imponderables.
2940         *)
2941    "report file system disk space usage",
2942    "\
2943 This command runs the C<df> command to report disk space used.
2944
2945 This command is mostly useful for interactive sessions.  It
2946 is I<not> intended that you try to parse the output string.
2947 Use C<statvfs> from programs.");
2948
2949   ("df_h", (RString "output", []), 126, [],
2950    [], (* XXX Tricky to test because it depends on the exact format
2951         * of the 'df' command and other imponderables.
2952         *)
2953    "report file system disk space usage (human readable)",
2954    "\
2955 This command runs the C<df -h> command to report disk space used
2956 in human-readable format.
2957
2958 This command is mostly useful for interactive sessions.  It
2959 is I<not> intended that you try to parse the output string.
2960 Use C<statvfs> from programs.");
2961
2962   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2963    [InitISOFS, Always, TestOutputInt (
2964       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2965    "estimate file space usage",
2966    "\
2967 This command runs the C<du -s> command to estimate file space
2968 usage for C<path>.
2969
2970 C<path> can be a file or a directory.  If C<path> is a directory
2971 then the estimate includes the contents of the directory and all
2972 subdirectories (recursively).
2973
2974 The result is the estimated size in I<kilobytes>
2975 (ie. units of 1024 bytes).");
2976
2977   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2978    [InitISOFS, Always, TestOutputList (
2979       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2980    "list files in an initrd",
2981    "\
2982 This command lists out files contained in an initrd.
2983
2984 The files are listed without any initial C</> character.  The
2985 files are listed in the order they appear (not necessarily
2986 alphabetical).  Directory names are listed as separate items.
2987
2988 Old Linux kernels (2.4 and earlier) used a compressed ext2
2989 filesystem as initrd.  We I<only> support the newer initramfs
2990 format (compressed cpio files).");
2991
2992   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2993    [],
2994    "mount a file using the loop device",
2995    "\
2996 This command lets you mount C<file> (a filesystem image
2997 in a file) on a mount point.  It is entirely equivalent to
2998 the command C<mount -o loop file mountpoint>.");
2999
3000   ("mkswap", (RErr, [Device "device"]), 130, [],
3001    [InitEmpty, Always, TestRun (
3002       [["part_disk"; "/dev/sda"; "mbr"];
3003        ["mkswap"; "/dev/sda1"]])],
3004    "create a swap partition",
3005    "\
3006 Create a swap partition on C<device>.");
3007
3008   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3009    [InitEmpty, Always, TestRun (
3010       [["part_disk"; "/dev/sda"; "mbr"];
3011        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3012    "create a swap partition with a label",
3013    "\
3014 Create a swap partition on C<device> with label C<label>.
3015
3016 Note that you cannot attach a swap label to a block device
3017 (eg. C</dev/sda>), just to a partition.  This appears to be
3018 a limitation of the kernel or swap tools.");
3019
3020   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3021    (let uuid = uuidgen () in
3022     [InitEmpty, Always, TestRun (
3023        [["part_disk"; "/dev/sda"; "mbr"];
3024         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3025    "create a swap partition with an explicit UUID",
3026    "\
3027 Create a swap partition on C<device> with UUID C<uuid>.");
3028
3029   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3030    [InitBasicFS, Always, TestOutputStruct (
3031       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3032        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3033        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3034     InitBasicFS, Always, TestOutputStruct (
3035       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3036        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3037    "make block, character or FIFO devices",
3038    "\
3039 This call creates block or character special devices, or
3040 named pipes (FIFOs).
3041
3042 The C<mode> parameter should be the mode, using the standard
3043 constants.  C<devmajor> and C<devminor> are the
3044 device major and minor numbers, only used when creating block
3045 and character special devices.
3046
3047 Note that, just like L<mknod(2)>, the mode must be bitwise
3048 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3049 just creates a regular file).  These constants are
3050 available in the standard Linux header files, or you can use
3051 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3052 which are wrappers around this command which bitwise OR
3053 in the appropriate constant for you.
3054
3055 The mode actually set is affected by the umask.");
3056
3057   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3058    [InitBasicFS, Always, TestOutputStruct (
3059       [["mkfifo"; "0o777"; "/node"];
3060        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3061    "make FIFO (named pipe)",
3062    "\
3063 This call creates a FIFO (named pipe) called C<path> with
3064 mode C<mode>.  It is just a convenient wrapper around
3065 C<guestfs_mknod>.
3066
3067 The mode actually set is affected by the umask.");
3068
3069   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3070    [InitBasicFS, Always, TestOutputStruct (
3071       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3072        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3073    "make block device node",
3074    "\
3075 This call creates a block device node called C<path> with
3076 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3077 It is just a convenient wrapper around C<guestfs_mknod>.
3078
3079 The mode actually set is affected by the umask.");
3080
3081   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3082    [InitBasicFS, Always, TestOutputStruct (
3083       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3084        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3085    "make char device node",
3086    "\
3087 This call creates a char device node called C<path> with
3088 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3089 It is just a convenient wrapper around C<guestfs_mknod>.
3090
3091 The mode actually set is affected by the umask.");
3092
3093   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3094    [InitEmpty, Always, TestOutputInt (
3095       [["umask"; "0o22"]], 0o22)],
3096    "set file mode creation mask (umask)",
3097    "\
3098 This function sets the mask used for creating new files and
3099 device nodes to C<mask & 0777>.
3100
3101 Typical umask values would be C<022> which creates new files
3102 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3103 C<002> which creates new files with permissions like
3104 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3105
3106 The default umask is C<022>.  This is important because it
3107 means that directories and device nodes will be created with
3108 C<0644> or C<0755> mode even if you specify C<0777>.
3109
3110 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3111
3112 This call returns the previous umask.");
3113
3114   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3115    [],
3116    "read directories entries",
3117    "\
3118 This returns the list of directory entries in directory C<dir>.
3119
3120 All entries in the directory are returned, including C<.> and
3121 C<..>.  The entries are I<not> sorted, but returned in the same
3122 order as the underlying filesystem.
3123
3124 Also this call returns basic file type information about each
3125 file.  The C<ftyp> field will contain one of the following characters:
3126
3127 =over 4
3128
3129 =item 'b'
3130
3131 Block special
3132
3133 =item 'c'
3134
3135 Char special
3136
3137 =item 'd'
3138
3139 Directory
3140
3141 =item 'f'
3142
3143 FIFO (named pipe)
3144
3145 =item 'l'
3146
3147 Symbolic link
3148
3149 =item 'r'
3150
3151 Regular file
3152
3153 =item 's'
3154
3155 Socket
3156
3157 =item 'u'
3158
3159 Unknown file type
3160
3161 =item '?'
3162
3163 The L<readdir(3)> call returned a C<d_type> field with an
3164 unexpected value
3165
3166 =back
3167
3168 This function is primarily intended for use by programs.  To
3169 get a simple list of names, use C<guestfs_ls>.  To get a printable
3170 directory for human consumption, use C<guestfs_ll>.");
3171
3172   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3173    [],
3174    "create partitions on a block device",
3175    "\
3176 This is a simplified interface to the C<guestfs_sfdisk>
3177 command, where partition sizes are specified in megabytes
3178 only (rounded to the nearest cylinder) and you don't need
3179 to specify the cyls, heads and sectors parameters which
3180 were rarely if ever used anyway.
3181
3182 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3183 and C<guestfs_part_disk>");
3184
3185   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3186    [],
3187    "determine file type inside a compressed file",
3188    "\
3189 This command runs C<file> after first decompressing C<path>
3190 using C<method>.
3191
3192 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3193
3194 Since 1.0.63, use C<guestfs_file> instead which can now
3195 process compressed files.");
3196
3197   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3198    [],
3199    "list extended attributes of a file or directory",
3200    "\
3201 This call lists the extended attributes of the file or directory
3202 C<path>.
3203
3204 At the system call level, this is a combination of the
3205 L<listxattr(2)> and L<getxattr(2)> calls.
3206
3207 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3208
3209   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3210    [],
3211    "list extended attributes of a file or directory",
3212    "\
3213 This is the same as C<guestfs_getxattrs>, but if C<path>
3214 is a symbolic link, then it returns the extended attributes
3215 of the link itself.");
3216
3217   ("setxattr", (RErr, [String "xattr";
3218                        String "val"; Int "vallen"; (* will be BufferIn *)
3219                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3220    [],
3221    "set extended attribute of a file or directory",
3222    "\
3223 This call sets the extended attribute named C<xattr>
3224 of the file C<path> to the value C<val> (of length C<vallen>).
3225 The value is arbitrary 8 bit data.
3226
3227 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3228
3229   ("lsetxattr", (RErr, [String "xattr";
3230                         String "val"; Int "vallen"; (* will be BufferIn *)
3231                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3232    [],
3233    "set extended attribute of a file or directory",
3234    "\
3235 This is the same as C<guestfs_setxattr>, but if C<path>
3236 is a symbolic link, then it sets an extended attribute
3237 of the link itself.");
3238
3239   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3240    [],
3241    "remove extended attribute of a file or directory",
3242    "\
3243 This call removes the extended attribute named C<xattr>
3244 of the file C<path>.
3245
3246 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3247
3248   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3249    [],
3250    "remove extended attribute of a file or directory",
3251    "\
3252 This is the same as C<guestfs_removexattr>, but if C<path>
3253 is a symbolic link, then it removes an extended attribute
3254 of the link itself.");
3255
3256   ("mountpoints", (RHashtable "mps", []), 147, [],
3257    [],
3258    "show mountpoints",
3259    "\
3260 This call is similar to C<guestfs_mounts>.  That call returns
3261 a list of devices.  This one returns a hash table (map) of
3262 device name to directory where the device is mounted.");
3263
3264   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3265    (* This is a special case: while you would expect a parameter
3266     * of type "Pathname", that doesn't work, because it implies
3267     * NEED_ROOT in the generated calling code in stubs.c, and
3268     * this function cannot use NEED_ROOT.
3269     *)
3270    [],
3271    "create a mountpoint",
3272    "\
3273 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3274 specialized calls that can be used to create extra mountpoints
3275 before mounting the first filesystem.
3276
3277 These calls are I<only> necessary in some very limited circumstances,
3278 mainly the case where you want to mount a mix of unrelated and/or
3279 read-only filesystems together.
3280
3281 For example, live CDs often contain a \"Russian doll\" nest of
3282 filesystems, an ISO outer layer, with a squashfs image inside, with
3283 an ext2/3 image inside that.  You can unpack this as follows
3284 in guestfish:
3285
3286  add-ro Fedora-11-i686-Live.iso
3287  run
3288  mkmountpoint /cd
3289  mkmountpoint /squash
3290  mkmountpoint /ext3
3291  mount /dev/sda /cd
3292  mount-loop /cd/LiveOS/squashfs.img /squash
3293  mount-loop /squash/LiveOS/ext3fs.img /ext3
3294
3295 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3296
3297   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3298    [],
3299    "remove a mountpoint",
3300    "\
3301 This calls removes a mountpoint that was previously created
3302 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3303 for full details.");
3304
3305   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3306    [InitISOFS, Always, TestOutputBuffer (
3307       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3308     (* Test various near large, large and too large files (RHBZ#589039). *)
3309     InitBasicFS, Always, TestLastFail (
3310       [["touch"; "/a"];
3311        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3312        ["read_file"; "/a"]]);
3313     InitBasicFS, Always, TestLastFail (
3314       [["touch"; "/a"];
3315        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3316        ["read_file"; "/a"]]);
3317     InitBasicFS, Always, TestLastFail (
3318       [["touch"; "/a"];
3319        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3320        ["read_file"; "/a"]])],
3321    "read a file",
3322    "\
3323 This calls returns the contents of the file C<path> as a
3324 buffer.
3325
3326 Unlike C<guestfs_cat>, this function can correctly
3327 handle files that contain embedded ASCII NUL characters.
3328 However unlike C<guestfs_download>, this function is limited
3329 in the total size of file that can be handled.");
3330
3331   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3332    [InitISOFS, Always, TestOutputList (
3333       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3334     InitISOFS, Always, TestOutputList (
3335       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3336    "return lines matching a pattern",
3337    "\
3338 This calls the external C<grep> program and returns the
3339 matching lines.");
3340
3341   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3342    [InitISOFS, Always, TestOutputList (
3343       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3344    "return lines matching a pattern",
3345    "\
3346 This calls the external C<egrep> program and returns the
3347 matching lines.");
3348
3349   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3350    [InitISOFS, Always, TestOutputList (
3351       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3352    "return lines matching a pattern",
3353    "\
3354 This calls the external C<fgrep> program and returns the
3355 matching lines.");
3356
3357   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3358    [InitISOFS, Always, TestOutputList (
3359       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3360    "return lines matching a pattern",
3361    "\
3362 This calls the external C<grep -i> program and returns the
3363 matching lines.");
3364
3365   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3366    [InitISOFS, Always, TestOutputList (
3367       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3368    "return lines matching a pattern",
3369    "\
3370 This calls the external C<egrep -i> program and returns the
3371 matching lines.");
3372
3373   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3374    [InitISOFS, Always, TestOutputList (
3375       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3376    "return lines matching a pattern",
3377    "\
3378 This calls the external C<fgrep -i> program and returns the
3379 matching lines.");
3380
3381   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3382    [InitISOFS, Always, TestOutputList (
3383       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3384    "return lines matching a pattern",
3385    "\
3386 This calls the external C<zgrep> program and returns the
3387 matching lines.");
3388
3389   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3390    [InitISOFS, Always, TestOutputList (
3391       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3392    "return lines matching a pattern",
3393    "\
3394 This calls the external C<zegrep> program and returns the
3395 matching lines.");
3396
3397   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3398    [InitISOFS, Always, TestOutputList (
3399       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3400    "return lines matching a pattern",
3401    "\
3402 This calls the external C<zfgrep> program and returns the
3403 matching lines.");
3404
3405   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3406    [InitISOFS, Always, TestOutputList (
3407       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3408    "return lines matching a pattern",
3409    "\
3410 This calls the external C<zgrep -i> program and returns the
3411 matching lines.");
3412
3413   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3414    [InitISOFS, Always, TestOutputList (
3415       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3416    "return lines matching a pattern",
3417    "\
3418 This calls the external C<zegrep -i> program and returns the
3419 matching lines.");
3420
3421   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3422    [InitISOFS, Always, TestOutputList (
3423       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3424    "return lines matching a pattern",
3425    "\
3426 This calls the external C<zfgrep -i> program and returns the
3427 matching lines.");
3428
3429   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3430    [InitISOFS, Always, TestOutput (
3431       [["realpath"; "/../directory"]], "/directory")],
3432    "canonicalized absolute pathname",
3433    "\
3434 Return the canonicalized absolute pathname of C<path>.  The
3435 returned path has no C<.>, C<..> or symbolic link path elements.");
3436
3437   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3438    [InitBasicFS, Always, TestOutputStruct (
3439       [["touch"; "/a"];
3440        ["ln"; "/a"; "/b"];
3441        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3442    "create a hard link",
3443    "\
3444 This command creates a hard link using the C<ln> command.");
3445
3446   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3447    [InitBasicFS, Always, TestOutputStruct (
3448       [["touch"; "/a"];
3449        ["touch"; "/b"];
3450        ["ln_f"; "/a"; "/b"];
3451        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3452    "create a hard link",
3453    "\
3454 This command creates a hard link using the C<ln -f> command.
3455 The C<-f> option removes the link (C<linkname>) if it exists already.");
3456
3457   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3458    [InitBasicFS, Always, TestOutputStruct (
3459       [["touch"; "/a"];
3460        ["ln_s"; "a"; "/b"];
3461        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3462    "create a symbolic link",
3463    "\
3464 This command creates a symbolic link using the C<ln -s> command.");
3465
3466   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3467    [InitBasicFS, Always, TestOutput (
3468       [["mkdir_p"; "/a/b"];
3469        ["touch"; "/a/b/c"];
3470        ["ln_sf"; "../d"; "/a/b/c"];
3471        ["readlink"; "/a/b/c"]], "../d")],
3472    "create a symbolic link",
3473    "\
3474 This command creates a symbolic link using the C<ln -sf> command,
3475 The C<-f> option removes the link (C<linkname>) if it exists already.");
3476
3477   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3478    [] (* XXX tested above *),
3479    "read the target of a symbolic link",
3480    "\
3481 This command reads the target of a symbolic link.");
3482
3483   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3484    [InitBasicFS, Always, TestOutputStruct (
3485       [["fallocate"; "/a"; "1000000"];
3486        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3487    "preallocate a file in the guest filesystem",
3488    "\
3489 This command preallocates a file (containing zero bytes) named
3490 C<path> of size C<len> bytes.  If the file exists already, it
3491 is overwritten.
3492
3493 Do not confuse this with the guestfish-specific
3494 C<alloc> command which allocates a file in the host and
3495 attaches it as a device.");
3496
3497   ("swapon_device", (RErr, [Device "device"]), 170, [],
3498    [InitPartition, Always, TestRun (
3499       [["mkswap"; "/dev/sda1"];
3500        ["swapon_device"; "/dev/sda1"];
3501        ["swapoff_device"; "/dev/sda1"]])],
3502    "enable swap on device",
3503    "\
3504 This command enables the libguestfs appliance to use the
3505 swap device or partition named C<device>.  The increased
3506 memory is made available for all commands, for example
3507 those run using C<guestfs_command> or C<guestfs_sh>.
3508
3509 Note that you should not swap to existing guest swap
3510 partitions unless you know what you are doing.  They may
3511 contain hibernation information, or other information that
3512 the guest doesn't want you to trash.  You also risk leaking
3513 information about the host to the guest this way.  Instead,
3514 attach a new host device to the guest and swap on that.");
3515
3516   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3517    [], (* XXX tested by swapon_device *)
3518    "disable swap on device",
3519    "\
3520 This command disables the libguestfs appliance swap
3521 device or partition named C<device>.
3522 See C<guestfs_swapon_device>.");
3523
3524   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3525    [InitBasicFS, Always, TestRun (
3526       [["fallocate"; "/swap"; "8388608"];
3527        ["mkswap_file"; "/swap"];
3528        ["swapon_file"; "/swap"];
3529        ["swapoff_file"; "/swap"]])],
3530    "enable swap on file",
3531    "\
3532 This command enables swap to a file.
3533 See C<guestfs_swapon_device> for other notes.");
3534
3535   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3536    [], (* XXX tested by swapon_file *)
3537    "disable swap on file",
3538    "\
3539 This command disables the libguestfs appliance swap on file.");
3540
3541   ("swapon_label", (RErr, [String "label"]), 174, [],
3542    [InitEmpty, Always, TestRun (
3543       [["part_disk"; "/dev/sdb"; "mbr"];
3544        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3545        ["swapon_label"; "swapit"];
3546        ["swapoff_label"; "swapit"];
3547        ["zero"; "/dev/sdb"];
3548        ["blockdev_rereadpt"; "/dev/sdb"]])],
3549    "enable swap on labeled swap partition",
3550    "\
3551 This command enables swap to a labeled swap partition.
3552 See C<guestfs_swapon_device> for other notes.");
3553
3554   ("swapoff_label", (RErr, [String "label"]), 175, [],
3555    [], (* XXX tested by swapon_label *)
3556    "disable swap on labeled swap partition",
3557    "\
3558 This command disables the libguestfs appliance swap on
3559 labeled swap partition.");
3560
3561   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3562    (let uuid = uuidgen () in
3563     [InitEmpty, Always, TestRun (
3564        [["mkswap_U"; uuid; "/dev/sdb"];
3565         ["swapon_uuid"; uuid];
3566         ["swapoff_uuid"; uuid]])]),
3567    "enable swap on swap partition by UUID",
3568    "\
3569 This command enables swap to a swap partition with the given UUID.
3570 See C<guestfs_swapon_device> for other notes.");
3571
3572   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3573    [], (* XXX tested by swapon_uuid *)
3574    "disable swap on swap partition by UUID",
3575    "\
3576 This command disables the libguestfs appliance swap partition
3577 with the given UUID.");
3578
3579   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3580    [InitBasicFS, Always, TestRun (
3581       [["fallocate"; "/swap"; "8388608"];
3582        ["mkswap_file"; "/swap"]])],
3583    "create a swap file",
3584    "\
3585 Create a swap file.
3586
3587 This command just writes a swap file signature to an existing
3588 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3589
3590   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3591    [InitISOFS, Always, TestRun (
3592       [["inotify_init"; "0"]])],
3593    "create an inotify handle",
3594    "\
3595 This command creates a new inotify handle.
3596 The inotify subsystem can be used to notify events which happen to
3597 objects in the guest filesystem.
3598
3599 C<maxevents> is the maximum number of events which will be
3600 queued up between calls to C<guestfs_inotify_read> or
3601 C<guestfs_inotify_files>.
3602 If this is passed as C<0>, then the kernel (or previously set)
3603 default is used.  For Linux 2.6.29 the default was 16384 events.
3604 Beyond this limit, the kernel throws away events, but records
3605 the fact that it threw them away by setting a flag
3606 C<IN_Q_OVERFLOW> in the returned structure list (see
3607 C<guestfs_inotify_read>).
3608
3609 Before any events are generated, you have to add some
3610 watches to the internal watch list.  See:
3611 C<guestfs_inotify_add_watch>,
3612 C<guestfs_inotify_rm_watch> and
3613 C<guestfs_inotify_watch_all>.
3614
3615 Queued up events should be read periodically by calling
3616 C<guestfs_inotify_read>
3617 (or C<guestfs_inotify_files> which is just a helpful
3618 wrapper around C<guestfs_inotify_read>).  If you don't
3619 read the events out often enough then you risk the internal
3620 queue overflowing.
3621
3622 The handle should be closed after use by calling
3623 C<guestfs_inotify_close>.  This also removes any
3624 watches automatically.
3625
3626 See also L<inotify(7)> for an overview of the inotify interface
3627 as exposed by the Linux kernel, which is roughly what we expose
3628 via libguestfs.  Note that there is one global inotify handle
3629 per libguestfs instance.");
3630
3631   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3632    [InitBasicFS, Always, TestOutputList (
3633       [["inotify_init"; "0"];
3634        ["inotify_add_watch"; "/"; "1073741823"];
3635        ["touch"; "/a"];
3636        ["touch"; "/b"];
3637        ["inotify_files"]], ["a"; "b"])],
3638    "add an inotify watch",
3639    "\
3640 Watch C<path> for the events listed in C<mask>.
3641
3642 Note that if C<path> is a directory then events within that
3643 directory are watched, but this does I<not> happen recursively
3644 (in subdirectories).
3645
3646 Note for non-C or non-Linux callers: the inotify events are
3647 defined by the Linux kernel ABI and are listed in
3648 C</usr/include/sys/inotify.h>.");
3649
3650   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3651    [],
3652    "remove an inotify watch",
3653    "\
3654 Remove a previously defined inotify watch.
3655 See C<guestfs_inotify_add_watch>.");
3656
3657   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3658    [],
3659    "return list of inotify events",
3660    "\
3661 Return the complete queue of events that have happened
3662 since the previous read call.
3663
3664 If no events have happened, this returns an empty list.
3665
3666 I<Note>: In order to make sure that all events have been
3667 read, you must call this function repeatedly until it
3668 returns an empty list.  The reason is that the call will
3669 read events up to the maximum appliance-to-host message
3670 size and leave remaining events in the queue.");
3671
3672   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3673    [],
3674    "return list of watched files that had events",
3675    "\
3676 This function is a helpful wrapper around C<guestfs_inotify_read>
3677 which just returns a list of pathnames of objects that were
3678 touched.  The returned pathnames are sorted and deduplicated.");
3679
3680   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3681    [],
3682    "close the inotify handle",
3683    "\
3684 This closes the inotify handle which was previously
3685 opened by inotify_init.  It removes all watches, throws
3686 away any pending events, and deallocates all resources.");
3687
3688   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3689    [],
3690    "set SELinux security context",
3691    "\
3692 This sets the SELinux security context of the daemon
3693 to the string C<context>.
3694
3695 See the documentation about SELINUX in L<guestfs(3)>.");
3696
3697   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3698    [],
3699    "get SELinux security context",
3700    "\
3701 This gets the SELinux security context of the daemon.
3702
3703 See the documentation about SELINUX in L<guestfs(3)>,
3704 and C<guestfs_setcon>");
3705
3706   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3707    [InitEmpty, Always, TestOutput (
3708       [["part_disk"; "/dev/sda"; "mbr"];
3709        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3710        ["mount_options"; ""; "/dev/sda1"; "/"];
3711        ["write_file"; "/new"; "new file contents"; "0"];
3712        ["cat"; "/new"]], "new file contents")],
3713    "make a filesystem with block size",
3714    "\
3715 This call is similar to C<guestfs_mkfs>, but it allows you to
3716 control the block size of the resulting filesystem.  Supported
3717 block sizes depend on the filesystem type, but typically they
3718 are C<1024>, C<2048> or C<4096> only.");
3719
3720   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3721    [InitEmpty, Always, TestOutput (
3722       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3723        ["mke2journal"; "4096"; "/dev/sda1"];
3724        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3725        ["mount_options"; ""; "/dev/sda2"; "/"];
3726        ["write_file"; "/new"; "new file contents"; "0"];
3727        ["cat"; "/new"]], "new file contents")],
3728    "make ext2/3/4 external journal",
3729    "\
3730 This creates an ext2 external journal on C<device>.  It is equivalent
3731 to the command:
3732
3733  mke2fs -O journal_dev -b blocksize device");
3734
3735   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3736    [InitEmpty, Always, TestOutput (
3737       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3738        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3739        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3740        ["mount_options"; ""; "/dev/sda2"; "/"];
3741        ["write_file"; "/new"; "new file contents"; "0"];
3742        ["cat"; "/new"]], "new file contents")],
3743    "make ext2/3/4 external journal with label",
3744    "\
3745 This creates an ext2 external journal on C<device> with label C<label>.");
3746
3747   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3748    (let uuid = uuidgen () in
3749     [InitEmpty, Always, TestOutput (
3750        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3751         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3752         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3753         ["mount_options"; ""; "/dev/sda2"; "/"];
3754         ["write_file"; "/new"; "new file contents"; "0"];
3755         ["cat"; "/new"]], "new file contents")]),
3756    "make ext2/3/4 external journal with UUID",
3757    "\
3758 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3759
3760   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3761    [],
3762    "make ext2/3/4 filesystem with external journal",
3763    "\
3764 This creates an ext2/3/4 filesystem on C<device> with
3765 an external journal on C<journal>.  It is equivalent
3766 to the command:
3767
3768  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3769
3770 See also C<guestfs_mke2journal>.");
3771
3772   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3773    [],
3774    "make ext2/3/4 filesystem with external journal",
3775    "\
3776 This creates an ext2/3/4 filesystem on C<device> with
3777 an external journal on the journal labeled C<label>.
3778
3779 See also C<guestfs_mke2journal_L>.");
3780
3781   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3782    [],
3783    "make ext2/3/4 filesystem with external journal",
3784    "\
3785 This creates an ext2/3/4 filesystem on C<device> with
3786 an external journal on the journal with UUID C<uuid>.
3787
3788 See also C<guestfs_mke2journal_U>.");
3789
3790   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3791    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3792    "load a kernel module",
3793    "\
3794 This loads a kernel module in the appliance.
3795
3796 The kernel module must have been whitelisted when libguestfs
3797 was built (see C<appliance/kmod.whitelist.in> in the source).");
3798
3799   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3800    [InitNone, Always, TestOutput (
3801       [["echo_daemon"; "This is a test"]], "This is a test"
3802     )],
3803    "echo arguments back to the client",
3804    "\
3805 This command concatenates the list of C<words> passed with single spaces
3806 between them and returns the resulting string.
3807
3808 You can use this command to test the connection through to the daemon.
3809
3810 See also C<guestfs_ping_daemon>.");
3811
3812   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3813    [], (* There is a regression test for this. *)
3814    "find all files and directories, returning NUL-separated list",
3815    "\
3816 This command lists out all files and directories, recursively,
3817 starting at C<directory>, placing the resulting list in the
3818 external file called C<files>.
3819
3820 This command works the same way as C<guestfs_find> with the
3821 following exceptions:
3822
3823 =over 4
3824
3825 =item *
3826
3827 The resulting list is written to an external file.
3828
3829 =item *
3830
3831 Items (filenames) in the result are separated
3832 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3833
3834 =item *
3835
3836 This command is not limited in the number of names that it
3837 can return.
3838
3839 =item *
3840
3841 The result list is not sorted.
3842
3843 =back");
3844
3845   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3846    [InitISOFS, Always, TestOutput (
3847       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3848     InitISOFS, Always, TestOutput (
3849       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3850     InitISOFS, Always, TestOutput (
3851       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3852     InitISOFS, Always, TestLastFail (
3853       [["case_sensitive_path"; "/Known-1/"]]);
3854     InitBasicFS, Always, TestOutput (
3855       [["mkdir"; "/a"];
3856        ["mkdir"; "/a/bbb"];
3857        ["touch"; "/a/bbb/c"];
3858        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3859     InitBasicFS, Always, TestOutput (
3860       [["mkdir"; "/a"];
3861        ["mkdir"; "/a/bbb"];
3862        ["touch"; "/a/bbb/c"];
3863        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3864     InitBasicFS, Always, TestLastFail (
3865       [["mkdir"; "/a"];
3866        ["mkdir"; "/a/bbb"];
3867        ["touch"; "/a/bbb/c"];
3868        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3869    "return true path on case-insensitive filesystem",
3870    "\
3871 This can be used to resolve case insensitive paths on
3872 a filesystem which is case sensitive.  The use case is
3873 to resolve paths which you have read from Windows configuration
3874 files or the Windows Registry, to the true path.
3875
3876 The command handles a peculiarity of the Linux ntfs-3g
3877 filesystem driver (and probably others), which is that although
3878 the underlying filesystem is case-insensitive, the driver
3879 exports the filesystem to Linux as case-sensitive.
3880
3881 One consequence of this is that special directories such
3882 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3883 (or other things) depending on the precise details of how
3884 they were created.  In Windows itself this would not be
3885 a problem.
3886
3887 Bug or feature?  You decide:
3888 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3889
3890 This function resolves the true case of each element in the
3891 path and returns the case-sensitive path.
3892
3893 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3894 might return C<\"/WINDOWS/system32\"> (the exact return value
3895 would depend on details of how the directories were originally
3896 created under Windows).
3897
3898 I<Note>:
3899 This function does not handle drive names, backslashes etc.
3900
3901 See also C<guestfs_realpath>.");
3902
3903   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3904    [InitBasicFS, Always, TestOutput (
3905       [["vfs_type"; "/dev/sda1"]], "ext2")],
3906    "get the Linux VFS type corresponding to a mounted device",
3907    "\
3908 This command gets the filesystem type corresponding to
3909 the filesystem on C<device>.
3910
3911 For most filesystems, the result is the name of the Linux
3912 VFS module which would be used to mount this filesystem
3913 if you mounted it without specifying the filesystem type.
3914 For example a string such as C<ext3> or C<ntfs>.");
3915
3916   ("truncate", (RErr, [Pathname "path"]), 199, [],
3917    [InitBasicFS, Always, TestOutputStruct (
3918       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3919        ["truncate"; "/test"];
3920        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3921    "truncate a file to zero size",
3922    "\
3923 This command truncates C<path> to a zero-length file.  The
3924 file must exist already.");
3925
3926   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3927    [InitBasicFS, Always, TestOutputStruct (
3928       [["touch"; "/test"];
3929        ["truncate_size"; "/test"; "1000"];
3930        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3931    "truncate a file to a particular size",
3932    "\
3933 This command truncates C<path> to size C<size> bytes.  The file
3934 must exist already.
3935
3936 If the current file size is less than C<size> then
3937 the file is extended to the required size with zero bytes.
3938 This creates a sparse file (ie. disk blocks are not allocated
3939 for the file until you write to it).  To create a non-sparse
3940 file of zeroes, use C<guestfs_fallocate64> instead.");
3941
3942   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3943    [InitBasicFS, Always, TestOutputStruct (
3944       [["touch"; "/test"];
3945        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3946        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3947    "set timestamp of a file with nanosecond precision",
3948    "\
3949 This command sets the timestamps of a file with nanosecond
3950 precision.
3951
3952 C<atsecs, atnsecs> are the last access time (atime) in secs and
3953 nanoseconds from the epoch.
3954
3955 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3956 secs and nanoseconds from the epoch.
3957
3958 If the C<*nsecs> field contains the special value C<-1> then
3959 the corresponding timestamp is set to the current time.  (The
3960 C<*secs> field is ignored in this case).
3961
3962 If the C<*nsecs> field contains the special value C<-2> then
3963 the corresponding timestamp is left unchanged.  (The
3964 C<*secs> field is ignored in this case).");
3965
3966   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3967    [InitBasicFS, Always, TestOutputStruct (
3968       [["mkdir_mode"; "/test"; "0o111"];
3969        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3970    "create a directory with a particular mode",
3971    "\
3972 This command creates a directory, setting the initial permissions
3973 of the directory to C<mode>.
3974
3975 For common Linux filesystems, the actual mode which is set will
3976 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3977 interpret the mode in other ways.
3978
3979 See also C<guestfs_mkdir>, C<guestfs_umask>");
3980
3981   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3982    [], (* XXX *)
3983    "change file owner and group",
3984    "\
3985 Change the file owner to C<owner> and group to C<group>.
3986 This is like C<guestfs_chown> but if C<path> is a symlink then
3987 the link itself is changed, not the target.
3988
3989 Only numeric uid and gid are supported.  If you want to use
3990 names, you will need to locate and parse the password file
3991 yourself (Augeas support makes this relatively easy).");
3992
3993   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3994    [], (* XXX *)
3995    "lstat on multiple files",
3996    "\
3997 This call allows you to perform the C<guestfs_lstat> operation
3998 on multiple files, where all files are in the directory C<path>.
3999 C<names> is the list of files from this directory.
4000
4001 On return you get a list of stat structs, with a one-to-one
4002 correspondence to the C<names> list.  If any name did not exist
4003 or could not be lstat'd, then the C<ino> field of that structure
4004 is set to C<-1>.
4005
4006 This call is intended for programs that want to efficiently
4007 list a directory contents without making many round-trips.
4008 See also C<guestfs_lxattrlist> for a similarly efficient call
4009 for getting extended attributes.  Very long directory listings
4010 might cause the protocol message size to be exceeded, causing
4011 this call to fail.  The caller must split up such requests
4012 into smaller groups of names.");
4013
4014   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4015    [], (* XXX *)
4016    "lgetxattr on multiple files",
4017    "\
4018 This call allows you to get the extended attributes
4019 of multiple files, where all files are in the directory C<path>.
4020 C<names> is the list of files from this directory.
4021
4022 On return you get a flat list of xattr structs which must be
4023 interpreted sequentially.  The first xattr struct always has a zero-length
4024 C<attrname>.  C<attrval> in this struct is zero-length
4025 to indicate there was an error doing C<lgetxattr> for this
4026 file, I<or> is a C string which is a decimal number
4027 (the number of following attributes for this file, which could
4028 be C<\"0\">).  Then after the first xattr struct are the
4029 zero or more attributes for the first named file.
4030 This repeats for the second and subsequent files.
4031
4032 This call is intended for programs that want to efficiently
4033 list a directory contents without making many round-trips.
4034 See also C<guestfs_lstatlist> for a similarly efficient call
4035 for getting standard stats.  Very long directory listings
4036 might cause the protocol message size to be exceeded, causing
4037 this call to fail.  The caller must split up such requests
4038 into smaller groups of names.");
4039
4040   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4041    [], (* XXX *)
4042    "readlink on multiple files",
4043    "\
4044 This call allows you to do a C<readlink> operation
4045 on multiple files, where all files are in the directory C<path>.
4046 C<names> is the list of files from this directory.
4047
4048 On return you get a list of strings, with a one-to-one
4049 correspondence to the C<names> list.  Each string is the
4050 value of the symbolic link.
4051
4052 If the C<readlink(2)> operation fails on any name, then
4053 the corresponding result string is the empty string C<\"\">.
4054 However the whole operation is completed even if there
4055 were C<readlink(2)> errors, and so you can call this
4056 function with names where you don't know if they are
4057 symbolic links already (albeit slightly less efficient).
4058
4059 This call is intended for programs that want to efficiently
4060 list a directory contents without making many round-trips.
4061 Very long directory listings might cause the protocol
4062 message size to be exceeded, causing
4063 this call to fail.  The caller must split up such requests
4064 into smaller groups of names.");
4065
4066   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4067    [InitISOFS, Always, TestOutputBuffer (
4068       [["pread"; "/known-4"; "1"; "3"]], "\n");
4069     InitISOFS, Always, TestOutputBuffer (
4070       [["pread"; "/empty"; "0"; "100"]], "")],
4071    "read part of a file",
4072    "\
4073 This command lets you read part of a file.  It reads C<count>
4074 bytes of the file, starting at C<offset>, from file C<path>.
4075
4076 This may read fewer bytes than requested.  For further details
4077 see the L<pread(2)> system call.");
4078
4079   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4080    [InitEmpty, Always, TestRun (
4081       [["part_init"; "/dev/sda"; "gpt"]])],
4082    "create an empty partition table",
4083    "\
4084 This creates an empty partition table on C<device> of one of the
4085 partition types listed below.  Usually C<parttype> should be
4086 either C<msdos> or C<gpt> (for large disks).
4087
4088 Initially there are no partitions.  Following this, you should
4089 call C<guestfs_part_add> for each partition required.
4090
4091 Possible values for C<parttype> are:
4092
4093 =over 4
4094
4095 =item B<efi> | B<gpt>
4096
4097 Intel EFI / GPT partition table.
4098
4099 This is recommended for >= 2 TB partitions that will be accessed
4100 from Linux and Intel-based Mac OS X.  It also has limited backwards
4101 compatibility with the C<mbr> format.
4102
4103 =item B<mbr> | B<msdos>
4104
4105 The standard PC \"Master Boot Record\" (MBR) format used
4106 by MS-DOS and Windows.  This partition type will B<only> work
4107 for device sizes up to 2 TB.  For large disks we recommend
4108 using C<gpt>.
4109
4110 =back
4111
4112 Other partition table types that may work but are not
4113 supported include:
4114
4115 =over 4
4116
4117 =item B<aix>
4118
4119 AIX disk labels.
4120
4121 =item B<amiga> | B<rdb>
4122
4123 Amiga \"Rigid Disk Block\" format.
4124
4125 =item B<bsd>
4126
4127 BSD disk labels.
4128
4129 =item B<dasd>
4130
4131 DASD, used on IBM mainframes.
4132
4133 =item B<dvh>
4134
4135 MIPS/SGI volumes.
4136
4137 =item B<mac>
4138
4139 Old Mac partition format.  Modern Macs use C<gpt>.
4140
4141 =item B<pc98>
4142
4143 NEC PC-98 format, common in Japan apparently.
4144
4145 =item B<sun>
4146
4147 Sun disk labels.
4148
4149 =back");
4150
4151   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4152    [InitEmpty, Always, TestRun (
4153       [["part_init"; "/dev/sda"; "mbr"];
4154        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4155     InitEmpty, Always, TestRun (
4156       [["part_init"; "/dev/sda"; "gpt"];
4157        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4158        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4159     InitEmpty, Always, TestRun (
4160       [["part_init"; "/dev/sda"; "mbr"];
4161        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4162        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4163        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4164        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4165    "add a partition to the device",
4166    "\
4167 This command adds a partition to C<device>.  If there is no partition
4168 table on the device, call C<guestfs_part_init> first.
4169
4170 The C<prlogex> parameter is the type of partition.  Normally you
4171 should pass C<p> or C<primary> here, but MBR partition tables also
4172 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4173 types.
4174
4175 C<startsect> and C<endsect> are the start and end of the partition
4176 in I<sectors>.  C<endsect> may be negative, which means it counts
4177 backwards from the end of the disk (C<-1> is the last sector).
4178
4179 Creating a partition which covers the whole disk is not so easy.
4180 Use C<guestfs_part_disk> to do that.");
4181
4182   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4183    [InitEmpty, Always, TestRun (
4184       [["part_disk"; "/dev/sda"; "mbr"]]);
4185     InitEmpty, Always, TestRun (
4186       [["part_disk"; "/dev/sda"; "gpt"]])],
4187    "partition whole disk with a single primary partition",
4188    "\
4189 This command is simply a combination of C<guestfs_part_init>
4190 followed by C<guestfs_part_add> to create a single primary partition
4191 covering the whole disk.
4192
4193 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4194 but other possible values are described in C<guestfs_part_init>.");
4195
4196   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4197    [InitEmpty, Always, TestRun (
4198       [["part_disk"; "/dev/sda"; "mbr"];
4199        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4200    "make a partition bootable",
4201    "\
4202 This sets the bootable flag on partition numbered C<partnum> on
4203 device C<device>.  Note that partitions are numbered from 1.
4204
4205 The bootable flag is used by some operating systems (notably
4206 Windows) to determine which partition to boot from.  It is by
4207 no means universally recognized.");
4208
4209   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4210    [InitEmpty, Always, TestRun (
4211       [["part_disk"; "/dev/sda"; "gpt"];
4212        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4213    "set partition name",
4214    "\
4215 This sets the partition name on partition numbered C<partnum> on
4216 device C<device>.  Note that partitions are numbered from 1.
4217
4218 The partition name can only be set on certain types of partition
4219 table.  This works on C<gpt> but not on C<mbr> partitions.");
4220
4221   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4222    [], (* XXX Add a regression test for this. *)
4223    "list partitions on a device",
4224    "\
4225 This command parses the partition table on C<device> and
4226 returns the list of partitions found.
4227
4228 The fields in the returned structure are:
4229
4230 =over 4
4231
4232 =item B<part_num>
4233
4234 Partition number, counting from 1.
4235
4236 =item B<part_start>
4237
4238 Start of the partition I<in bytes>.  To get sectors you have to
4239 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4240
4241 =item B<part_end>
4242
4243 End of the partition in bytes.
4244
4245 =item B<part_size>
4246
4247 Size of the partition in bytes.
4248
4249 =back");
4250
4251   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4252    [InitEmpty, Always, TestOutput (
4253       [["part_disk"; "/dev/sda"; "gpt"];
4254        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4255    "get the partition table type",
4256    "\
4257 This command examines the partition table on C<device> and
4258 returns the partition table type (format) being used.
4259
4260 Common return values include: C<msdos> (a DOS/Windows style MBR
4261 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4262 values are possible, although unusual.  See C<guestfs_part_init>
4263 for a full list.");
4264
4265   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4266    [InitBasicFS, Always, TestOutputBuffer (
4267       [["fill"; "0x63"; "10"; "/test"];
4268        ["read_file"; "/test"]], "cccccccccc")],
4269    "fill a file with octets",
4270    "\
4271 This command creates a new file called C<path>.  The initial
4272 content of the file is C<len> octets of C<c>, where C<c>
4273 must be a number in the range C<[0..255]>.
4274
4275 To fill a file with zero bytes (sparsely), it is
4276 much more efficient to use C<guestfs_truncate_size>.");
4277
4278   ("available", (RErr, [StringList "groups"]), 216, [],
4279    [InitNone, Always, TestRun [["available"; ""]]],
4280    "test availability of some parts of the API",
4281    "\
4282 This command is used to check the availability of some
4283 groups of functionality in the appliance, which not all builds of
4284 the libguestfs appliance will be able to provide.
4285
4286 The libguestfs groups, and the functions that those
4287 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4288
4289 The argument C<groups> is a list of group names, eg:
4290 C<[\"inotify\", \"augeas\"]> would check for the availability of
4291 the Linux inotify functions and Augeas (configuration file
4292 editing) functions.
4293
4294 The command returns no error if I<all> requested groups are available.
4295
4296 It fails with an error if one or more of the requested
4297 groups is unavailable in the appliance.
4298
4299 If an unknown group name is included in the
4300 list of groups then an error is always returned.
4301
4302 I<Notes:>
4303
4304 =over 4
4305
4306 =item *
4307
4308 You must call C<guestfs_launch> before calling this function.
4309
4310 The reason is because we don't know what groups are
4311 supported by the appliance/daemon until it is running and can
4312 be queried.
4313
4314 =item *
4315
4316 If a group of functions is available, this does not necessarily
4317 mean that they will work.  You still have to check for errors
4318 when calling individual API functions even if they are
4319 available.
4320
4321 =item *
4322
4323 It is usually the job of distro packagers to build
4324 complete functionality into the libguestfs appliance.
4325 Upstream libguestfs, if built from source with all
4326 requirements satisfied, will support everything.
4327
4328 =item *
4329
4330 This call was added in version C<1.0.80>.  In previous
4331 versions of libguestfs all you could do would be to speculatively
4332 execute a command to find out if the daemon implemented it.
4333 See also C<guestfs_version>.
4334
4335 =back");
4336
4337   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4338    [InitBasicFS, Always, TestOutputBuffer (
4339       [["write_file"; "/src"; "hello, world"; "0"];
4340        ["dd"; "/src"; "/dest"];
4341        ["read_file"; "/dest"]], "hello, world")],
4342    "copy from source to destination using dd",
4343    "\
4344 This command copies from one source device or file C<src>
4345 to another destination device or file C<dest>.  Normally you
4346 would use this to copy to or from a device or partition, for
4347 example to duplicate a filesystem.
4348
4349 If the destination is a device, it must be as large or larger
4350 than the source file or device, otherwise the copy will fail.
4351 This command cannot do partial copies (see C<guestfs_copy_size>).");
4352
4353   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4354    [InitBasicFS, Always, TestOutputInt (
4355       [["write_file"; "/file"; "hello, world"; "0"];
4356        ["filesize"; "/file"]], 12)],
4357    "return the size of the file in bytes",
4358    "\
4359 This command returns the size of C<file> in bytes.
4360
4361 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4362 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4363 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4364
4365   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4366    [InitBasicFSonLVM, Always, TestOutputList (
4367       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4368        ["lvs"]], ["/dev/VG/LV2"])],
4369    "rename an LVM logical volume",
4370    "\
4371 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4372
4373   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4374    [InitBasicFSonLVM, Always, TestOutputList (
4375       [["umount"; "/"];
4376        ["vg_activate"; "false"; "VG"];
4377        ["vgrename"; "VG"; "VG2"];
4378        ["vg_activate"; "true"; "VG2"];
4379        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4380        ["vgs"]], ["VG2"])],
4381    "rename an LVM volume group",
4382    "\
4383 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4384
4385   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4386    [InitISOFS, Always, TestOutputBuffer (
4387       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4388    "list the contents of a single file in an initrd",
4389    "\
4390 This command unpacks the file C<filename> from the initrd file
4391 called C<initrdpath>.  The filename must be given I<without> the
4392 initial C</> character.
4393
4394 For example, in guestfish you could use the following command
4395 to examine the boot script (usually called C</init>)
4396 contained in a Linux initrd or initramfs image:
4397
4398  initrd-cat /boot/initrd-<version>.img init
4399
4400 See also C<guestfs_initrd_list>.");
4401
4402   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4403    [],
4404    "get the UUID of a physical volume",
4405    "\
4406 This command returns the UUID of the LVM PV C<device>.");
4407
4408   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4409    [],
4410    "get the UUID of a volume group",
4411    "\
4412 This command returns the UUID of the LVM VG named C<vgname>.");
4413
4414   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4415    [],
4416    "get the UUID of a logical volume",
4417    "\
4418 This command returns the UUID of the LVM LV C<device>.");
4419
4420   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4421    [],
4422    "get the PV UUIDs containing the volume group",
4423    "\
4424 Given a VG called C<vgname>, this returns the UUIDs of all
4425 the physical volumes that this volume group resides on.
4426
4427 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4428 calls to associate physical volumes and volume groups.
4429
4430 See also C<guestfs_vglvuuids>.");
4431
4432   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4433    [],
4434    "get the LV UUIDs of all LVs in the volume group",
4435    "\
4436 Given a VG called C<vgname>, this returns the UUIDs of all
4437 the logical volumes created in this volume group.
4438
4439 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4440 calls to associate logical volumes and volume groups.
4441
4442 See also C<guestfs_vgpvuuids>.");
4443
4444   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4445    [InitBasicFS, Always, TestOutputBuffer (
4446       [["write_file"; "/src"; "hello, world"; "0"];
4447        ["copy_size"; "/src"; "/dest"; "5"];
4448        ["read_file"; "/dest"]], "hello")],
4449    "copy size bytes from source to destination using dd",
4450    "\
4451 This command copies exactly C<size> bytes from one source device
4452 or file C<src> to another destination device or file C<dest>.
4453
4454 Note this will fail if the source is too short or if the destination
4455 is not large enough.");
4456
4457   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4458    [InitEmpty, Always, TestRun (
4459       [["part_init"; "/dev/sda"; "mbr"];
4460        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4461        ["part_del"; "/dev/sda"; "1"]])],
4462    "delete a partition",
4463    "\
4464 This command deletes the partition numbered C<partnum> on C<device>.
4465
4466 Note that in the case of MBR partitioning, deleting an
4467 extended partition also deletes any logical partitions
4468 it contains.");
4469
4470   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4471    [InitEmpty, Always, TestOutputTrue (
4472       [["part_init"; "/dev/sda"; "mbr"];
4473        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4474        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4475        ["part_get_bootable"; "/dev/sda"; "1"]])],
4476    "return true if a partition is bootable",
4477    "\
4478 This command returns true if the partition C<partnum> on
4479 C<device> has the bootable flag set.
4480
4481 See also C<guestfs_part_set_bootable>.");
4482
4483   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4484    [InitEmpty, Always, TestOutputInt (
4485       [["part_init"; "/dev/sda"; "mbr"];
4486        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4487        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4488        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4489    "get the MBR type byte (ID byte) from a partition",
4490    "\
4491 Returns the MBR type byte (also known as the ID byte) from
4492 the numbered partition C<partnum>.
4493
4494 Note that only MBR (old DOS-style) partitions have type bytes.
4495 You will get undefined results for other partition table
4496 types (see C<guestfs_part_get_parttype>).");
4497
4498   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4499    [], (* tested by part_get_mbr_id *)
4500    "set the MBR type byte (ID byte) of a partition",
4501    "\
4502 Sets the MBR type byte (also known as the ID byte) of
4503 the numbered partition C<partnum> to C<idbyte>.  Note
4504 that the type bytes quoted in most documentation are
4505 in fact hexadecimal numbers, but usually documented
4506 without any leading \"0x\" which might be confusing.
4507
4508 Note that only MBR (old DOS-style) partitions have type bytes.
4509 You will get undefined results for other partition table
4510 types (see C<guestfs_part_get_parttype>).");
4511
4512 ]
4513
4514 let all_functions = non_daemon_functions @ daemon_functions
4515
4516 (* In some places we want the functions to be displayed sorted
4517  * alphabetically, so this is useful:
4518  *)
4519 let all_functions_sorted =
4520   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4521                compare n1 n2) all_functions
4522
4523 (* Field types for structures. *)
4524 type field =
4525   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4526   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4527   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4528   | FUInt32
4529   | FInt32
4530   | FUInt64
4531   | FInt64
4532   | FBytes                      (* Any int measure that counts bytes. *)
4533   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4534   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4535
4536 (* Because we generate extra parsing code for LVM command line tools,
4537  * we have to pull out the LVM columns separately here.
4538  *)
4539 let lvm_pv_cols = [
4540   "pv_name", FString;
4541   "pv_uuid", FUUID;
4542   "pv_fmt", FString;
4543   "pv_size", FBytes;
4544   "dev_size", FBytes;
4545   "pv_free", FBytes;
4546   "pv_used", FBytes;
4547   "pv_attr", FString (* XXX *);
4548   "pv_pe_count", FInt64;
4549   "pv_pe_alloc_count", FInt64;
4550   "pv_tags", FString;
4551   "pe_start", FBytes;
4552   "pv_mda_count", FInt64;
4553   "pv_mda_free", FBytes;
4554   (* Not in Fedora 10:
4555      "pv_mda_size", FBytes;
4556   *)
4557 ]
4558 let lvm_vg_cols = [
4559   "vg_name", FString;
4560   "vg_uuid", FUUID;
4561   "vg_fmt", FString;
4562   "vg_attr", FString (* XXX *);
4563   "vg_size", FBytes;
4564   "vg_free", FBytes;
4565   "vg_sysid", FString;
4566   "vg_extent_size", FBytes;
4567   "vg_extent_count", FInt64;
4568   "vg_free_count", FInt64;
4569   "max_lv", FInt64;
4570   "max_pv", FInt64;
4571   "pv_count", FInt64;
4572   "lv_count", FInt64;
4573   "snap_count", FInt64;
4574   "vg_seqno", FInt64;
4575   "vg_tags", FString;
4576   "vg_mda_count", FInt64;
4577   "vg_mda_free", FBytes;
4578   (* Not in Fedora 10:
4579      "vg_mda_size", FBytes;
4580   *)
4581 ]
4582 let lvm_lv_cols = [
4583   "lv_name", FString;
4584   "lv_uuid", FUUID;
4585   "lv_attr", FString (* XXX *);
4586   "lv_major", FInt64;
4587   "lv_minor", FInt64;
4588   "lv_kernel_major", FInt64;
4589   "lv_kernel_minor", FInt64;
4590   "lv_size", FBytes;
4591   "seg_count", FInt64;
4592   "origin", FString;
4593   "snap_percent", FOptPercent;
4594   "copy_percent", FOptPercent;
4595   "move_pv", FString;
4596   "lv_tags", FString;
4597   "mirror_log", FString;
4598   "modules", FString;
4599 ]
4600
4601 (* Names and fields in all structures (in RStruct and RStructList)
4602  * that we support.
4603  *)
4604 let structs = [
4605   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4606    * not use this struct in any new code.
4607    *)
4608   "int_bool", [
4609     "i", FInt32;                (* for historical compatibility *)
4610     "b", FInt32;                (* for historical compatibility *)
4611   ];
4612
4613   (* LVM PVs, VGs, LVs. *)
4614   "lvm_pv", lvm_pv_cols;
4615   "lvm_vg", lvm_vg_cols;
4616   "lvm_lv", lvm_lv_cols;
4617
4618   (* Column names and types from stat structures.
4619    * NB. Can't use things like 'st_atime' because glibc header files
4620    * define some of these as macros.  Ugh.
4621    *)
4622   "stat", [
4623     "dev", FInt64;
4624     "ino", FInt64;
4625     "mode", FInt64;
4626     "nlink", FInt64;
4627     "uid", FInt64;
4628     "gid", FInt64;
4629     "rdev", FInt64;
4630     "size", FInt64;
4631     "blksize", FInt64;
4632     "blocks", FInt64;
4633     "atime", FInt64;
4634     "mtime", FInt64;
4635     "ctime", FInt64;
4636   ];
4637   "statvfs", [
4638     "bsize", FInt64;
4639     "frsize", FInt64;
4640     "blocks", FInt64;
4641     "bfree", FInt64;
4642     "bavail", FInt64;
4643     "files", FInt64;
4644     "ffree", FInt64;
4645     "favail", FInt64;
4646     "fsid", FInt64;
4647     "flag", FInt64;
4648     "namemax", FInt64;
4649   ];
4650
4651   (* Column names in dirent structure. *)
4652   "dirent", [
4653     "ino", FInt64;
4654     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4655     "ftyp", FChar;
4656     "name", FString;
4657   ];
4658
4659   (* Version numbers. *)
4660   "version", [
4661     "major", FInt64;
4662     "minor", FInt64;
4663     "release", FInt64;
4664     "extra", FString;
4665   ];
4666
4667   (* Extended attribute. *)
4668   "xattr", [
4669     "attrname", FString;
4670     "attrval", FBuffer;
4671   ];
4672
4673   (* Inotify events. *)
4674   "inotify_event", [
4675     "in_wd", FInt64;
4676     "in_mask", FUInt32;
4677     "in_cookie", FUInt32;
4678     "in_name", FString;
4679   ];
4680
4681   (* Partition table entry. *)
4682   "partition", [
4683     "part_num", FInt32;
4684     "part_start", FBytes;
4685     "part_end", FBytes;
4686     "part_size", FBytes;
4687   ];
4688 ] (* end of structs *)
4689
4690 (* Ugh, Java has to be different ..
4691  * These names are also used by the Haskell bindings.
4692  *)
4693 let java_structs = [
4694   "int_bool", "IntBool";
4695   "lvm_pv", "PV";
4696   "lvm_vg", "VG";
4697   "lvm_lv", "LV";
4698   "stat", "Stat";
4699   "statvfs", "StatVFS";
4700   "dirent", "Dirent";
4701   "version", "Version";
4702   "xattr", "XAttr";
4703   "inotify_event", "INotifyEvent";
4704   "partition", "Partition";
4705 ]
4706
4707 (* What structs are actually returned. *)
4708 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4709
4710 (* Returns a list of RStruct/RStructList structs that are returned
4711  * by any function.  Each element of returned list is a pair:
4712  *
4713  * (structname, RStructOnly)
4714  *    == there exists function which returns RStruct (_, structname)
4715  * (structname, RStructListOnly)
4716  *    == there exists function which returns RStructList (_, structname)
4717  * (structname, RStructAndList)
4718  *    == there are functions returning both RStruct (_, structname)
4719  *                                      and RStructList (_, structname)
4720  *)
4721 let rstructs_used_by functions =
4722   (* ||| is a "logical OR" for rstructs_used_t *)
4723   let (|||) a b =
4724     match a, b with
4725     | RStructAndList, _
4726     | _, RStructAndList -> RStructAndList
4727     | RStructOnly, RStructListOnly
4728     | RStructListOnly, RStructOnly -> RStructAndList
4729     | RStructOnly, RStructOnly -> RStructOnly
4730     | RStructListOnly, RStructListOnly -> RStructListOnly
4731   in
4732
4733   let h = Hashtbl.create 13 in
4734
4735   (* if elem->oldv exists, update entry using ||| operator,
4736    * else just add elem->newv to the hash
4737    *)
4738   let update elem newv =
4739     try  let oldv = Hashtbl.find h elem in
4740          Hashtbl.replace h elem (newv ||| oldv)
4741     with Not_found -> Hashtbl.add h elem newv
4742   in
4743
4744   List.iter (
4745     fun (_, style, _, _, _, _, _) ->
4746       match fst style with
4747       | RStruct (_, structname) -> update structname RStructOnly
4748       | RStructList (_, structname) -> update structname RStructListOnly
4749       | _ -> ()
4750   ) functions;
4751
4752   (* return key->values as a list of (key,value) *)
4753   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4754
4755 (* Used for testing language bindings. *)
4756 type callt =
4757   | CallString of string
4758   | CallOptString of string option
4759   | CallStringList of string list
4760   | CallInt of int
4761   | CallInt64 of int64
4762   | CallBool of bool
4763
4764 (* Used to memoize the result of pod2text. *)
4765 let pod2text_memo_filename = "src/.pod2text.data"
4766 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4767   try
4768     let chan = open_in pod2text_memo_filename in
4769     let v = input_value chan in
4770     close_in chan;
4771     v
4772   with
4773     _ -> Hashtbl.create 13
4774 let pod2text_memo_updated () =
4775   let chan = open_out pod2text_memo_filename in
4776   output_value chan pod2text_memo;
4777   close_out chan
4778
4779 (* Useful functions.
4780  * Note we don't want to use any external OCaml libraries which
4781  * makes this a bit harder than it should be.
4782  *)
4783 module StringMap = Map.Make (String)
4784
4785 let failwithf fs = ksprintf failwith fs
4786
4787 let unique = let i = ref 0 in fun () -> incr i; !i
4788
4789 let replace_char s c1 c2 =
4790   let s2 = String.copy s in
4791   let r = ref false in
4792   for i = 0 to String.length s2 - 1 do
4793     if String.unsafe_get s2 i = c1 then (
4794       String.unsafe_set s2 i c2;
4795       r := true
4796     )
4797   done;
4798   if not !r then s else s2
4799
4800 let isspace c =
4801   c = ' '
4802   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4803
4804 let triml ?(test = isspace) str =
4805   let i = ref 0 in
4806   let n = ref (String.length str) in
4807   while !n > 0 && test str.[!i]; do
4808     decr n;
4809     incr i
4810   done;
4811   if !i = 0 then str
4812   else String.sub str !i !n
4813
4814 let trimr ?(test = isspace) str =
4815   let n = ref (String.length str) in
4816   while !n > 0 && test str.[!n-1]; do
4817     decr n
4818   done;
4819   if !n = String.length str then str
4820   else String.sub str 0 !n
4821
4822 let trim ?(test = isspace) str =
4823   trimr ~test (triml ~test str)
4824
4825 let rec find s sub =
4826   let len = String.length s in
4827   let sublen = String.length sub in
4828   let rec loop i =
4829     if i <= len-sublen then (
4830       let rec loop2 j =
4831         if j < sublen then (
4832           if s.[i+j] = sub.[j] then loop2 (j+1)
4833           else -1
4834         ) else
4835           i (* found *)
4836       in
4837       let r = loop2 0 in
4838       if r = -1 then loop (i+1) else r
4839     ) else
4840       -1 (* not found *)
4841   in
4842   loop 0
4843
4844 let rec replace_str s s1 s2 =
4845   let len = String.length s in
4846   let sublen = String.length s1 in
4847   let i = find s s1 in
4848   if i = -1 then s
4849   else (
4850     let s' = String.sub s 0 i in
4851     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4852     s' ^ s2 ^ replace_str s'' s1 s2
4853   )
4854
4855 let rec string_split sep str =
4856   let len = String.length str in
4857   let seplen = String.length sep in
4858   let i = find str sep in
4859   if i = -1 then [str]
4860   else (
4861     let s' = String.sub str 0 i in
4862     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4863     s' :: string_split sep s''
4864   )
4865
4866 let files_equal n1 n2 =
4867   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4868   match Sys.command cmd with
4869   | 0 -> true
4870   | 1 -> false
4871   | i -> failwithf "%s: failed with error code %d" cmd i
4872
4873 let rec filter_map f = function
4874   | [] -> []
4875   | x :: xs ->
4876       match f x with
4877       | Some y -> y :: filter_map f xs
4878       | None -> filter_map f xs
4879
4880 let rec find_map f = function
4881   | [] -> raise Not_found
4882   | x :: xs ->
4883       match f x with
4884       | Some y -> y
4885       | None -> find_map f xs
4886
4887 let iteri f xs =
4888   let rec loop i = function
4889     | [] -> ()
4890     | x :: xs -> f i x; loop (i+1) xs
4891   in
4892   loop 0 xs
4893
4894 let mapi f xs =
4895   let rec loop i = function
4896     | [] -> []
4897     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4898   in
4899   loop 0 xs
4900
4901 let count_chars c str =
4902   let count = ref 0 in
4903   for i = 0 to String.length str - 1 do
4904     if c = String.unsafe_get str i then incr count
4905   done;
4906   !count
4907
4908 let name_of_argt = function
4909   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4910   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4911   | FileIn n | FileOut n -> n
4912
4913 let java_name_of_struct typ =
4914   try List.assoc typ java_structs
4915   with Not_found ->
4916     failwithf
4917       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4918
4919 let cols_of_struct typ =
4920   try List.assoc typ structs
4921   with Not_found ->
4922     failwithf "cols_of_struct: unknown struct %s" typ
4923
4924 let seq_of_test = function
4925   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4926   | TestOutputListOfDevices (s, _)
4927   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4928   | TestOutputTrue s | TestOutputFalse s
4929   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4930   | TestOutputStruct (s, _)
4931   | TestLastFail s -> s
4932
4933 (* Handling for function flags. *)
4934 let protocol_limit_warning =
4935   "Because of the message protocol, there is a transfer limit
4936 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4937
4938 let danger_will_robinson =
4939   "B<This command is dangerous.  Without careful use you
4940 can easily destroy all your data>."
4941
4942 let deprecation_notice flags =
4943   try
4944     let alt =
4945       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4946     let txt =
4947       sprintf "This function is deprecated.
4948 In new code, use the C<%s> call instead.
4949
4950 Deprecated functions will not be removed from the API, but the
4951 fact that they are deprecated indicates that there are problems
4952 with correct use of these functions." alt in
4953     Some txt
4954   with
4955     Not_found -> None
4956
4957 (* Create list of optional groups. *)
4958 let optgroups =
4959   let h = Hashtbl.create 13 in
4960   List.iter (
4961     fun (name, _, _, flags, _, _, _) ->
4962       List.iter (
4963         function
4964         | Optional group ->
4965             let names = try Hashtbl.find h group with Not_found -> [] in
4966             Hashtbl.replace h group (name :: names)
4967         | _ -> ()
4968       ) flags
4969   ) daemon_functions;
4970   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4971   let groups =
4972     List.map (
4973       fun group -> group, List.sort compare (Hashtbl.find h group)
4974     ) groups in
4975   List.sort (fun x y -> compare (fst x) (fst y)) groups
4976
4977 (* Check function names etc. for consistency. *)
4978 let check_functions () =
4979   let contains_uppercase str =
4980     let len = String.length str in
4981     let rec loop i =
4982       if i >= len then false
4983       else (
4984         let c = str.[i] in
4985         if c >= 'A' && c <= 'Z' then true
4986         else loop (i+1)
4987       )
4988     in
4989     loop 0
4990   in
4991
4992   (* Check function names. *)
4993   List.iter (
4994     fun (name, _, _, _, _, _, _) ->
4995       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4996         failwithf "function name %s does not need 'guestfs' prefix" name;
4997       if name = "" then
4998         failwithf "function name is empty";
4999       if name.[0] < 'a' || name.[0] > 'z' then
5000         failwithf "function name %s must start with lowercase a-z" name;
5001       if String.contains name '-' then
5002         failwithf "function name %s should not contain '-', use '_' instead."
5003           name
5004   ) all_functions;
5005
5006   (* Check function parameter/return names. *)
5007   List.iter (
5008     fun (name, style, _, _, _, _, _) ->
5009       let check_arg_ret_name n =
5010         if contains_uppercase n then
5011           failwithf "%s param/ret %s should not contain uppercase chars"
5012             name n;
5013         if String.contains n '-' || String.contains n '_' then
5014           failwithf "%s param/ret %s should not contain '-' or '_'"
5015             name n;
5016         if n = "value" then
5017           failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
5018         if n = "int" || n = "char" || n = "short" || n = "long" then
5019           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5020         if n = "i" || n = "n" then
5021           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5022         if n = "argv" || n = "args" then
5023           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5024
5025         (* List Haskell, OCaml and C keywords here.
5026          * http://www.haskell.org/haskellwiki/Keywords
5027          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5028          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5029          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5030          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5031          * Omitting _-containing words, since they're handled above.
5032          * Omitting the OCaml reserved word, "val", is ok,
5033          * and saves us from renaming several parameters.
5034          *)
5035         let reserved = [
5036           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5037           "char"; "class"; "const"; "constraint"; "continue"; "data";
5038           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5039           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5040           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5041           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5042           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5043           "interface";
5044           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5045           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5046           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5047           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5048           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5049           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5050           "volatile"; "when"; "where"; "while";
5051           ] in
5052         if List.mem n reserved then
5053           failwithf "%s has param/ret using reserved word %s" name n;
5054       in
5055
5056       (match fst style with
5057        | RErr -> ()
5058        | RInt n | RInt64 n | RBool n
5059        | RConstString n | RConstOptString n | RString n
5060        | RStringList n | RStruct (n, _) | RStructList (n, _)
5061        | RHashtable n | RBufferOut n ->
5062            check_arg_ret_name n
5063       );
5064       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5065   ) all_functions;
5066
5067   (* Check short descriptions. *)
5068   List.iter (
5069     fun (name, _, _, _, _, shortdesc, _) ->
5070       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5071         failwithf "short description of %s should begin with lowercase." name;
5072       let c = shortdesc.[String.length shortdesc-1] in
5073       if c = '\n' || c = '.' then
5074         failwithf "short description of %s should not end with . or \\n." name
5075   ) all_functions;
5076
5077   (* Check long descriptions. *)
5078   List.iter (
5079     fun (name, _, _, _, _, _, longdesc) ->
5080       if longdesc.[String.length longdesc-1] = '\n' then
5081         failwithf "long description of %s should not end with \\n." name
5082   ) all_functions;
5083
5084   (* Check proc_nrs. *)
5085   List.iter (
5086     fun (name, _, proc_nr, _, _, _, _) ->
5087       if proc_nr <= 0 then
5088         failwithf "daemon function %s should have proc_nr > 0" name
5089   ) daemon_functions;
5090
5091   List.iter (
5092     fun (name, _, proc_nr, _, _, _, _) ->
5093       if proc_nr <> -1 then
5094         failwithf "non-daemon function %s should have proc_nr -1" name
5095   ) non_daemon_functions;
5096
5097   let proc_nrs =
5098     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5099       daemon_functions in
5100   let proc_nrs =
5101     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5102   let rec loop = function
5103     | [] -> ()
5104     | [_] -> ()
5105     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5106         loop rest
5107     | (name1,nr1) :: (name2,nr2) :: _ ->
5108         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5109           name1 name2 nr1 nr2
5110   in
5111   loop proc_nrs;
5112
5113   (* Check tests. *)
5114   List.iter (
5115     function
5116       (* Ignore functions that have no tests.  We generate a
5117        * warning when the user does 'make check' instead.
5118        *)
5119     | name, _, _, _, [], _, _ -> ()
5120     | name, _, _, _, tests, _, _ ->
5121         let funcs =
5122           List.map (
5123             fun (_, _, test) ->
5124               match seq_of_test test with
5125               | [] ->
5126                   failwithf "%s has a test containing an empty sequence" name
5127               | cmds -> List.map List.hd cmds
5128           ) tests in
5129         let funcs = List.flatten funcs in
5130
5131         let tested = List.mem name funcs in
5132
5133         if not tested then
5134           failwithf "function %s has tests but does not test itself" name
5135   ) all_functions
5136
5137 (* 'pr' prints to the current output file. *)
5138 let chan = ref Pervasives.stdout
5139 let lines = ref 0
5140 let pr fs =
5141   ksprintf
5142     (fun str ->
5143        let i = count_chars '\n' str in
5144        lines := !lines + i;
5145        output_string !chan str
5146     ) fs
5147
5148 let copyright_years =
5149   let this_year = 1900 + (localtime (time ())).tm_year in
5150   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5151
5152 (* Generate a header block in a number of standard styles. *)
5153 type comment_style =
5154     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5155 type license = GPLv2plus | LGPLv2plus
5156
5157 let generate_header ?(extra_inputs = []) comment license =
5158   let inputs = "src/generator.ml" :: extra_inputs in
5159   let c = match comment with
5160     | CStyle ->         pr "/* "; " *"
5161     | CPlusPlusStyle -> pr "// "; "//"
5162     | HashStyle ->      pr "# ";  "#"
5163     | OCamlStyle ->     pr "(* "; " *"
5164     | HaskellStyle ->   pr "{- "; "  " in
5165   pr "libguestfs generated file\n";
5166   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5167   List.iter (pr "%s   %s\n" c) inputs;
5168   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5169   pr "%s\n" c;
5170   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5171   pr "%s\n" c;
5172   (match license with
5173    | GPLv2plus ->
5174        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5175        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5176        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5177        pr "%s (at your option) any later version.\n" c;
5178        pr "%s\n" c;
5179        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5180        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5181        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5182        pr "%s GNU General Public License for more details.\n" c;
5183        pr "%s\n" c;
5184        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5185        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5186        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5187
5188    | LGPLv2plus ->
5189        pr "%s This library is free software; you can redistribute it and/or\n" c;
5190        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5191        pr "%s License as published by the Free Software Foundation; either\n" c;
5192        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5193        pr "%s\n" c;
5194        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5195        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5196        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5197        pr "%s Lesser General Public License for more details.\n" c;
5198        pr "%s\n" c;
5199        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5200        pr "%s License along with this library; if not, write to the Free Software\n" c;
5201        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5202   );
5203   (match comment with
5204    | CStyle -> pr " */\n"
5205    | CPlusPlusStyle
5206    | HashStyle -> ()
5207    | OCamlStyle -> pr " *)\n"
5208    | HaskellStyle -> pr "-}\n"
5209   );
5210   pr "\n"
5211
5212 (* Start of main code generation functions below this line. *)
5213
5214 (* Generate the pod documentation for the C API. *)
5215 let rec generate_actions_pod () =
5216   List.iter (
5217     fun (shortname, style, _, flags, _, _, longdesc) ->
5218       if not (List.mem NotInDocs flags) then (
5219         let name = "guestfs_" ^ shortname in
5220         pr "=head2 %s\n\n" name;
5221         pr " ";
5222         generate_prototype ~extern:false ~handle:"g" name style;
5223         pr "\n\n";
5224         pr "%s\n\n" longdesc;
5225         (match fst style with
5226          | RErr ->
5227              pr "This function returns 0 on success or -1 on error.\n\n"
5228          | RInt _ ->
5229              pr "On error this function returns -1.\n\n"
5230          | RInt64 _ ->
5231              pr "On error this function returns -1.\n\n"
5232          | RBool _ ->
5233              pr "This function returns a C truth value on success or -1 on error.\n\n"
5234          | RConstString _ ->
5235              pr "This function returns a string, or NULL on error.
5236 The string is owned by the guest handle and must I<not> be freed.\n\n"
5237          | RConstOptString _ ->
5238              pr "This function returns a string which may be NULL.
5239 There is no way to return an error from this function.
5240 The string is owned by the guest handle and must I<not> be freed.\n\n"
5241          | RString _ ->
5242              pr "This function returns a string, or NULL on error.
5243 I<The caller must free the returned string after use>.\n\n"
5244          | RStringList _ ->
5245              pr "This function returns a NULL-terminated array of strings
5246 (like L<environ(3)>), or NULL if there was an error.
5247 I<The caller must free the strings and the array after use>.\n\n"
5248          | RStruct (_, typ) ->
5249              pr "This function returns a C<struct guestfs_%s *>,
5250 or NULL if there was an error.
5251 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5252          | RStructList (_, typ) ->
5253              pr "This function returns a C<struct guestfs_%s_list *>
5254 (see E<lt>guestfs-structs.hE<gt>),
5255 or NULL if there was an error.
5256 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5257          | RHashtable _ ->
5258              pr "This function returns a NULL-terminated array of
5259 strings, or NULL if there was an error.
5260 The array of strings will always have length C<2n+1>, where
5261 C<n> keys and values alternate, followed by the trailing NULL entry.
5262 I<The caller must free the strings and the array after use>.\n\n"
5263          | RBufferOut _ ->
5264              pr "This function returns a buffer, or NULL on error.
5265 The size of the returned buffer is written to C<*size_r>.
5266 I<The caller must free the returned buffer after use>.\n\n"
5267         );
5268         if List.mem ProtocolLimitWarning flags then
5269           pr "%s\n\n" protocol_limit_warning;
5270         if List.mem DangerWillRobinson flags then
5271           pr "%s\n\n" danger_will_robinson;
5272         match deprecation_notice flags with
5273         | None -> ()
5274         | Some txt -> pr "%s\n\n" txt
5275       )
5276   ) all_functions_sorted
5277
5278 and generate_structs_pod () =
5279   (* Structs documentation. *)
5280   List.iter (
5281     fun (typ, cols) ->
5282       pr "=head2 guestfs_%s\n" typ;
5283       pr "\n";
5284       pr " struct guestfs_%s {\n" typ;
5285       List.iter (
5286         function
5287         | name, FChar -> pr "   char %s;\n" name
5288         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5289         | name, FInt32 -> pr "   int32_t %s;\n" name
5290         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5291         | name, FInt64 -> pr "   int64_t %s;\n" name
5292         | name, FString -> pr "   char *%s;\n" name
5293         | name, FBuffer ->
5294             pr "   /* The next two fields describe a byte array. */\n";
5295             pr "   uint32_t %s_len;\n" name;
5296             pr "   char *%s;\n" name
5297         | name, FUUID ->
5298             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5299             pr "   char %s[32];\n" name
5300         | name, FOptPercent ->
5301             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5302             pr "   float %s;\n" name
5303       ) cols;
5304       pr " };\n";
5305       pr " \n";
5306       pr " struct guestfs_%s_list {\n" typ;
5307       pr "   uint32_t len; /* Number of elements in list. */\n";
5308       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5309       pr " };\n";
5310       pr " \n";
5311       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5312       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5313         typ typ;
5314       pr "\n"
5315   ) structs
5316
5317 and generate_availability_pod () =
5318   (* Availability documentation. *)
5319   pr "=over 4\n";
5320   pr "\n";
5321   List.iter (
5322     fun (group, functions) ->
5323       pr "=item B<%s>\n" group;
5324       pr "\n";
5325       pr "The following functions:\n";
5326       List.iter (pr "L</guestfs_%s>\n") functions;
5327       pr "\n"
5328   ) optgroups;
5329   pr "=back\n";
5330   pr "\n"
5331
5332 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5333  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5334  *
5335  * We have to use an underscore instead of a dash because otherwise
5336  * rpcgen generates incorrect code.
5337  *
5338  * This header is NOT exported to clients, but see also generate_structs_h.
5339  *)
5340 and generate_xdr () =
5341   generate_header CStyle LGPLv2plus;
5342
5343   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5344   pr "typedef string str<>;\n";
5345   pr "\n";
5346
5347   (* Internal structures. *)
5348   List.iter (
5349     function
5350     | typ, cols ->
5351         pr "struct guestfs_int_%s {\n" typ;
5352         List.iter (function
5353                    | name, FChar -> pr "  char %s;\n" name
5354                    | name, FString -> pr "  string %s<>;\n" name
5355                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5356                    | name, FUUID -> pr "  opaque %s[32];\n" name
5357                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5358                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5359                    | name, FOptPercent -> pr "  float %s;\n" name
5360                   ) cols;
5361         pr "};\n";
5362         pr "\n";
5363         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5364         pr "\n";
5365   ) structs;
5366
5367   List.iter (
5368     fun (shortname, style, _, _, _, _, _) ->
5369       let name = "guestfs_" ^ shortname in
5370
5371       (match snd style with
5372        | [] -> ()
5373        | args ->
5374            pr "struct %s_args {\n" name;
5375            List.iter (
5376              function
5377              | Pathname n | Device n | Dev_or_Path n | String n ->
5378                  pr "  string %s<>;\n" n
5379              | OptString n -> pr "  str *%s;\n" n
5380              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5381              | Bool n -> pr "  bool %s;\n" n
5382              | Int n -> pr "  int %s;\n" n
5383              | Int64 n -> pr "  hyper %s;\n" n
5384              | FileIn _ | FileOut _ -> ()
5385            ) args;
5386            pr "};\n\n"
5387       );
5388       (match fst style with
5389        | RErr -> ()
5390        | RInt n ->
5391            pr "struct %s_ret {\n" name;
5392            pr "  int %s;\n" n;
5393            pr "};\n\n"
5394        | RInt64 n ->
5395            pr "struct %s_ret {\n" name;
5396            pr "  hyper %s;\n" n;
5397            pr "};\n\n"
5398        | RBool n ->
5399            pr "struct %s_ret {\n" name;
5400            pr "  bool %s;\n" n;
5401            pr "};\n\n"
5402        | RConstString _ | RConstOptString _ ->
5403            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5404        | RString n ->
5405            pr "struct %s_ret {\n" name;
5406            pr "  string %s<>;\n" n;
5407            pr "};\n\n"
5408        | RStringList n ->
5409            pr "struct %s_ret {\n" name;
5410            pr "  str %s<>;\n" n;
5411            pr "};\n\n"
5412        | RStruct (n, typ) ->
5413            pr "struct %s_ret {\n" name;
5414            pr "  guestfs_int_%s %s;\n" typ n;
5415            pr "};\n\n"
5416        | RStructList (n, typ) ->
5417            pr "struct %s_ret {\n" name;
5418            pr "  guestfs_int_%s_list %s;\n" typ n;
5419            pr "};\n\n"
5420        | RHashtable n ->
5421            pr "struct %s_ret {\n" name;
5422            pr "  str %s<>;\n" n;
5423            pr "};\n\n"
5424        | RBufferOut n ->
5425            pr "struct %s_ret {\n" name;
5426            pr "  opaque %s<>;\n" n;
5427            pr "};\n\n"
5428       );
5429   ) daemon_functions;
5430
5431   (* Table of procedure numbers. *)
5432   pr "enum guestfs_procedure {\n";
5433   List.iter (
5434     fun (shortname, _, proc_nr, _, _, _, _) ->
5435       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5436   ) daemon_functions;
5437   pr "  GUESTFS_PROC_NR_PROCS\n";
5438   pr "};\n";
5439   pr "\n";
5440
5441   (* Having to choose a maximum message size is annoying for several
5442    * reasons (it limits what we can do in the API), but it (a) makes
5443    * the protocol a lot simpler, and (b) provides a bound on the size
5444    * of the daemon which operates in limited memory space.
5445    *)
5446   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5447   pr "\n";
5448
5449   (* Message header, etc. *)
5450   pr "\
5451 /* The communication protocol is now documented in the guestfs(3)
5452  * manpage.
5453  */
5454
5455 const GUESTFS_PROGRAM = 0x2000F5F5;
5456 const GUESTFS_PROTOCOL_VERSION = 1;
5457
5458 /* These constants must be larger than any possible message length. */
5459 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5460 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5461
5462 enum guestfs_message_direction {
5463   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5464   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5465 };
5466
5467 enum guestfs_message_status {
5468   GUESTFS_STATUS_OK = 0,
5469   GUESTFS_STATUS_ERROR = 1
5470 };
5471
5472 const GUESTFS_ERROR_LEN = 256;
5473
5474 struct guestfs_message_error {
5475   string error_message<GUESTFS_ERROR_LEN>;
5476 };
5477
5478 struct guestfs_message_header {
5479   unsigned prog;                     /* GUESTFS_PROGRAM */
5480   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5481   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5482   guestfs_message_direction direction;
5483   unsigned serial;                   /* message serial number */
5484   guestfs_message_status status;
5485 };
5486
5487 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5488
5489 struct guestfs_chunk {
5490   int cancel;                        /* if non-zero, transfer is cancelled */
5491   /* data size is 0 bytes if the transfer has finished successfully */
5492   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5493 };
5494 "
5495
5496 (* Generate the guestfs-structs.h file. *)
5497 and generate_structs_h () =
5498   generate_header CStyle LGPLv2plus;
5499
5500   (* This is a public exported header file containing various
5501    * structures.  The structures are carefully written to have
5502    * exactly the same in-memory format as the XDR structures that
5503    * we use on the wire to the daemon.  The reason for creating
5504    * copies of these structures here is just so we don't have to
5505    * export the whole of guestfs_protocol.h (which includes much
5506    * unrelated and XDR-dependent stuff that we don't want to be
5507    * public, or required by clients).
5508    *
5509    * To reiterate, we will pass these structures to and from the
5510    * client with a simple assignment or memcpy, so the format
5511    * must be identical to what rpcgen / the RFC defines.
5512    *)
5513
5514   (* Public structures. *)
5515   List.iter (
5516     fun (typ, cols) ->
5517       pr "struct guestfs_%s {\n" typ;
5518       List.iter (
5519         function
5520         | name, FChar -> pr "  char %s;\n" name
5521         | name, FString -> pr "  char *%s;\n" name
5522         | name, FBuffer ->
5523             pr "  uint32_t %s_len;\n" name;
5524             pr "  char *%s;\n" name
5525         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5526         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5527         | name, FInt32 -> pr "  int32_t %s;\n" name
5528         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5529         | name, FInt64 -> pr "  int64_t %s;\n" name
5530         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5531       ) cols;
5532       pr "};\n";
5533       pr "\n";
5534       pr "struct guestfs_%s_list {\n" typ;
5535       pr "  uint32_t len;\n";
5536       pr "  struct guestfs_%s *val;\n" typ;
5537       pr "};\n";
5538       pr "\n";
5539       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5540       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5541       pr "\n"
5542   ) structs
5543
5544 (* Generate the guestfs-actions.h file. *)
5545 and generate_actions_h () =
5546   generate_header CStyle LGPLv2plus;
5547   List.iter (
5548     fun (shortname, style, _, _, _, _, _) ->
5549       let name = "guestfs_" ^ shortname in
5550       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5551         name style
5552   ) all_functions
5553
5554 (* Generate the guestfs-internal-actions.h file. *)
5555 and generate_internal_actions_h () =
5556   generate_header CStyle LGPLv2plus;
5557   List.iter (
5558     fun (shortname, style, _, _, _, _, _) ->
5559       let name = "guestfs__" ^ shortname in
5560       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5561         name style
5562   ) non_daemon_functions
5563
5564 (* Generate the client-side dispatch stubs. *)
5565 and generate_client_actions () =
5566   generate_header CStyle LGPLv2plus;
5567
5568   pr "\
5569 #include <stdio.h>
5570 #include <stdlib.h>
5571 #include <stdint.h>
5572 #include <string.h>
5573 #include <inttypes.h>
5574
5575 #include \"guestfs.h\"
5576 #include \"guestfs-internal.h\"
5577 #include \"guestfs-internal-actions.h\"
5578 #include \"guestfs_protocol.h\"
5579
5580 #define error guestfs_error
5581 //#define perrorf guestfs_perrorf
5582 #define safe_malloc guestfs_safe_malloc
5583 #define safe_realloc guestfs_safe_realloc
5584 //#define safe_strdup guestfs_safe_strdup
5585 #define safe_memdup guestfs_safe_memdup
5586
5587 /* Check the return message from a call for validity. */
5588 static int
5589 check_reply_header (guestfs_h *g,
5590                     const struct guestfs_message_header *hdr,
5591                     unsigned int proc_nr, unsigned int serial)
5592 {
5593   if (hdr->prog != GUESTFS_PROGRAM) {
5594     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5595     return -1;
5596   }
5597   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5598     error (g, \"wrong protocol version (%%d/%%d)\",
5599            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5600     return -1;
5601   }
5602   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5603     error (g, \"unexpected message direction (%%d/%%d)\",
5604            hdr->direction, GUESTFS_DIRECTION_REPLY);
5605     return -1;
5606   }
5607   if (hdr->proc != proc_nr) {
5608     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5609     return -1;
5610   }
5611   if (hdr->serial != serial) {
5612     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5613     return -1;
5614   }
5615
5616   return 0;
5617 }
5618
5619 /* Check we are in the right state to run a high-level action. */
5620 static int
5621 check_state (guestfs_h *g, const char *caller)
5622 {
5623   if (!guestfs__is_ready (g)) {
5624     if (guestfs__is_config (g) || guestfs__is_launching (g))
5625       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5626         caller);
5627     else
5628       error (g, \"%%s called from the wrong state, %%d != READY\",
5629         caller, guestfs__get_state (g));
5630     return -1;
5631   }
5632   return 0;
5633 }
5634
5635 ";
5636
5637   (* Generate code to generate guestfish call traces. *)
5638   let trace_call shortname style =
5639     pr "  if (guestfs__get_trace (g)) {\n";
5640
5641     let needs_i =
5642       List.exists (function
5643                    | StringList _ | DeviceList _ -> true
5644                    | _ -> false) (snd style) in
5645     if needs_i then (
5646       pr "    size_t i;\n";
5647       pr "\n"
5648     );
5649
5650     pr "    printf (\"%s\");\n" shortname;
5651     List.iter (
5652       function
5653       | String n                        (* strings *)
5654       | Device n
5655       | Pathname n
5656       | Dev_or_Path n
5657       | FileIn n
5658       | FileOut n ->
5659           (* guestfish doesn't support string escaping, so neither do we *)
5660           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5661       | OptString n ->                  (* string option *)
5662           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5663           pr "    else printf (\" null\");\n"
5664       | StringList n
5665       | DeviceList n ->                 (* string list *)
5666           pr "    putchar (' ');\n";
5667           pr "    putchar ('\"');\n";
5668           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5669           pr "      if (i > 0) putchar (' ');\n";
5670           pr "      fputs (%s[i], stdout);\n" n;
5671           pr "    }\n";
5672           pr "    putchar ('\"');\n";
5673       | Bool n ->                       (* boolean *)
5674           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5675       | Int n ->                        (* int *)
5676           pr "    printf (\" %%d\", %s);\n" n
5677       | Int64 n ->
5678           pr "    printf (\" %%\" PRIi64, %s);\n" n
5679     ) (snd style);
5680     pr "    putchar ('\\n');\n";
5681     pr "  }\n";
5682     pr "\n";
5683   in
5684
5685   (* For non-daemon functions, generate a wrapper around each function. *)
5686   List.iter (
5687     fun (shortname, style, _, _, _, _, _) ->
5688       let name = "guestfs_" ^ shortname in
5689
5690       generate_prototype ~extern:false ~semicolon:false ~newline:true
5691         ~handle:"g" name style;
5692       pr "{\n";
5693       trace_call shortname style;
5694       pr "  return guestfs__%s " shortname;
5695       generate_c_call_args ~handle:"g" style;
5696       pr ";\n";
5697       pr "}\n";
5698       pr "\n"
5699   ) non_daemon_functions;
5700
5701   (* Client-side stubs for each function. *)
5702   List.iter (
5703     fun (shortname, style, _, _, _, _, _) ->
5704       let name = "guestfs_" ^ shortname in
5705
5706       (* Generate the action stub. *)
5707       generate_prototype ~extern:false ~semicolon:false ~newline:true
5708         ~handle:"g" name style;
5709
5710       let error_code =
5711         match fst style with
5712         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5713         | RConstString _ | RConstOptString _ ->
5714             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5715         | RString _ | RStringList _
5716         | RStruct _ | RStructList _
5717         | RHashtable _ | RBufferOut _ ->
5718             "NULL" in
5719
5720       pr "{\n";
5721
5722       (match snd style with
5723        | [] -> ()
5724        | _ -> pr "  struct %s_args args;\n" name
5725       );
5726
5727       pr "  guestfs_message_header hdr;\n";
5728       pr "  guestfs_message_error err;\n";
5729       let has_ret =
5730         match fst style with
5731         | RErr -> false
5732         | RConstString _ | RConstOptString _ ->
5733             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5734         | RInt _ | RInt64 _
5735         | RBool _ | RString _ | RStringList _
5736         | RStruct _ | RStructList _
5737         | RHashtable _ | RBufferOut _ ->
5738             pr "  struct %s_ret ret;\n" name;
5739             true in
5740
5741       pr "  int serial;\n";
5742       pr "  int r;\n";
5743       pr "\n";
5744       trace_call shortname style;
5745       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5746       pr "  guestfs___set_busy (g);\n";
5747       pr "\n";
5748
5749       (* Send the main header and arguments. *)
5750       (match snd style with
5751        | [] ->
5752            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5753              (String.uppercase shortname)
5754        | args ->
5755            List.iter (
5756              function
5757              | Pathname n | Device n | Dev_or_Path n | String n ->
5758                  pr "  args.%s = (char *) %s;\n" n n
5759              | OptString n ->
5760                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5761              | StringList n | DeviceList n ->
5762                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5763                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5764              | Bool n ->
5765                  pr "  args.%s = %s;\n" n n
5766              | Int n ->
5767                  pr "  args.%s = %s;\n" n n
5768              | Int64 n ->
5769                  pr "  args.%s = %s;\n" n n
5770              | FileIn _ | FileOut _ -> ()
5771            ) args;
5772            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5773              (String.uppercase shortname);
5774            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5775              name;
5776       );
5777       pr "  if (serial == -1) {\n";
5778       pr "    guestfs___end_busy (g);\n";
5779       pr "    return %s;\n" error_code;
5780       pr "  }\n";
5781       pr "\n";
5782
5783       (* Send any additional files (FileIn) requested. *)
5784       let need_read_reply_label = ref false in
5785       List.iter (
5786         function
5787         | FileIn n ->
5788             pr "  r = guestfs___send_file (g, %s);\n" n;
5789             pr "  if (r == -1) {\n";
5790             pr "    guestfs___end_busy (g);\n";
5791             pr "    return %s;\n" error_code;
5792             pr "  }\n";
5793             pr "  if (r == -2) /* daemon cancelled */\n";
5794             pr "    goto read_reply;\n";
5795             need_read_reply_label := true;
5796             pr "\n";
5797         | _ -> ()
5798       ) (snd style);
5799
5800       (* Wait for the reply from the remote end. *)
5801       if !need_read_reply_label then pr " read_reply:\n";
5802       pr "  memset (&hdr, 0, sizeof hdr);\n";
5803       pr "  memset (&err, 0, sizeof err);\n";
5804       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5805       pr "\n";
5806       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5807       if not has_ret then
5808         pr "NULL, NULL"
5809       else
5810         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5811       pr ");\n";
5812
5813       pr "  if (r == -1) {\n";
5814       pr "    guestfs___end_busy (g);\n";
5815       pr "    return %s;\n" error_code;
5816       pr "  }\n";
5817       pr "\n";
5818
5819       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5820         (String.uppercase shortname);
5821       pr "    guestfs___end_busy (g);\n";
5822       pr "    return %s;\n" error_code;
5823       pr "  }\n";
5824       pr "\n";
5825
5826       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5827       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5828       pr "    free (err.error_message);\n";
5829       pr "    guestfs___end_busy (g);\n";
5830       pr "    return %s;\n" error_code;
5831       pr "  }\n";
5832       pr "\n";
5833
5834       (* Expecting to receive further files (FileOut)? *)
5835       List.iter (
5836         function
5837         | FileOut n ->
5838             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5839             pr "    guestfs___end_busy (g);\n";
5840             pr "    return %s;\n" error_code;
5841             pr "  }\n";
5842             pr "\n";
5843         | _ -> ()
5844       ) (snd style);
5845
5846       pr "  guestfs___end_busy (g);\n";
5847
5848       (match fst style with
5849        | RErr -> pr "  return 0;\n"
5850        | RInt n | RInt64 n | RBool n ->
5851            pr "  return ret.%s;\n" n
5852        | RConstString _ | RConstOptString _ ->
5853            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5854        | RString n ->
5855            pr "  return ret.%s; /* caller will free */\n" n
5856        | RStringList n | RHashtable n ->
5857            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5858            pr "  ret.%s.%s_val =\n" n n;
5859            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5860            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5861              n n;
5862            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5863            pr "  return ret.%s.%s_val;\n" n n
5864        | RStruct (n, _) ->
5865            pr "  /* caller will free this */\n";
5866            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5867        | RStructList (n, _) ->
5868            pr "  /* caller will free this */\n";
5869            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5870        | RBufferOut n ->
5871            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5872            pr "   * _val might be NULL here.  To make the API saner for\n";
5873            pr "   * callers, we turn this case into a unique pointer (using\n";
5874            pr "   * malloc(1)).\n";
5875            pr "   */\n";
5876            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5877            pr "    *size_r = ret.%s.%s_len;\n" n n;
5878            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5879            pr "  } else {\n";
5880            pr "    free (ret.%s.%s_val);\n" n n;
5881            pr "    char *p = safe_malloc (g, 1);\n";
5882            pr "    *size_r = ret.%s.%s_len;\n" n n;
5883            pr "    return p;\n";
5884            pr "  }\n";
5885       );
5886
5887       pr "}\n\n"
5888   ) daemon_functions;
5889
5890   (* Functions to free structures. *)
5891   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5892   pr " * structure format is identical to the XDR format.  See note in\n";
5893   pr " * generator.ml.\n";
5894   pr " */\n";
5895   pr "\n";
5896
5897   List.iter (
5898     fun (typ, _) ->
5899       pr "void\n";
5900       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5901       pr "{\n";
5902       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5903       pr "  free (x);\n";
5904       pr "}\n";
5905       pr "\n";
5906
5907       pr "void\n";
5908       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5909       pr "{\n";
5910       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5911       pr "  free (x);\n";
5912       pr "}\n";
5913       pr "\n";
5914
5915   ) structs;
5916
5917 (* Generate daemon/actions.h. *)
5918 and generate_daemon_actions_h () =
5919   generate_header CStyle GPLv2plus;
5920
5921   pr "#include \"../src/guestfs_protocol.h\"\n";
5922   pr "\n";
5923
5924   List.iter (
5925     fun (name, style, _, _, _, _, _) ->
5926       generate_prototype
5927         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5928         name style;
5929   ) daemon_functions
5930
5931 (* Generate the linker script which controls the visibility of
5932  * symbols in the public ABI and ensures no other symbols get
5933  * exported accidentally.
5934  *)
5935 and generate_linker_script () =
5936   generate_header HashStyle GPLv2plus;
5937
5938   let globals = [
5939     "guestfs_create";
5940     "guestfs_close";
5941     "guestfs_get_error_handler";
5942     "guestfs_get_out_of_memory_handler";
5943     "guestfs_last_error";
5944     "guestfs_set_error_handler";
5945     "guestfs_set_launch_done_callback";
5946     "guestfs_set_log_message_callback";
5947     "guestfs_set_out_of_memory_handler";
5948     "guestfs_set_subprocess_quit_callback";
5949
5950     (* Unofficial parts of the API: the bindings code use these
5951      * functions, so it is useful to export them.
5952      *)
5953     "guestfs_safe_calloc";
5954     "guestfs_safe_malloc";
5955     "guestfs_safe_strdup";
5956     "guestfs_safe_memdup";
5957   ] in
5958   let functions =
5959     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5960       all_functions in
5961   let structs =
5962     List.concat (
5963       List.map (fun (typ, _) ->
5964                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5965         structs
5966     ) in
5967   let globals = List.sort compare (globals @ functions @ structs) in
5968
5969   pr "{\n";
5970   pr "    global:\n";
5971   List.iter (pr "        %s;\n") globals;
5972   pr "\n";
5973
5974   pr "    local:\n";
5975   pr "        *;\n";
5976   pr "};\n"
5977
5978 (* Generate the server-side stubs. *)
5979 and generate_daemon_actions () =
5980   generate_header CStyle GPLv2plus;
5981
5982   pr "#include <config.h>\n";
5983   pr "\n";
5984   pr "#include <stdio.h>\n";
5985   pr "#include <stdlib.h>\n";
5986   pr "#include <string.h>\n";
5987   pr "#include <inttypes.h>\n";
5988   pr "#include <rpc/types.h>\n";
5989   pr "#include <rpc/xdr.h>\n";
5990   pr "\n";
5991   pr "#include \"daemon.h\"\n";
5992   pr "#include \"c-ctype.h\"\n";
5993   pr "#include \"../src/guestfs_protocol.h\"\n";
5994   pr "#include \"actions.h\"\n";
5995   pr "\n";
5996
5997   List.iter (
5998     fun (name, style, _, _, _, _, _) ->
5999       (* Generate server-side stubs. *)
6000       pr "static void %s_stub (XDR *xdr_in)\n" name;
6001       pr "{\n";
6002       let error_code =
6003         match fst style with
6004         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6005         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6006         | RBool _ -> pr "  int r;\n"; "-1"
6007         | RConstString _ | RConstOptString _ ->
6008             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6009         | RString _ -> pr "  char *r;\n"; "NULL"
6010         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6011         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6012         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6013         | RBufferOut _ ->
6014             pr "  size_t size = 1;\n";
6015             pr "  char *r;\n";
6016             "NULL" in
6017
6018       (match snd style with
6019        | [] -> ()
6020        | args ->
6021            pr "  struct guestfs_%s_args args;\n" name;
6022            List.iter (
6023              function
6024              | Device n | Dev_or_Path n
6025              | Pathname n
6026              | String n -> ()
6027              | OptString n -> pr "  char *%s;\n" n
6028              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6029              | Bool n -> pr "  int %s;\n" n
6030              | Int n -> pr "  int %s;\n" n
6031              | Int64 n -> pr "  int64_t %s;\n" n
6032              | FileIn _ | FileOut _ -> ()
6033            ) args
6034       );
6035       pr "\n";
6036
6037       (match snd style with
6038        | [] -> ()
6039        | args ->
6040            pr "  memset (&args, 0, sizeof args);\n";
6041            pr "\n";
6042            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6043            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6044            pr "    return;\n";
6045            pr "  }\n";
6046            let pr_args n =
6047              pr "  char *%s = args.%s;\n" n n
6048            in
6049            let pr_list_handling_code n =
6050              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6051              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6052              pr "  if (%s == NULL) {\n" n;
6053              pr "    reply_with_perror (\"realloc\");\n";
6054              pr "    goto done;\n";
6055              pr "  }\n";
6056              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6057              pr "  args.%s.%s_val = %s;\n" n n n;
6058            in
6059            List.iter (
6060              function
6061              | Pathname n ->
6062                  pr_args n;
6063                  pr "  ABS_PATH (%s, goto done);\n" n;
6064              | Device n ->
6065                  pr_args n;
6066                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6067              | Dev_or_Path n ->
6068                  pr_args n;
6069                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6070              | String n -> pr_args n
6071              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6072              | StringList n ->
6073                  pr_list_handling_code n;
6074              | DeviceList n ->
6075                  pr_list_handling_code n;
6076                  pr "  /* Ensure that each is a device,\n";
6077                  pr "   * and perform device name translation.\n";
6078                  pr "   */\n";
6079                  pr "  {\n";
6080                  pr "    size_t i;\n";
6081                  pr "    for (i = 0; %s[i] != NULL; ++i)\n" n;
6082                  pr "      RESOLVE_DEVICE (%s[i], goto done);\n" n;
6083                  pr "  }\n";
6084              | Bool n -> pr "  %s = args.%s;\n" n n
6085              | Int n -> pr "  %s = args.%s;\n" n n
6086              | Int64 n -> pr "  %s = args.%s;\n" n n
6087              | FileIn _ | FileOut _ -> ()
6088            ) args;
6089            pr "\n"
6090       );
6091
6092
6093       (* this is used at least for do_equal *)
6094       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6095         (* Emit NEED_ROOT just once, even when there are two or
6096            more Pathname args *)
6097         pr "  NEED_ROOT (goto done);\n";
6098       );
6099
6100       (* Don't want to call the impl with any FileIn or FileOut
6101        * parameters, since these go "outside" the RPC protocol.
6102        *)
6103       let args' =
6104         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6105           (snd style) in
6106       pr "  r = do_%s " name;
6107       generate_c_call_args (fst style, args');
6108       pr ";\n";
6109
6110       (match fst style with
6111        | RErr | RInt _ | RInt64 _ | RBool _
6112        | RConstString _ | RConstOptString _
6113        | RString _ | RStringList _ | RHashtable _
6114        | RStruct (_, _) | RStructList (_, _) ->
6115            pr "  if (r == %s)\n" error_code;
6116            pr "    /* do_%s has already called reply_with_error */\n" name;
6117            pr "    goto done;\n";
6118            pr "\n"
6119        | RBufferOut _ ->
6120            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6121            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6122            pr "   */\n";
6123            pr "  if (size == 1 && r == %s)\n" error_code;
6124            pr "    /* do_%s has already called reply_with_error */\n" name;
6125            pr "    goto done;\n";
6126            pr "\n"
6127       );
6128
6129       (* If there are any FileOut parameters, then the impl must
6130        * send its own reply.
6131        *)
6132       let no_reply =
6133         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6134       if no_reply then
6135         pr "  /* do_%s has already sent a reply */\n" name
6136       else (
6137         match fst style with
6138         | RErr -> pr "  reply (NULL, NULL);\n"
6139         | RInt n | RInt64 n | RBool n ->
6140             pr "  struct guestfs_%s_ret ret;\n" name;
6141             pr "  ret.%s = r;\n" n;
6142             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6143               name
6144         | RConstString _ | RConstOptString _ ->
6145             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6146         | RString n ->
6147             pr "  struct guestfs_%s_ret ret;\n" name;
6148             pr "  ret.%s = r;\n" n;
6149             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6150               name;
6151             pr "  free (r);\n"
6152         | RStringList n | RHashtable n ->
6153             pr "  struct guestfs_%s_ret ret;\n" name;
6154             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6155             pr "  ret.%s.%s_val = r;\n" n n;
6156             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6157               name;
6158             pr "  free_strings (r);\n"
6159         | RStruct (n, _) ->
6160             pr "  struct guestfs_%s_ret ret;\n" name;
6161             pr "  ret.%s = *r;\n" n;
6162             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6163               name;
6164             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6165               name
6166         | RStructList (n, _) ->
6167             pr "  struct guestfs_%s_ret ret;\n" name;
6168             pr "  ret.%s = *r;\n" n;
6169             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6170               name;
6171             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6172               name
6173         | RBufferOut n ->
6174             pr "  struct guestfs_%s_ret ret;\n" name;
6175             pr "  ret.%s.%s_val = r;\n" n n;
6176             pr "  ret.%s.%s_len = size;\n" n n;
6177             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6178               name;
6179             pr "  free (r);\n"
6180       );
6181
6182       (* Free the args. *)
6183       (match snd style with
6184        | [] ->
6185            pr "done: ;\n";
6186        | _ ->
6187            pr "done:\n";
6188            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6189              name
6190       );
6191
6192       pr "}\n\n";
6193   ) daemon_functions;
6194
6195   (* Dispatch function. *)
6196   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6197   pr "{\n";
6198   pr "  switch (proc_nr) {\n";
6199
6200   List.iter (
6201     fun (name, style, _, _, _, _, _) ->
6202       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6203       pr "      %s_stub (xdr_in);\n" name;
6204       pr "      break;\n"
6205   ) daemon_functions;
6206
6207   pr "    default:\n";
6208   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d, set LIBGUESTFS_PATH to point to the matching libguestfs appliance directory\", proc_nr);\n";
6209   pr "  }\n";
6210   pr "}\n";
6211   pr "\n";
6212
6213   (* LVM columns and tokenization functions. *)
6214   (* XXX This generates crap code.  We should rethink how we
6215    * do this parsing.
6216    *)
6217   List.iter (
6218     function
6219     | typ, cols ->
6220         pr "static const char *lvm_%s_cols = \"%s\";\n"
6221           typ (String.concat "," (List.map fst cols));
6222         pr "\n";
6223
6224         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6225         pr "{\n";
6226         pr "  char *tok, *p, *next;\n";
6227         pr "  size_t i, j;\n";
6228         pr "\n";
6229         (*
6230           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6231           pr "\n";
6232         *)
6233         pr "  if (!str) {\n";
6234         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6235         pr "    return -1;\n";
6236         pr "  }\n";
6237         pr "  if (!*str || c_isspace (*str)) {\n";
6238         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6239         pr "    return -1;\n";
6240         pr "  }\n";
6241         pr "  tok = str;\n";
6242         List.iter (
6243           fun (name, coltype) ->
6244             pr "  if (!tok) {\n";
6245             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6246             pr "    return -1;\n";
6247             pr "  }\n";
6248             pr "  p = strchrnul (tok, ',');\n";
6249             pr "  if (*p) next = p+1; else next = NULL;\n";
6250             pr "  *p = '\\0';\n";
6251             (match coltype with
6252              | FString ->
6253                  pr "  r->%s = strdup (tok);\n" name;
6254                  pr "  if (r->%s == NULL) {\n" name;
6255                  pr "    perror (\"strdup\");\n";
6256                  pr "    return -1;\n";
6257                  pr "  }\n"
6258              | FUUID ->
6259                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6260                  pr "    if (tok[j] == '\\0') {\n";
6261                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6262                  pr "      return -1;\n";
6263                  pr "    } else if (tok[j] != '-')\n";
6264                  pr "      r->%s[i++] = tok[j];\n" name;
6265                  pr "  }\n";
6266              | FBytes ->
6267                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6268                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6269                  pr "    return -1;\n";
6270                  pr "  }\n";
6271              | FInt64 ->
6272                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6273                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6274                  pr "    return -1;\n";
6275                  pr "  }\n";
6276              | FOptPercent ->
6277                  pr "  if (tok[0] == '\\0')\n";
6278                  pr "    r->%s = -1;\n" name;
6279                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6280                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6281                  pr "    return -1;\n";
6282                  pr "  }\n";
6283              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6284                  assert false (* can never be an LVM column *)
6285             );
6286             pr "  tok = next;\n";
6287         ) cols;
6288
6289         pr "  if (tok != NULL) {\n";
6290         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6291         pr "    return -1;\n";
6292         pr "  }\n";
6293         pr "  return 0;\n";
6294         pr "}\n";
6295         pr "\n";
6296
6297         pr "guestfs_int_lvm_%s_list *\n" typ;
6298         pr "parse_command_line_%ss (void)\n" typ;
6299         pr "{\n";
6300         pr "  char *out, *err;\n";
6301         pr "  char *p, *pend;\n";
6302         pr "  int r, i;\n";
6303         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6304         pr "  void *newp;\n";
6305         pr "\n";
6306         pr "  ret = malloc (sizeof *ret);\n";
6307         pr "  if (!ret) {\n";
6308         pr "    reply_with_perror (\"malloc\");\n";
6309         pr "    return NULL;\n";
6310         pr "  }\n";
6311         pr "\n";
6312         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6313         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6314         pr "\n";
6315         pr "  r = command (&out, &err,\n";
6316         pr "           \"lvm\", \"%ss\",\n" typ;
6317         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6318         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6319         pr "  if (r == -1) {\n";
6320         pr "    reply_with_error (\"%%s\", err);\n";
6321         pr "    free (out);\n";
6322         pr "    free (err);\n";
6323         pr "    free (ret);\n";
6324         pr "    return NULL;\n";
6325         pr "  }\n";
6326         pr "\n";
6327         pr "  free (err);\n";
6328         pr "\n";
6329         pr "  /* Tokenize each line of the output. */\n";
6330         pr "  p = out;\n";
6331         pr "  i = 0;\n";
6332         pr "  while (p) {\n";
6333         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6334         pr "    if (pend) {\n";
6335         pr "      *pend = '\\0';\n";
6336         pr "      pend++;\n";
6337         pr "    }\n";
6338         pr "\n";
6339         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6340         pr "      p++;\n";
6341         pr "\n";
6342         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6343         pr "      p = pend;\n";
6344         pr "      continue;\n";
6345         pr "    }\n";
6346         pr "\n";
6347         pr "    /* Allocate some space to store this next entry. */\n";
6348         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6349         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6350         pr "    if (newp == NULL) {\n";
6351         pr "      reply_with_perror (\"realloc\");\n";
6352         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6353         pr "      free (ret);\n";
6354         pr "      free (out);\n";
6355         pr "      return NULL;\n";
6356         pr "    }\n";
6357         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6358         pr "\n";
6359         pr "    /* Tokenize the next entry. */\n";
6360         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6361         pr "    if (r == -1) {\n";
6362         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6363         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6364         pr "      free (ret);\n";
6365         pr "      free (out);\n";
6366         pr "      return NULL;\n";
6367         pr "    }\n";
6368         pr "\n";
6369         pr "    ++i;\n";
6370         pr "    p = pend;\n";
6371         pr "  }\n";
6372         pr "\n";
6373         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6374         pr "\n";
6375         pr "  free (out);\n";
6376         pr "  return ret;\n";
6377         pr "}\n"
6378
6379   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6380
6381 (* Generate a list of function names, for debugging in the daemon.. *)
6382 and generate_daemon_names () =
6383   generate_header CStyle GPLv2plus;
6384
6385   pr "#include <config.h>\n";
6386   pr "\n";
6387   pr "#include \"daemon.h\"\n";
6388   pr "\n";
6389
6390   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6391   pr "const char *function_names[] = {\n";
6392   List.iter (
6393     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6394   ) daemon_functions;
6395   pr "};\n";
6396
6397 (* Generate the optional groups for the daemon to implement
6398  * guestfs_available.
6399  *)
6400 and generate_daemon_optgroups_c () =
6401   generate_header CStyle GPLv2plus;
6402
6403   pr "#include <config.h>\n";
6404   pr "\n";
6405   pr "#include \"daemon.h\"\n";
6406   pr "#include \"optgroups.h\"\n";
6407   pr "\n";
6408
6409   pr "struct optgroup optgroups[] = {\n";
6410   List.iter (
6411     fun (group, _) ->
6412       pr "  { \"%s\", optgroup_%s_available },\n" group group
6413   ) optgroups;
6414   pr "  { NULL, NULL }\n";
6415   pr "};\n"
6416
6417 and generate_daemon_optgroups_h () =
6418   generate_header CStyle GPLv2plus;
6419
6420   List.iter (
6421     fun (group, _) ->
6422       pr "extern int optgroup_%s_available (void);\n" group
6423   ) optgroups
6424
6425 (* Generate the tests. *)
6426 and generate_tests () =
6427   generate_header CStyle GPLv2plus;
6428
6429   pr "\
6430 #include <stdio.h>
6431 #include <stdlib.h>
6432 #include <string.h>
6433 #include <unistd.h>
6434 #include <sys/types.h>
6435 #include <fcntl.h>
6436
6437 #include \"guestfs.h\"
6438 #include \"guestfs-internal.h\"
6439
6440 static guestfs_h *g;
6441 static int suppress_error = 0;
6442
6443 static void print_error (guestfs_h *g, void *data, const char *msg)
6444 {
6445   if (!suppress_error)
6446     fprintf (stderr, \"%%s\\n\", msg);
6447 }
6448
6449 /* FIXME: nearly identical code appears in fish.c */
6450 static void print_strings (char *const *argv)
6451 {
6452   size_t argc;
6453
6454   for (argc = 0; argv[argc] != NULL; ++argc)
6455     printf (\"\\t%%s\\n\", argv[argc]);
6456 }
6457
6458 /*
6459 static void print_table (char const *const *argv)
6460 {
6461   size_t i;
6462
6463   for (i = 0; argv[i] != NULL; i += 2)
6464     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6465 }
6466 */
6467
6468 static int
6469 is_available (const char *group)
6470 {
6471   const char *groups[] = { group, NULL };
6472   int r;
6473
6474   suppress_error = 1;
6475   r = guestfs_available (g, (char **) groups);
6476   suppress_error = 0;
6477
6478   return r == 0;
6479 }
6480
6481 ";
6482
6483   (* Generate a list of commands which are not tested anywhere. *)
6484   pr "static void no_test_warnings (void)\n";
6485   pr "{\n";
6486
6487   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6488   List.iter (
6489     fun (_, _, _, _, tests, _, _) ->
6490       let tests = filter_map (
6491         function
6492         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
6493         | (_, Disabled, _) -> None
6494       ) tests in
6495       let seq = List.concat (List.map seq_of_test tests) in
6496       let cmds_tested = List.map List.hd seq in
6497       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6498   ) all_functions;
6499
6500   List.iter (
6501     fun (name, _, _, _, _, _, _) ->
6502       if not (Hashtbl.mem hash name) then
6503         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6504   ) all_functions;
6505
6506   pr "}\n";
6507   pr "\n";
6508
6509   (* Generate the actual tests.  Note that we generate the tests
6510    * in reverse order, deliberately, so that (in general) the
6511    * newest tests run first.  This makes it quicker and easier to
6512    * debug them.
6513    *)
6514   let test_names =
6515     List.map (
6516       fun (name, _, _, flags, tests, _, _) ->
6517         mapi (generate_one_test name flags) tests
6518     ) (List.rev all_functions) in
6519   let test_names = List.concat test_names in
6520   let nr_tests = List.length test_names in
6521
6522   pr "\
6523 int main (int argc, char *argv[])
6524 {
6525   char c = 0;
6526   unsigned long int n_failed = 0;
6527   const char *filename;
6528   int fd;
6529   int nr_tests, test_num = 0;
6530
6531   setbuf (stdout, NULL);
6532
6533   no_test_warnings ();
6534
6535   g = guestfs_create ();
6536   if (g == NULL) {
6537     printf (\"guestfs_create FAILED\\n\");
6538     exit (EXIT_FAILURE);
6539   }
6540
6541   guestfs_set_error_handler (g, print_error, NULL);
6542
6543   guestfs_set_path (g, \"../appliance\");
6544
6545   filename = \"test1.img\";
6546   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6547   if (fd == -1) {
6548     perror (filename);
6549     exit (EXIT_FAILURE);
6550   }
6551   if (lseek (fd, %d, SEEK_SET) == -1) {
6552     perror (\"lseek\");
6553     close (fd);
6554     unlink (filename);
6555     exit (EXIT_FAILURE);
6556   }
6557   if (write (fd, &c, 1) == -1) {
6558     perror (\"write\");
6559     close (fd);
6560     unlink (filename);
6561     exit (EXIT_FAILURE);
6562   }
6563   if (close (fd) == -1) {
6564     perror (filename);
6565     unlink (filename);
6566     exit (EXIT_FAILURE);
6567   }
6568   if (guestfs_add_drive (g, filename) == -1) {
6569     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6570     exit (EXIT_FAILURE);
6571   }
6572
6573   filename = \"test2.img\";
6574   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6575   if (fd == -1) {
6576     perror (filename);
6577     exit (EXIT_FAILURE);
6578   }
6579   if (lseek (fd, %d, SEEK_SET) == -1) {
6580     perror (\"lseek\");
6581     close (fd);
6582     unlink (filename);
6583     exit (EXIT_FAILURE);
6584   }
6585   if (write (fd, &c, 1) == -1) {
6586     perror (\"write\");
6587     close (fd);
6588     unlink (filename);
6589     exit (EXIT_FAILURE);
6590   }
6591   if (close (fd) == -1) {
6592     perror (filename);
6593     unlink (filename);
6594     exit (EXIT_FAILURE);
6595   }
6596   if (guestfs_add_drive (g, filename) == -1) {
6597     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6598     exit (EXIT_FAILURE);
6599   }
6600
6601   filename = \"test3.img\";
6602   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6603   if (fd == -1) {
6604     perror (filename);
6605     exit (EXIT_FAILURE);
6606   }
6607   if (lseek (fd, %d, SEEK_SET) == -1) {
6608     perror (\"lseek\");
6609     close (fd);
6610     unlink (filename);
6611     exit (EXIT_FAILURE);
6612   }
6613   if (write (fd, &c, 1) == -1) {
6614     perror (\"write\");
6615     close (fd);
6616     unlink (filename);
6617     exit (EXIT_FAILURE);
6618   }
6619   if (close (fd) == -1) {
6620     perror (filename);
6621     unlink (filename);
6622     exit (EXIT_FAILURE);
6623   }
6624   if (guestfs_add_drive (g, filename) == -1) {
6625     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6626     exit (EXIT_FAILURE);
6627   }
6628
6629   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6630     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6631     exit (EXIT_FAILURE);
6632   }
6633
6634   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6635   alarm (600);
6636
6637   if (guestfs_launch (g) == -1) {
6638     printf (\"guestfs_launch FAILED\\n\");
6639     exit (EXIT_FAILURE);
6640   }
6641
6642   /* Cancel previous alarm. */
6643   alarm (0);
6644
6645   nr_tests = %d;
6646
6647 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6648
6649   iteri (
6650     fun i test_name ->
6651       pr "  test_num++;\n";
6652       pr "  if (guestfs_get_verbose (g))\n";
6653       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6654       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6655       pr "  if (%s () == -1) {\n" test_name;
6656       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6657       pr "    n_failed++;\n";
6658       pr "  }\n";
6659   ) test_names;
6660   pr "\n";
6661
6662   pr "  guestfs_close (g);\n";
6663   pr "  unlink (\"test1.img\");\n";
6664   pr "  unlink (\"test2.img\");\n";
6665   pr "  unlink (\"test3.img\");\n";
6666   pr "\n";
6667
6668   pr "  if (n_failed > 0) {\n";
6669   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6670   pr "    exit (EXIT_FAILURE);\n";
6671   pr "  }\n";
6672   pr "\n";
6673
6674   pr "  exit (EXIT_SUCCESS);\n";
6675   pr "}\n"
6676
6677 and generate_one_test name flags i (init, prereq, test) =
6678   let test_name = sprintf "test_%s_%d" name i in
6679
6680   pr "\
6681 static int %s_skip (void)
6682 {
6683   const char *str;
6684
6685   str = getenv (\"TEST_ONLY\");
6686   if (str)
6687     return strstr (str, \"%s\") == NULL;
6688   str = getenv (\"SKIP_%s\");
6689   if (str && STREQ (str, \"1\")) return 1;
6690   str = getenv (\"SKIP_TEST_%s\");
6691   if (str && STREQ (str, \"1\")) return 1;
6692   return 0;
6693 }
6694
6695 " test_name name (String.uppercase test_name) (String.uppercase name);
6696
6697   (match prereq with
6698    | Disabled | Always | IfAvailable _ -> ()
6699    | If code | Unless code ->
6700        pr "static int %s_prereq (void)\n" test_name;
6701        pr "{\n";
6702        pr "  %s\n" code;
6703        pr "}\n";
6704        pr "\n";
6705   );
6706
6707   pr "\
6708 static int %s (void)
6709 {
6710   if (%s_skip ()) {
6711     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6712     return 0;
6713   }
6714
6715 " test_name test_name test_name;
6716
6717   (* Optional functions should only be tested if the relevant
6718    * support is available in the daemon.
6719    *)
6720   List.iter (
6721     function
6722     | Optional group ->
6723         pr "  if (!is_available (\"%s\")) {\n" group;
6724         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
6725         pr "    return 0;\n";
6726         pr "  }\n";
6727     | _ -> ()
6728   ) flags;
6729
6730   (match prereq with
6731    | Disabled ->
6732        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6733    | If _ ->
6734        pr "  if (! %s_prereq ()) {\n" test_name;
6735        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6736        pr "    return 0;\n";
6737        pr "  }\n";
6738        pr "\n";
6739        generate_one_test_body name i test_name init test;
6740    | Unless _ ->
6741        pr "  if (%s_prereq ()) {\n" test_name;
6742        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6743        pr "    return 0;\n";
6744        pr "  }\n";
6745        pr "\n";
6746        generate_one_test_body name i test_name init test;
6747    | IfAvailable group ->
6748        pr "  if (!is_available (\"%s\")) {\n" group;
6749        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
6750        pr "    return 0;\n";
6751        pr "  }\n";
6752        pr "\n";
6753        generate_one_test_body name i test_name init test;
6754    | Always ->
6755        generate_one_test_body name i test_name init test
6756   );
6757
6758   pr "  return 0;\n";
6759   pr "}\n";
6760   pr "\n";
6761   test_name
6762
6763 and generate_one_test_body name i test_name init test =
6764   (match init with
6765    | InitNone (* XXX at some point, InitNone and InitEmpty became
6766                * folded together as the same thing.  Really we should
6767                * make InitNone do nothing at all, but the tests may
6768                * need to be checked to make sure this is OK.
6769                *)
6770    | InitEmpty ->
6771        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6772        List.iter (generate_test_command_call test_name)
6773          [["blockdev_setrw"; "/dev/sda"];
6774           ["umount_all"];
6775           ["lvm_remove_all"]]
6776    | InitPartition ->
6777        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6778        List.iter (generate_test_command_call test_name)
6779          [["blockdev_setrw"; "/dev/sda"];
6780           ["umount_all"];
6781           ["lvm_remove_all"];
6782           ["part_disk"; "/dev/sda"; "mbr"]]
6783    | InitBasicFS ->
6784        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6785        List.iter (generate_test_command_call test_name)
6786          [["blockdev_setrw"; "/dev/sda"];
6787           ["umount_all"];
6788           ["lvm_remove_all"];
6789           ["part_disk"; "/dev/sda"; "mbr"];
6790           ["mkfs"; "ext2"; "/dev/sda1"];
6791           ["mount_options"; ""; "/dev/sda1"; "/"]]
6792    | InitBasicFSonLVM ->
6793        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6794          test_name;
6795        List.iter (generate_test_command_call test_name)
6796          [["blockdev_setrw"; "/dev/sda"];
6797           ["umount_all"];
6798           ["lvm_remove_all"];
6799           ["part_disk"; "/dev/sda"; "mbr"];
6800           ["pvcreate"; "/dev/sda1"];
6801           ["vgcreate"; "VG"; "/dev/sda1"];
6802           ["lvcreate"; "LV"; "VG"; "8"];
6803           ["mkfs"; "ext2"; "/dev/VG/LV"];
6804           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6805    | InitISOFS ->
6806        pr "  /* InitISOFS for %s */\n" test_name;
6807        List.iter (generate_test_command_call test_name)
6808          [["blockdev_setrw"; "/dev/sda"];
6809           ["umount_all"];
6810           ["lvm_remove_all"];
6811           ["mount_ro"; "/dev/sdd"; "/"]]
6812   );
6813
6814   let get_seq_last = function
6815     | [] ->
6816         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6817           test_name
6818     | seq ->
6819         let seq = List.rev seq in
6820         List.rev (List.tl seq), List.hd seq
6821   in
6822
6823   match test with
6824   | TestRun seq ->
6825       pr "  /* TestRun for %s (%d) */\n" name i;
6826       List.iter (generate_test_command_call test_name) seq
6827   | TestOutput (seq, expected) ->
6828       pr "  /* TestOutput for %s (%d) */\n" name i;
6829       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6830       let seq, last = get_seq_last seq in
6831       let test () =
6832         pr "    if (STRNEQ (r, expected)) {\n";
6833         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6834         pr "      return -1;\n";
6835         pr "    }\n"
6836       in
6837       List.iter (generate_test_command_call test_name) seq;
6838       generate_test_command_call ~test test_name last
6839   | TestOutputList (seq, expected) ->
6840       pr "  /* TestOutputList for %s (%d) */\n" name i;
6841       let seq, last = get_seq_last seq in
6842       let test () =
6843         iteri (
6844           fun i str ->
6845             pr "    if (!r[%d]) {\n" i;
6846             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6847             pr "      print_strings (r);\n";
6848             pr "      return -1;\n";
6849             pr "    }\n";
6850             pr "    {\n";
6851             pr "      const char *expected = \"%s\";\n" (c_quote str);
6852             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6853             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6854             pr "        return -1;\n";
6855             pr "      }\n";
6856             pr "    }\n"
6857         ) expected;
6858         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6859         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6860           test_name;
6861         pr "      print_strings (r);\n";
6862         pr "      return -1;\n";
6863         pr "    }\n"
6864       in
6865       List.iter (generate_test_command_call test_name) seq;
6866       generate_test_command_call ~test test_name last
6867   | TestOutputListOfDevices (seq, expected) ->
6868       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6869       let seq, last = get_seq_last seq in
6870       let test () =
6871         iteri (
6872           fun i str ->
6873             pr "    if (!r[%d]) {\n" i;
6874             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6875             pr "      print_strings (r);\n";
6876             pr "      return -1;\n";
6877             pr "    }\n";
6878             pr "    {\n";
6879             pr "      const char *expected = \"%s\";\n" (c_quote str);
6880             pr "      r[%d][5] = 's';\n" i;
6881             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6882             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6883             pr "        return -1;\n";
6884             pr "      }\n";
6885             pr "    }\n"
6886         ) expected;
6887         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6888         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6889           test_name;
6890         pr "      print_strings (r);\n";
6891         pr "      return -1;\n";
6892         pr "    }\n"
6893       in
6894       List.iter (generate_test_command_call test_name) seq;
6895       generate_test_command_call ~test test_name last
6896   | TestOutputInt (seq, expected) ->
6897       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6898       let seq, last = get_seq_last seq in
6899       let test () =
6900         pr "    if (r != %d) {\n" expected;
6901         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6902           test_name expected;
6903         pr "               (int) r);\n";
6904         pr "      return -1;\n";
6905         pr "    }\n"
6906       in
6907       List.iter (generate_test_command_call test_name) seq;
6908       generate_test_command_call ~test test_name last
6909   | TestOutputIntOp (seq, op, expected) ->
6910       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6911       let seq, last = get_seq_last seq in
6912       let test () =
6913         pr "    if (! (r %s %d)) {\n" op expected;
6914         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6915           test_name op expected;
6916         pr "               (int) r);\n";
6917         pr "      return -1;\n";
6918         pr "    }\n"
6919       in
6920       List.iter (generate_test_command_call test_name) seq;
6921       generate_test_command_call ~test test_name last
6922   | TestOutputTrue seq ->
6923       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6924       let seq, last = get_seq_last seq in
6925       let test () =
6926         pr "    if (!r) {\n";
6927         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6928           test_name;
6929         pr "      return -1;\n";
6930         pr "    }\n"
6931       in
6932       List.iter (generate_test_command_call test_name) seq;
6933       generate_test_command_call ~test test_name last
6934   | TestOutputFalse seq ->
6935       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6936       let seq, last = get_seq_last seq in
6937       let test () =
6938         pr "    if (r) {\n";
6939         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6940           test_name;
6941         pr "      return -1;\n";
6942         pr "    }\n"
6943       in
6944       List.iter (generate_test_command_call test_name) seq;
6945       generate_test_command_call ~test test_name last
6946   | TestOutputLength (seq, expected) ->
6947       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6948       let seq, last = get_seq_last seq in
6949       let test () =
6950         pr "    int j;\n";
6951         pr "    for (j = 0; j < %d; ++j)\n" expected;
6952         pr "      if (r[j] == NULL) {\n";
6953         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6954           test_name;
6955         pr "        print_strings (r);\n";
6956         pr "        return -1;\n";
6957         pr "      }\n";
6958         pr "    if (r[j] != NULL) {\n";
6959         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6960           test_name;
6961         pr "      print_strings (r);\n";
6962         pr "      return -1;\n";
6963         pr "    }\n"
6964       in
6965       List.iter (generate_test_command_call test_name) seq;
6966       generate_test_command_call ~test test_name last
6967   | TestOutputBuffer (seq, expected) ->
6968       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6969       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6970       let seq, last = get_seq_last seq in
6971       let len = String.length expected in
6972       let test () =
6973         pr "    if (size != %d) {\n" len;
6974         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6975         pr "      return -1;\n";
6976         pr "    }\n";
6977         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6978         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6979         pr "      return -1;\n";
6980         pr "    }\n"
6981       in
6982       List.iter (generate_test_command_call test_name) seq;
6983       generate_test_command_call ~test test_name last
6984   | TestOutputStruct (seq, checks) ->
6985       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6986       let seq, last = get_seq_last seq in
6987       let test () =
6988         List.iter (
6989           function
6990           | CompareWithInt (field, expected) ->
6991               pr "    if (r->%s != %d) {\n" field expected;
6992               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6993                 test_name field expected;
6994               pr "               (int) r->%s);\n" field;
6995               pr "      return -1;\n";
6996               pr "    }\n"
6997           | CompareWithIntOp (field, op, expected) ->
6998               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6999               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
7000                 test_name field op expected;
7001               pr "               (int) r->%s);\n" field;
7002               pr "      return -1;\n";
7003               pr "    }\n"
7004           | CompareWithString (field, expected) ->
7005               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7006               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7007                 test_name field expected;
7008               pr "               r->%s);\n" field;
7009               pr "      return -1;\n";
7010               pr "    }\n"
7011           | CompareFieldsIntEq (field1, field2) ->
7012               pr "    if (r->%s != r->%s) {\n" field1 field2;
7013               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7014                 test_name field1 field2;
7015               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7016               pr "      return -1;\n";
7017               pr "    }\n"
7018           | CompareFieldsStrEq (field1, field2) ->
7019               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7020               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7021                 test_name field1 field2;
7022               pr "               r->%s, r->%s);\n" field1 field2;
7023               pr "      return -1;\n";
7024               pr "    }\n"
7025         ) checks
7026       in
7027       List.iter (generate_test_command_call test_name) seq;
7028       generate_test_command_call ~test test_name last
7029   | TestLastFail seq ->
7030       pr "  /* TestLastFail for %s (%d) */\n" name i;
7031       let seq, last = get_seq_last seq in
7032       List.iter (generate_test_command_call test_name) seq;
7033       generate_test_command_call test_name ~expect_error:true last
7034
7035 (* Generate the code to run a command, leaving the result in 'r'.
7036  * If you expect to get an error then you should set expect_error:true.
7037  *)
7038 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7039   match cmd with
7040   | [] -> assert false
7041   | name :: args ->
7042       (* Look up the command to find out what args/ret it has. *)
7043       let style =
7044         try
7045           let _, style, _, _, _, _, _ =
7046             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7047           style
7048         with Not_found ->
7049           failwithf "%s: in test, command %s was not found" test_name name in
7050
7051       if List.length (snd style) <> List.length args then
7052         failwithf "%s: in test, wrong number of args given to %s"
7053           test_name name;
7054
7055       pr "  {\n";
7056
7057       List.iter (
7058         function
7059         | OptString n, "NULL" -> ()
7060         | Pathname n, arg
7061         | Device n, arg
7062         | Dev_or_Path n, arg
7063         | String n, arg
7064         | OptString n, arg ->
7065             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7066         | Int _, _
7067         | Int64 _, _
7068         | Bool _, _
7069         | FileIn _, _ | FileOut _, _ -> ()
7070         | StringList n, "" | DeviceList n, "" ->
7071             pr "    const char *const %s[1] = { NULL };\n" n
7072         | StringList n, arg | DeviceList n, arg ->
7073             let strs = string_split " " arg in
7074             iteri (
7075               fun i str ->
7076                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7077             ) strs;
7078             pr "    const char *const %s[] = {\n" n;
7079             iteri (
7080               fun i _ -> pr "      %s_%d,\n" n i
7081             ) strs;
7082             pr "      NULL\n";
7083             pr "    };\n";
7084       ) (List.combine (snd style) args);
7085
7086       let error_code =
7087         match fst style with
7088         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7089         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7090         | RConstString _ | RConstOptString _ ->
7091             pr "    const char *r;\n"; "NULL"
7092         | RString _ -> pr "    char *r;\n"; "NULL"
7093         | RStringList _ | RHashtable _ ->
7094             pr "    char **r;\n";
7095             pr "    size_t i;\n";
7096             "NULL"
7097         | RStruct (_, typ) ->
7098             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7099         | RStructList (_, typ) ->
7100             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7101         | RBufferOut _ ->
7102             pr "    char *r;\n";
7103             pr "    size_t size;\n";
7104             "NULL" in
7105
7106       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7107       pr "    r = guestfs_%s (g" name;
7108
7109       (* Generate the parameters. *)
7110       List.iter (
7111         function
7112         | OptString _, "NULL" -> pr ", NULL"
7113         | Pathname n, _
7114         | Device n, _ | Dev_or_Path n, _
7115         | String n, _
7116         | OptString n, _ ->
7117             pr ", %s" n
7118         | FileIn _, arg | FileOut _, arg ->
7119             pr ", \"%s\"" (c_quote arg)
7120         | StringList n, _ | DeviceList n, _ ->
7121             pr ", (char **) %s" n
7122         | Int _, arg ->
7123             let i =
7124               try int_of_string arg
7125               with Failure "int_of_string" ->
7126                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7127             pr ", %d" i
7128         | Int64 _, arg ->
7129             let i =
7130               try Int64.of_string arg
7131               with Failure "int_of_string" ->
7132                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7133             pr ", %Ld" i
7134         | Bool _, arg ->
7135             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7136       ) (List.combine (snd style) args);
7137
7138       (match fst style with
7139        | RBufferOut _ -> pr ", &size"
7140        | _ -> ()
7141       );
7142
7143       pr ");\n";
7144
7145       if not expect_error then
7146         pr "    if (r == %s)\n" error_code
7147       else
7148         pr "    if (r != %s)\n" error_code;
7149       pr "      return -1;\n";
7150
7151       (* Insert the test code. *)
7152       (match test with
7153        | None -> ()
7154        | Some f -> f ()
7155       );
7156
7157       (match fst style with
7158        | RErr | RInt _ | RInt64 _ | RBool _
7159        | RConstString _ | RConstOptString _ -> ()
7160        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7161        | RStringList _ | RHashtable _ ->
7162            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7163            pr "      free (r[i]);\n";
7164            pr "    free (r);\n"
7165        | RStruct (_, typ) ->
7166            pr "    guestfs_free_%s (r);\n" typ
7167        | RStructList (_, typ) ->
7168            pr "    guestfs_free_%s_list (r);\n" typ
7169       );
7170
7171       pr "  }\n"
7172
7173 and c_quote str =
7174   let str = replace_str str "\r" "\\r" in
7175   let str = replace_str str "\n" "\\n" in
7176   let str = replace_str str "\t" "\\t" in
7177   let str = replace_str str "\000" "\\0" in
7178   str
7179
7180 (* Generate a lot of different functions for guestfish. *)
7181 and generate_fish_cmds () =
7182   generate_header CStyle GPLv2plus;
7183
7184   let all_functions =
7185     List.filter (
7186       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7187     ) all_functions in
7188   let all_functions_sorted =
7189     List.filter (
7190       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7191     ) all_functions_sorted in
7192
7193   pr "#include <config.h>\n";
7194   pr "\n";
7195   pr "#include <stdio.h>\n";
7196   pr "#include <stdlib.h>\n";
7197   pr "#include <string.h>\n";
7198   pr "#include <inttypes.h>\n";
7199   pr "\n";
7200   pr "#include <guestfs.h>\n";
7201   pr "#include \"c-ctype.h\"\n";
7202   pr "#include \"full-write.h\"\n";
7203   pr "#include \"xstrtol.h\"\n";
7204   pr "#include \"fish.h\"\n";
7205   pr "\n";
7206
7207   (* list_commands function, which implements guestfish -h *)
7208   pr "void list_commands (void)\n";
7209   pr "{\n";
7210   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7211   pr "  list_builtin_commands ();\n";
7212   List.iter (
7213     fun (name, _, _, flags, _, shortdesc, _) ->
7214       let name = replace_char name '_' '-' in
7215       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7216         name shortdesc
7217   ) all_functions_sorted;
7218   pr "  printf (\"    %%s\\n\",";
7219   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7220   pr "}\n";
7221   pr "\n";
7222
7223   (* display_command function, which implements guestfish -h cmd *)
7224   pr "int display_command (const char *cmd)\n";
7225   pr "{\n";
7226   List.iter (
7227     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7228       let name2 = replace_char name '_' '-' in
7229       let alias =
7230         try find_map (function FishAlias n -> Some n | _ -> None) flags
7231         with Not_found -> name in
7232       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7233       let synopsis =
7234         match snd style with
7235         | [] -> name2
7236         | args ->
7237             sprintf "%s %s"
7238               name2 (String.concat " " (List.map name_of_argt args)) in
7239
7240       let warnings =
7241         if List.mem ProtocolLimitWarning flags then
7242           ("\n\n" ^ protocol_limit_warning)
7243         else "" in
7244
7245       (* For DangerWillRobinson commands, we should probably have
7246        * guestfish prompt before allowing you to use them (especially
7247        * in interactive mode). XXX
7248        *)
7249       let warnings =
7250         warnings ^
7251           if List.mem DangerWillRobinson flags then
7252             ("\n\n" ^ danger_will_robinson)
7253           else "" in
7254
7255       let warnings =
7256         warnings ^
7257           match deprecation_notice flags with
7258           | None -> ""
7259           | Some txt -> "\n\n" ^ txt in
7260
7261       let describe_alias =
7262         if name <> alias then
7263           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7264         else "" in
7265
7266       pr "  if (";
7267       pr "STRCASEEQ (cmd, \"%s\")" name;
7268       if name <> name2 then
7269         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7270       if name <> alias then
7271         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7272       pr ") {\n";
7273       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7274         name2 shortdesc
7275         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7276          "=head1 DESCRIPTION\n\n" ^
7277          longdesc ^ warnings ^ describe_alias);
7278       pr "    return 0;\n";
7279       pr "  }\n";
7280       pr "  else\n"
7281   ) all_functions;
7282   pr "    return display_builtin_command (cmd);\n";
7283   pr "}\n";
7284   pr "\n";
7285
7286   let emit_print_list_function typ =
7287     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7288       typ typ typ;
7289     pr "{\n";
7290     pr "  unsigned int i;\n";
7291     pr "\n";
7292     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7293     pr "    printf (\"[%%d] = {\\n\", i);\n";
7294     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7295     pr "    printf (\"}\\n\");\n";
7296     pr "  }\n";
7297     pr "}\n";
7298     pr "\n";
7299   in
7300
7301   (* print_* functions *)
7302   List.iter (
7303     fun (typ, cols) ->
7304       let needs_i =
7305         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7306
7307       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7308       pr "{\n";
7309       if needs_i then (
7310         pr "  unsigned int i;\n";
7311         pr "\n"
7312       );
7313       List.iter (
7314         function
7315         | name, FString ->
7316             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7317         | name, FUUID ->
7318             pr "  printf (\"%%s%s: \", indent);\n" name;
7319             pr "  for (i = 0; i < 32; ++i)\n";
7320             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7321             pr "  printf (\"\\n\");\n"
7322         | name, FBuffer ->
7323             pr "  printf (\"%%s%s: \", indent);\n" name;
7324             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7325             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7326             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7327             pr "    else\n";
7328             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7329             pr "  printf (\"\\n\");\n"
7330         | name, (FUInt64|FBytes) ->
7331             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7332               name typ name
7333         | name, FInt64 ->
7334             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7335               name typ name
7336         | name, FUInt32 ->
7337             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7338               name typ name
7339         | name, FInt32 ->
7340             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7341               name typ name
7342         | name, FChar ->
7343             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7344               name typ name
7345         | name, FOptPercent ->
7346             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7347               typ name name typ name;
7348             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7349       ) cols;
7350       pr "}\n";
7351       pr "\n";
7352   ) structs;
7353
7354   (* Emit a print_TYPE_list function definition only if that function is used. *)
7355   List.iter (
7356     function
7357     | typ, (RStructListOnly | RStructAndList) ->
7358         (* generate the function for typ *)
7359         emit_print_list_function typ
7360     | typ, _ -> () (* empty *)
7361   ) (rstructs_used_by all_functions);
7362
7363   (* Emit a print_TYPE function definition only if that function is used. *)
7364   List.iter (
7365     function
7366     | typ, (RStructOnly | RStructAndList) ->
7367         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7368         pr "{\n";
7369         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7370         pr "}\n";
7371         pr "\n";
7372     | typ, _ -> () (* empty *)
7373   ) (rstructs_used_by all_functions);
7374
7375   (* run_<action> actions *)
7376   List.iter (
7377     fun (name, style, _, flags, _, _, _) ->
7378       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7379       pr "{\n";
7380       (match fst style with
7381        | RErr
7382        | RInt _
7383        | RBool _ -> pr "  int r;\n"
7384        | RInt64 _ -> pr "  int64_t r;\n"
7385        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7386        | RString _ -> pr "  char *r;\n"
7387        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7388        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7389        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7390        | RBufferOut _ ->
7391            pr "  char *r;\n";
7392            pr "  size_t size;\n";
7393       );
7394       List.iter (
7395         function
7396         | Device n
7397         | String n
7398         | OptString n
7399         | FileIn n
7400         | FileOut n -> pr "  const char *%s;\n" n
7401         | Pathname n
7402         | Dev_or_Path n -> pr "  char *%s;\n" n
7403         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7404         | Bool n -> pr "  int %s;\n" n
7405         | Int n -> pr "  int %s;\n" n
7406         | Int64 n -> pr "  int64_t %s;\n" n
7407       ) (snd style);
7408
7409       (* Check and convert parameters. *)
7410       let argc_expected = List.length (snd style) in
7411       pr "  if (argc != %d) {\n" argc_expected;
7412       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7413         argc_expected;
7414       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7415       pr "    return -1;\n";
7416       pr "  }\n";
7417
7418       let parse_integer fn fntyp rtyp range name i =
7419         pr "  {\n";
7420         pr "    strtol_error xerr;\n";
7421         pr "    %s r;\n" fntyp;
7422         pr "\n";
7423         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7424         pr "    if (xerr != LONGINT_OK) {\n";
7425         pr "      fprintf (stderr,\n";
7426         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7427         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7428         pr "      return -1;\n";
7429         pr "    }\n";
7430         (match range with
7431          | None -> ()
7432          | Some (min, max, comment) ->
7433              pr "    /* %s */\n" comment;
7434              pr "    if (r < %s || r > %s) {\n" min max;
7435              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7436                name;
7437              pr "      return -1;\n";
7438              pr "    }\n";
7439              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7440         );
7441         pr "    %s = r;\n" name;
7442         pr "  }\n";
7443       in
7444
7445       iteri (
7446         fun i ->
7447           function
7448           | Device name
7449           | String name ->
7450               pr "  %s = argv[%d];\n" name i
7451           | Pathname name
7452           | Dev_or_Path name ->
7453               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7454               pr "  if (%s == NULL) return -1;\n" name
7455           | OptString name ->
7456               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7457                 name i i
7458           | FileIn name ->
7459               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7460                 name i i
7461           | FileOut name ->
7462               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7463                 name i i
7464           | StringList name | DeviceList name ->
7465               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7466               pr "  if (%s == NULL) return -1;\n" name;
7467           | Bool name ->
7468               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7469           | Int name ->
7470               let range =
7471                 let min = "(-(2LL<<30))"
7472                 and max = "((2LL<<30)-1)"
7473                 and comment =
7474                   "The Int type in the generator is a signed 31 bit int." in
7475                 Some (min, max, comment) in
7476               parse_integer "xstrtoll" "long long" "int" range name i
7477           | Int64 name ->
7478               parse_integer "xstrtoll" "long long" "int64_t" None name i
7479       ) (snd style);
7480
7481       (* Call C API function. *)
7482       let fn =
7483         try find_map (function FishAction n -> Some n | _ -> None) flags
7484         with Not_found -> sprintf "guestfs_%s" name in
7485       pr "  r = %s " fn;
7486       generate_c_call_args ~handle:"g" style;
7487       pr ";\n";
7488
7489       List.iter (
7490         function
7491         | Device _ | String _
7492         | OptString _ | Bool _
7493         | Int _ | Int64 _
7494         | FileIn _ | FileOut _ -> ()
7495         | Pathname name | Dev_or_Path name ->
7496             pr "  free (%s);\n" name
7497         | StringList name | DeviceList name ->
7498             pr "  free_strings (%s);\n" name
7499       ) (snd style);
7500
7501       (* Check return value for errors and display command results. *)
7502       (match fst style with
7503        | RErr -> pr "  return r;\n"
7504        | RInt _ ->
7505            pr "  if (r == -1) return -1;\n";
7506            pr "  printf (\"%%d\\n\", r);\n";
7507            pr "  return 0;\n"
7508        | RInt64 _ ->
7509            pr "  if (r == -1) return -1;\n";
7510            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7511            pr "  return 0;\n"
7512        | RBool _ ->
7513            pr "  if (r == -1) return -1;\n";
7514            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7515            pr "  return 0;\n"
7516        | RConstString _ ->
7517            pr "  if (r == NULL) return -1;\n";
7518            pr "  printf (\"%%s\\n\", r);\n";
7519            pr "  return 0;\n"
7520        | RConstOptString _ ->
7521            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7522            pr "  return 0;\n"
7523        | RString _ ->
7524            pr "  if (r == NULL) return -1;\n";
7525            pr "  printf (\"%%s\\n\", r);\n";
7526            pr "  free (r);\n";
7527            pr "  return 0;\n"
7528        | RStringList _ ->
7529            pr "  if (r == NULL) return -1;\n";
7530            pr "  print_strings (r);\n";
7531            pr "  free_strings (r);\n";
7532            pr "  return 0;\n"
7533        | RStruct (_, typ) ->
7534            pr "  if (r == NULL) return -1;\n";
7535            pr "  print_%s (r);\n" typ;
7536            pr "  guestfs_free_%s (r);\n" typ;
7537            pr "  return 0;\n"
7538        | RStructList (_, typ) ->
7539            pr "  if (r == NULL) return -1;\n";
7540            pr "  print_%s_list (r);\n" typ;
7541            pr "  guestfs_free_%s_list (r);\n" typ;
7542            pr "  return 0;\n"
7543        | RHashtable _ ->
7544            pr "  if (r == NULL) return -1;\n";
7545            pr "  print_table (r);\n";
7546            pr "  free_strings (r);\n";
7547            pr "  return 0;\n"
7548        | RBufferOut _ ->
7549            pr "  if (r == NULL) return -1;\n";
7550            pr "  if (full_write (1, r, size) != size) {\n";
7551            pr "    perror (\"write\");\n";
7552            pr "    free (r);\n";
7553            pr "    return -1;\n";
7554            pr "  }\n";
7555            pr "  free (r);\n";
7556            pr "  return 0;\n"
7557       );
7558       pr "}\n";
7559       pr "\n"
7560   ) all_functions;
7561
7562   (* run_action function *)
7563   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7564   pr "{\n";
7565   List.iter (
7566     fun (name, _, _, flags, _, _, _) ->
7567       let name2 = replace_char name '_' '-' in
7568       let alias =
7569         try find_map (function FishAlias n -> Some n | _ -> None) flags
7570         with Not_found -> name in
7571       pr "  if (";
7572       pr "STRCASEEQ (cmd, \"%s\")" name;
7573       if name <> name2 then
7574         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7575       if name <> alias then
7576         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7577       pr ")\n";
7578       pr "    return run_%s (cmd, argc, argv);\n" name;
7579       pr "  else\n";
7580   ) all_functions;
7581   pr "    {\n";
7582   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7583   pr "      if (command_num == 1)\n";
7584   pr "        extended_help_message ();\n";
7585   pr "      return -1;\n";
7586   pr "    }\n";
7587   pr "  return 0;\n";
7588   pr "}\n";
7589   pr "\n"
7590
7591 (* Readline completion for guestfish. *)
7592 and generate_fish_completion () =
7593   generate_header CStyle GPLv2plus;
7594
7595   let all_functions =
7596     List.filter (
7597       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7598     ) all_functions in
7599
7600   pr "\
7601 #include <config.h>
7602
7603 #include <stdio.h>
7604 #include <stdlib.h>
7605 #include <string.h>
7606
7607 #ifdef HAVE_LIBREADLINE
7608 #include <readline/readline.h>
7609 #endif
7610
7611 #include \"fish.h\"
7612
7613 #ifdef HAVE_LIBREADLINE
7614
7615 static const char *const commands[] = {
7616   BUILTIN_COMMANDS_FOR_COMPLETION,
7617 ";
7618
7619   (* Get the commands, including the aliases.  They don't need to be
7620    * sorted - the generator() function just does a dumb linear search.
7621    *)
7622   let commands =
7623     List.map (
7624       fun (name, _, _, flags, _, _, _) ->
7625         let name2 = replace_char name '_' '-' in
7626         let alias =
7627           try find_map (function FishAlias n -> Some n | _ -> None) flags
7628           with Not_found -> name in
7629
7630         if name <> alias then [name2; alias] else [name2]
7631     ) all_functions in
7632   let commands = List.flatten commands in
7633
7634   List.iter (pr "  \"%s\",\n") commands;
7635
7636   pr "  NULL
7637 };
7638
7639 static char *
7640 generator (const char *text, int state)
7641 {
7642   static size_t index, len;
7643   const char *name;
7644
7645   if (!state) {
7646     index = 0;
7647     len = strlen (text);
7648   }
7649
7650   rl_attempted_completion_over = 1;
7651
7652   while ((name = commands[index]) != NULL) {
7653     index++;
7654     if (STRCASEEQLEN (name, text, len))
7655       return strdup (name);
7656   }
7657
7658   return NULL;
7659 }
7660
7661 #endif /* HAVE_LIBREADLINE */
7662
7663 #ifdef HAVE_RL_COMPLETION_MATCHES
7664 #define RL_COMPLETION_MATCHES rl_completion_matches
7665 #else
7666 #ifdef HAVE_COMPLETION_MATCHES
7667 #define RL_COMPLETION_MATCHES completion_matches
7668 #endif
7669 #endif /* else just fail if we don't have either symbol */
7670
7671 char **
7672 do_completion (const char *text, int start, int end)
7673 {
7674   char **matches = NULL;
7675
7676 #ifdef HAVE_LIBREADLINE
7677   rl_completion_append_character = ' ';
7678
7679   if (start == 0)
7680     matches = RL_COMPLETION_MATCHES (text, generator);
7681   else if (complete_dest_paths)
7682     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7683 #endif
7684
7685   return matches;
7686 }
7687 ";
7688
7689 (* Generate the POD documentation for guestfish. *)
7690 and generate_fish_actions_pod () =
7691   let all_functions_sorted =
7692     List.filter (
7693       fun (_, _, _, flags, _, _, _) ->
7694         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7695     ) all_functions_sorted in
7696
7697   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7698
7699   List.iter (
7700     fun (name, style, _, flags, _, _, longdesc) ->
7701       let longdesc =
7702         Str.global_substitute rex (
7703           fun s ->
7704             let sub =
7705               try Str.matched_group 1 s
7706               with Not_found ->
7707                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7708             "C<" ^ replace_char sub '_' '-' ^ ">"
7709         ) longdesc in
7710       let name = replace_char name '_' '-' in
7711       let alias =
7712         try find_map (function FishAlias n -> Some n | _ -> None) flags
7713         with Not_found -> name in
7714
7715       pr "=head2 %s" name;
7716       if name <> alias then
7717         pr " | %s" alias;
7718       pr "\n";
7719       pr "\n";
7720       pr " %s" name;
7721       List.iter (
7722         function
7723         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7724         | OptString n -> pr " %s" n
7725         | StringList n | DeviceList n -> pr " '%s ...'" n
7726         | Bool _ -> pr " true|false"
7727         | Int n -> pr " %s" n
7728         | Int64 n -> pr " %s" n
7729         | FileIn n | FileOut n -> pr " (%s|-)" n
7730       ) (snd style);
7731       pr "\n";
7732       pr "\n";
7733       pr "%s\n\n" longdesc;
7734
7735       if List.exists (function FileIn _ | FileOut _ -> true
7736                       | _ -> false) (snd style) then
7737         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7738
7739       if List.mem ProtocolLimitWarning flags then
7740         pr "%s\n\n" protocol_limit_warning;
7741
7742       if List.mem DangerWillRobinson flags then
7743         pr "%s\n\n" danger_will_robinson;
7744
7745       match deprecation_notice flags with
7746       | None -> ()
7747       | Some txt -> pr "%s\n\n" txt
7748   ) all_functions_sorted
7749
7750 (* Generate a C function prototype. *)
7751 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7752     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7753     ?(prefix = "")
7754     ?handle name style =
7755   if extern then pr "extern ";
7756   if static then pr "static ";
7757   (match fst style with
7758    | RErr -> pr "int "
7759    | RInt _ -> pr "int "
7760    | RInt64 _ -> pr "int64_t "
7761    | RBool _ -> pr "int "
7762    | RConstString _ | RConstOptString _ -> pr "const char *"
7763    | RString _ | RBufferOut _ -> pr "char *"
7764    | RStringList _ | RHashtable _ -> pr "char **"
7765    | RStruct (_, typ) ->
7766        if not in_daemon then pr "struct guestfs_%s *" typ
7767        else pr "guestfs_int_%s *" typ
7768    | RStructList (_, typ) ->
7769        if not in_daemon then pr "struct guestfs_%s_list *" typ
7770        else pr "guestfs_int_%s_list *" typ
7771   );
7772   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7773   pr "%s%s (" prefix name;
7774   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7775     pr "void"
7776   else (
7777     let comma = ref false in
7778     (match handle with
7779      | None -> ()
7780      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7781     );
7782     let next () =
7783       if !comma then (
7784         if single_line then pr ", " else pr ",\n\t\t"
7785       );
7786       comma := true
7787     in
7788     List.iter (
7789       function
7790       | Pathname n
7791       | Device n | Dev_or_Path n
7792       | String n
7793       | OptString n ->
7794           next ();
7795           pr "const char *%s" n
7796       | StringList n | DeviceList n ->
7797           next ();
7798           pr "char *const *%s" n
7799       | Bool n -> next (); pr "int %s" n
7800       | Int n -> next (); pr "int %s" n
7801       | Int64 n -> next (); pr "int64_t %s" n
7802       | FileIn n
7803       | FileOut n ->
7804           if not in_daemon then (next (); pr "const char *%s" n)
7805     ) (snd style);
7806     if is_RBufferOut then (next (); pr "size_t *size_r");
7807   );
7808   pr ")";
7809   if semicolon then pr ";";
7810   if newline then pr "\n"
7811
7812 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7813 and generate_c_call_args ?handle ?(decl = false) style =
7814   pr "(";
7815   let comma = ref false in
7816   let next () =
7817     if !comma then pr ", ";
7818     comma := true
7819   in
7820   (match handle with
7821    | None -> ()
7822    | Some handle -> pr "%s" handle; comma := true
7823   );
7824   List.iter (
7825     fun arg ->
7826       next ();
7827       pr "%s" (name_of_argt arg)
7828   ) (snd style);
7829   (* For RBufferOut calls, add implicit &size parameter. *)
7830   if not decl then (
7831     match fst style with
7832     | RBufferOut _ ->
7833         next ();
7834         pr "&size"
7835     | _ -> ()
7836   );
7837   pr ")"
7838
7839 (* Generate the OCaml bindings interface. *)
7840 and generate_ocaml_mli () =
7841   generate_header OCamlStyle LGPLv2plus;
7842
7843   pr "\
7844 (** For API documentation you should refer to the C API
7845     in the guestfs(3) manual page.  The OCaml API uses almost
7846     exactly the same calls. *)
7847
7848 type t
7849 (** A [guestfs_h] handle. *)
7850
7851 exception Error of string
7852 (** This exception is raised when there is an error. *)
7853
7854 exception Handle_closed of string
7855 (** This exception is raised if you use a {!Guestfs.t} handle
7856     after calling {!close} on it.  The string is the name of
7857     the function. *)
7858
7859 val create : unit -> t
7860 (** Create a {!Guestfs.t} handle. *)
7861
7862 val close : t -> unit
7863 (** Close the {!Guestfs.t} handle and free up all resources used
7864     by it immediately.
7865
7866     Handles are closed by the garbage collector when they become
7867     unreferenced, but callers can call this in order to provide
7868     predictable cleanup. *)
7869
7870 ";
7871   generate_ocaml_structure_decls ();
7872
7873   (* The actions. *)
7874   List.iter (
7875     fun (name, style, _, _, _, shortdesc, _) ->
7876       generate_ocaml_prototype name style;
7877       pr "(** %s *)\n" shortdesc;
7878       pr "\n"
7879   ) all_functions_sorted
7880
7881 (* Generate the OCaml bindings implementation. *)
7882 and generate_ocaml_ml () =
7883   generate_header OCamlStyle LGPLv2plus;
7884
7885   pr "\
7886 type t
7887
7888 exception Error of string
7889 exception Handle_closed of string
7890
7891 external create : unit -> t = \"ocaml_guestfs_create\"
7892 external close : t -> unit = \"ocaml_guestfs_close\"
7893
7894 (* Give the exceptions names, so they can be raised from the C code. *)
7895 let () =
7896   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7897   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7898
7899 ";
7900
7901   generate_ocaml_structure_decls ();
7902
7903   (* The actions. *)
7904   List.iter (
7905     fun (name, style, _, _, _, shortdesc, _) ->
7906       generate_ocaml_prototype ~is_external:true name style;
7907   ) all_functions_sorted
7908
7909 (* Generate the OCaml bindings C implementation. *)
7910 and generate_ocaml_c () =
7911   generate_header CStyle LGPLv2plus;
7912
7913   pr "\
7914 #include <stdio.h>
7915 #include <stdlib.h>
7916 #include <string.h>
7917
7918 #include <caml/config.h>
7919 #include <caml/alloc.h>
7920 #include <caml/callback.h>
7921 #include <caml/fail.h>
7922 #include <caml/memory.h>
7923 #include <caml/mlvalues.h>
7924 #include <caml/signals.h>
7925
7926 #include \"guestfs.h\"
7927
7928 #include \"guestfs_c.h\"
7929
7930 /* Copy a hashtable of string pairs into an assoc-list.  We return
7931  * the list in reverse order, but hashtables aren't supposed to be
7932  * ordered anyway.
7933  */
7934 static CAMLprim value
7935 copy_table (char * const * argv)
7936 {
7937   CAMLparam0 ();
7938   CAMLlocal5 (rv, pairv, kv, vv, cons);
7939   size_t i;
7940
7941   rv = Val_int (0);
7942   for (i = 0; argv[i] != NULL; i += 2) {
7943     kv = caml_copy_string (argv[i]);
7944     vv = caml_copy_string (argv[i+1]);
7945     pairv = caml_alloc (2, 0);
7946     Store_field (pairv, 0, kv);
7947     Store_field (pairv, 1, vv);
7948     cons = caml_alloc (2, 0);
7949     Store_field (cons, 1, rv);
7950     rv = cons;
7951     Store_field (cons, 0, pairv);
7952   }
7953
7954   CAMLreturn (rv);
7955 }
7956
7957 ";
7958
7959   (* Struct copy functions. *)
7960
7961   let emit_ocaml_copy_list_function typ =
7962     pr "static CAMLprim value\n";
7963     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7964     pr "{\n";
7965     pr "  CAMLparam0 ();\n";
7966     pr "  CAMLlocal2 (rv, v);\n";
7967     pr "  unsigned int i;\n";
7968     pr "\n";
7969     pr "  if (%ss->len == 0)\n" typ;
7970     pr "    CAMLreturn (Atom (0));\n";
7971     pr "  else {\n";
7972     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7973     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7974     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7975     pr "      caml_modify (&Field (rv, i), v);\n";
7976     pr "    }\n";
7977     pr "    CAMLreturn (rv);\n";
7978     pr "  }\n";
7979     pr "}\n";
7980     pr "\n";
7981   in
7982
7983   List.iter (
7984     fun (typ, cols) ->
7985       let has_optpercent_col =
7986         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7987
7988       pr "static CAMLprim value\n";
7989       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7990       pr "{\n";
7991       pr "  CAMLparam0 ();\n";
7992       if has_optpercent_col then
7993         pr "  CAMLlocal3 (rv, v, v2);\n"
7994       else
7995         pr "  CAMLlocal2 (rv, v);\n";
7996       pr "\n";
7997       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7998       iteri (
7999         fun i col ->
8000           (match col with
8001            | name, FString ->
8002                pr "  v = caml_copy_string (%s->%s);\n" typ name
8003            | name, FBuffer ->
8004                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8005                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8006                  typ name typ name
8007            | name, FUUID ->
8008                pr "  v = caml_alloc_string (32);\n";
8009                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8010            | name, (FBytes|FInt64|FUInt64) ->
8011                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8012            | name, (FInt32|FUInt32) ->
8013                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8014            | name, FOptPercent ->
8015                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8016                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8017                pr "    v = caml_alloc (1, 0);\n";
8018                pr "    Store_field (v, 0, v2);\n";
8019                pr "  } else /* None */\n";
8020                pr "    v = Val_int (0);\n";
8021            | name, FChar ->
8022                pr "  v = Val_int (%s->%s);\n" typ name
8023           );
8024           pr "  Store_field (rv, %d, v);\n" i
8025       ) cols;
8026       pr "  CAMLreturn (rv);\n";
8027       pr "}\n";
8028       pr "\n";
8029   ) structs;
8030
8031   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8032   List.iter (
8033     function
8034     | typ, (RStructListOnly | RStructAndList) ->
8035         (* generate the function for typ *)
8036         emit_ocaml_copy_list_function typ
8037     | typ, _ -> () (* empty *)
8038   ) (rstructs_used_by all_functions);
8039
8040   (* The wrappers. *)
8041   List.iter (
8042     fun (name, style, _, _, _, _, _) ->
8043       pr "/* Automatically generated wrapper for function\n";
8044       pr " * ";
8045       generate_ocaml_prototype name style;
8046       pr " */\n";
8047       pr "\n";
8048
8049       let params =
8050         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8051
8052       let needs_extra_vs =
8053         match fst style with RConstOptString _ -> true | _ -> false in
8054
8055       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8056       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8057       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8058       pr "\n";
8059
8060       pr "CAMLprim value\n";
8061       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8062       List.iter (pr ", value %s") (List.tl params);
8063       pr ")\n";
8064       pr "{\n";
8065
8066       (match params with
8067        | [p1; p2; p3; p4; p5] ->
8068            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8069        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8070            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8071            pr "  CAMLxparam%d (%s);\n"
8072              (List.length rest) (String.concat ", " rest)
8073        | ps ->
8074            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8075       );
8076       if not needs_extra_vs then
8077         pr "  CAMLlocal1 (rv);\n"
8078       else
8079         pr "  CAMLlocal3 (rv, v, v2);\n";
8080       pr "\n";
8081
8082       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8083       pr "  if (g == NULL)\n";
8084       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8085       pr "\n";
8086
8087       List.iter (
8088         function
8089         | Pathname n
8090         | Device n | Dev_or_Path n
8091         | String n
8092         | FileIn n
8093         | FileOut n ->
8094             (* Copy strings in case the GC moves them: RHBZ#604691 *)
8095             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
8096         | OptString n ->
8097             pr "  char *%s =\n" n;
8098             pr "    %sv != Val_int (0) ?" n;
8099             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
8100         | StringList n | DeviceList n ->
8101             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8102         | Bool n ->
8103             pr "  int %s = Bool_val (%sv);\n" n n
8104         | Int n ->
8105             pr "  int %s = Int_val (%sv);\n" n n
8106         | Int64 n ->
8107             pr "  int64_t %s = Int64_val (%sv);\n" n n
8108       ) (snd style);
8109       let error_code =
8110         match fst style with
8111         | RErr -> pr "  int r;\n"; "-1"
8112         | RInt _ -> pr "  int r;\n"; "-1"
8113         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8114         | RBool _ -> pr "  int r;\n"; "-1"
8115         | RConstString _ | RConstOptString _ ->
8116             pr "  const char *r;\n"; "NULL"
8117         | RString _ -> pr "  char *r;\n"; "NULL"
8118         | RStringList _ ->
8119             pr "  size_t i;\n";
8120             pr "  char **r;\n";
8121             "NULL"
8122         | RStruct (_, typ) ->
8123             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8124         | RStructList (_, typ) ->
8125             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8126         | RHashtable _ ->
8127             pr "  size_t i;\n";
8128             pr "  char **r;\n";
8129             "NULL"
8130         | RBufferOut _ ->
8131             pr "  char *r;\n";
8132             pr "  size_t size;\n";
8133             "NULL" in
8134       pr "\n";
8135
8136       pr "  caml_enter_blocking_section ();\n";
8137       pr "  r = guestfs_%s " name;
8138       generate_c_call_args ~handle:"g" style;
8139       pr ";\n";
8140       pr "  caml_leave_blocking_section ();\n";
8141
8142       (* Free strings if we copied them above. *)
8143       List.iter (
8144         function
8145         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
8146         | FileIn n | FileOut n ->
8147             pr "  free (%s);\n" n
8148         | StringList n | DeviceList n ->
8149             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8150         | Bool _ | Int _ | Int64 _ -> ()
8151       ) (snd style);
8152
8153       pr "  if (r == %s)\n" error_code;
8154       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8155       pr "\n";
8156
8157       (match fst style with
8158        | RErr -> pr "  rv = Val_unit;\n"
8159        | RInt _ -> pr "  rv = Val_int (r);\n"
8160        | RInt64 _ ->
8161            pr "  rv = caml_copy_int64 (r);\n"
8162        | RBool _ -> pr "  rv = Val_bool (r);\n"
8163        | RConstString _ ->
8164            pr "  rv = caml_copy_string (r);\n"
8165        | RConstOptString _ ->
8166            pr "  if (r) { /* Some string */\n";
8167            pr "    v = caml_alloc (1, 0);\n";
8168            pr "    v2 = caml_copy_string (r);\n";
8169            pr "    Store_field (v, 0, v2);\n";
8170            pr "  } else /* None */\n";
8171            pr "    v = Val_int (0);\n";
8172        | RString _ ->
8173            pr "  rv = caml_copy_string (r);\n";
8174            pr "  free (r);\n"
8175        | RStringList _ ->
8176            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8177            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8178            pr "  free (r);\n"
8179        | RStruct (_, typ) ->
8180            pr "  rv = copy_%s (r);\n" typ;
8181            pr "  guestfs_free_%s (r);\n" typ;
8182        | RStructList (_, typ) ->
8183            pr "  rv = copy_%s_list (r);\n" typ;
8184            pr "  guestfs_free_%s_list (r);\n" typ;
8185        | RHashtable _ ->
8186            pr "  rv = copy_table (r);\n";
8187            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8188            pr "  free (r);\n";
8189        | RBufferOut _ ->
8190            pr "  rv = caml_alloc_string (size);\n";
8191            pr "  memcpy (String_val (rv), r, size);\n";
8192       );
8193
8194       pr "  CAMLreturn (rv);\n";
8195       pr "}\n";
8196       pr "\n";
8197
8198       if List.length params > 5 then (
8199         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8200         pr "CAMLprim value ";
8201         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8202         pr "CAMLprim value\n";
8203         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8204         pr "{\n";
8205         pr "  return ocaml_guestfs_%s (argv[0]" name;
8206         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8207         pr ");\n";
8208         pr "}\n";
8209         pr "\n"
8210       )
8211   ) all_functions_sorted
8212
8213 and generate_ocaml_structure_decls () =
8214   List.iter (
8215     fun (typ, cols) ->
8216       pr "type %s = {\n" typ;
8217       List.iter (
8218         function
8219         | name, FString -> pr "  %s : string;\n" name
8220         | name, FBuffer -> pr "  %s : string;\n" name
8221         | name, FUUID -> pr "  %s : string;\n" name
8222         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8223         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8224         | name, FChar -> pr "  %s : char;\n" name
8225         | name, FOptPercent -> pr "  %s : float option;\n" name
8226       ) cols;
8227       pr "}\n";
8228       pr "\n"
8229   ) structs
8230
8231 and generate_ocaml_prototype ?(is_external = false) name style =
8232   if is_external then pr "external " else pr "val ";
8233   pr "%s : t -> " name;
8234   List.iter (
8235     function
8236     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8237     | OptString _ -> pr "string option -> "
8238     | StringList _ | DeviceList _ -> pr "string array -> "
8239     | Bool _ -> pr "bool -> "
8240     | Int _ -> pr "int -> "
8241     | Int64 _ -> pr "int64 -> "
8242   ) (snd style);
8243   (match fst style with
8244    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8245    | RInt _ -> pr "int"
8246    | RInt64 _ -> pr "int64"
8247    | RBool _ -> pr "bool"
8248    | RConstString _ -> pr "string"
8249    | RConstOptString _ -> pr "string option"
8250    | RString _ | RBufferOut _ -> pr "string"
8251    | RStringList _ -> pr "string array"
8252    | RStruct (_, typ) -> pr "%s" typ
8253    | RStructList (_, typ) -> pr "%s array" typ
8254    | RHashtable _ -> pr "(string * string) list"
8255   );
8256   if is_external then (
8257     pr " = ";
8258     if List.length (snd style) + 1 > 5 then
8259       pr "\"ocaml_guestfs_%s_byte\" " name;
8260     pr "\"ocaml_guestfs_%s\"" name
8261   );
8262   pr "\n"
8263
8264 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8265 and generate_perl_xs () =
8266   generate_header CStyle LGPLv2plus;
8267
8268   pr "\
8269 #include \"EXTERN.h\"
8270 #include \"perl.h\"
8271 #include \"XSUB.h\"
8272
8273 #include <guestfs.h>
8274
8275 #ifndef PRId64
8276 #define PRId64 \"lld\"
8277 #endif
8278
8279 static SV *
8280 my_newSVll(long long val) {
8281 #ifdef USE_64_BIT_ALL
8282   return newSViv(val);
8283 #else
8284   char buf[100];
8285   int len;
8286   len = snprintf(buf, 100, \"%%\" PRId64, val);
8287   return newSVpv(buf, len);
8288 #endif
8289 }
8290
8291 #ifndef PRIu64
8292 #define PRIu64 \"llu\"
8293 #endif
8294
8295 static SV *
8296 my_newSVull(unsigned long long val) {
8297 #ifdef USE_64_BIT_ALL
8298   return newSVuv(val);
8299 #else
8300   char buf[100];
8301   int len;
8302   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8303   return newSVpv(buf, len);
8304 #endif
8305 }
8306
8307 /* http://www.perlmonks.org/?node_id=680842 */
8308 static char **
8309 XS_unpack_charPtrPtr (SV *arg) {
8310   char **ret;
8311   AV *av;
8312   I32 i;
8313
8314   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8315     croak (\"array reference expected\");
8316
8317   av = (AV *)SvRV (arg);
8318   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8319   if (!ret)
8320     croak (\"malloc failed\");
8321
8322   for (i = 0; i <= av_len (av); i++) {
8323     SV **elem = av_fetch (av, i, 0);
8324
8325     if (!elem || !*elem)
8326       croak (\"missing element in list\");
8327
8328     ret[i] = SvPV_nolen (*elem);
8329   }
8330
8331   ret[i] = NULL;
8332
8333   return ret;
8334 }
8335
8336 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8337
8338 PROTOTYPES: ENABLE
8339
8340 guestfs_h *
8341 _create ()
8342    CODE:
8343       RETVAL = guestfs_create ();
8344       if (!RETVAL)
8345         croak (\"could not create guestfs handle\");
8346       guestfs_set_error_handler (RETVAL, NULL, NULL);
8347  OUTPUT:
8348       RETVAL
8349
8350 void
8351 DESTROY (g)
8352       guestfs_h *g;
8353  PPCODE:
8354       guestfs_close (g);
8355
8356 ";
8357
8358   List.iter (
8359     fun (name, style, _, _, _, _, _) ->
8360       (match fst style with
8361        | RErr -> pr "void\n"
8362        | RInt _ -> pr "SV *\n"
8363        | RInt64 _ -> pr "SV *\n"
8364        | RBool _ -> pr "SV *\n"
8365        | RConstString _ -> pr "SV *\n"
8366        | RConstOptString _ -> pr "SV *\n"
8367        | RString _ -> pr "SV *\n"
8368        | RBufferOut _ -> pr "SV *\n"
8369        | RStringList _
8370        | RStruct _ | RStructList _
8371        | RHashtable _ ->
8372            pr "void\n" (* all lists returned implictly on the stack *)
8373       );
8374       (* Call and arguments. *)
8375       pr "%s " name;
8376       generate_c_call_args ~handle:"g" ~decl:true style;
8377       pr "\n";
8378       pr "      guestfs_h *g;\n";
8379       iteri (
8380         fun i ->
8381           function
8382           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8383               pr "      char *%s;\n" n
8384           | OptString n ->
8385               (* http://www.perlmonks.org/?node_id=554277
8386                * Note that the implicit handle argument means we have
8387                * to add 1 to the ST(x) operator.
8388                *)
8389               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8390           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8391           | Bool n -> pr "      int %s;\n" n
8392           | Int n -> pr "      int %s;\n" n
8393           | Int64 n -> pr "      int64_t %s;\n" n
8394       ) (snd style);
8395
8396       let do_cleanups () =
8397         List.iter (
8398           function
8399           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8400           | Bool _ | Int _ | Int64 _
8401           | FileIn _ | FileOut _ -> ()
8402           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8403         ) (snd style)
8404       in
8405
8406       (* Code. *)
8407       (match fst style with
8408        | RErr ->
8409            pr "PREINIT:\n";
8410            pr "      int r;\n";
8411            pr " PPCODE:\n";
8412            pr "      r = guestfs_%s " name;
8413            generate_c_call_args ~handle:"g" style;
8414            pr ";\n";
8415            do_cleanups ();
8416            pr "      if (r == -1)\n";
8417            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8418        | RInt n
8419        | RBool n ->
8420            pr "PREINIT:\n";
8421            pr "      int %s;\n" n;
8422            pr "   CODE:\n";
8423            pr "      %s = guestfs_%s " n name;
8424            generate_c_call_args ~handle:"g" style;
8425            pr ";\n";
8426            do_cleanups ();
8427            pr "      if (%s == -1)\n" n;
8428            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8429            pr "      RETVAL = newSViv (%s);\n" n;
8430            pr " OUTPUT:\n";
8431            pr "      RETVAL\n"
8432        | RInt64 n ->
8433            pr "PREINIT:\n";
8434            pr "      int64_t %s;\n" n;
8435            pr "   CODE:\n";
8436            pr "      %s = guestfs_%s " n name;
8437            generate_c_call_args ~handle:"g" style;
8438            pr ";\n";
8439            do_cleanups ();
8440            pr "      if (%s == -1)\n" n;
8441            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8442            pr "      RETVAL = my_newSVll (%s);\n" n;
8443            pr " OUTPUT:\n";
8444            pr "      RETVAL\n"
8445        | RConstString n ->
8446            pr "PREINIT:\n";
8447            pr "      const char *%s;\n" n;
8448            pr "   CODE:\n";
8449            pr "      %s = guestfs_%s " n name;
8450            generate_c_call_args ~handle:"g" style;
8451            pr ";\n";
8452            do_cleanups ();
8453            pr "      if (%s == NULL)\n" n;
8454            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8455            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8456            pr " OUTPUT:\n";
8457            pr "      RETVAL\n"
8458        | RConstOptString n ->
8459            pr "PREINIT:\n";
8460            pr "      const char *%s;\n" n;
8461            pr "   CODE:\n";
8462            pr "      %s = guestfs_%s " n name;
8463            generate_c_call_args ~handle:"g" style;
8464            pr ";\n";
8465            do_cleanups ();
8466            pr "      if (%s == NULL)\n" n;
8467            pr "        RETVAL = &PL_sv_undef;\n";
8468            pr "      else\n";
8469            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8470            pr " OUTPUT:\n";
8471            pr "      RETVAL\n"
8472        | RString n ->
8473            pr "PREINIT:\n";
8474            pr "      char *%s;\n" n;
8475            pr "   CODE:\n";
8476            pr "      %s = guestfs_%s " n name;
8477            generate_c_call_args ~handle:"g" style;
8478            pr ";\n";
8479            do_cleanups ();
8480            pr "      if (%s == NULL)\n" n;
8481            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8482            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8483            pr "      free (%s);\n" n;
8484            pr " OUTPUT:\n";
8485            pr "      RETVAL\n"
8486        | RStringList n | RHashtable n ->
8487            pr "PREINIT:\n";
8488            pr "      char **%s;\n" n;
8489            pr "      size_t i, n;\n";
8490            pr " PPCODE:\n";
8491            pr "      %s = guestfs_%s " n name;
8492            generate_c_call_args ~handle:"g" style;
8493            pr ";\n";
8494            do_cleanups ();
8495            pr "      if (%s == NULL)\n" n;
8496            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8497            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8498            pr "      EXTEND (SP, n);\n";
8499            pr "      for (i = 0; i < n; ++i) {\n";
8500            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8501            pr "        free (%s[i]);\n" n;
8502            pr "      }\n";
8503            pr "      free (%s);\n" n;
8504        | RStruct (n, typ) ->
8505            let cols = cols_of_struct typ in
8506            generate_perl_struct_code typ cols name style n do_cleanups
8507        | RStructList (n, typ) ->
8508            let cols = cols_of_struct typ in
8509            generate_perl_struct_list_code typ cols name style n do_cleanups
8510        | RBufferOut n ->
8511            pr "PREINIT:\n";
8512            pr "      char *%s;\n" n;
8513            pr "      size_t size;\n";
8514            pr "   CODE:\n";
8515            pr "      %s = guestfs_%s " n name;
8516            generate_c_call_args ~handle:"g" style;
8517            pr ";\n";
8518            do_cleanups ();
8519            pr "      if (%s == NULL)\n" n;
8520            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8521            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8522            pr "      free (%s);\n" n;
8523            pr " OUTPUT:\n";
8524            pr "      RETVAL\n"
8525       );
8526
8527       pr "\n"
8528   ) all_functions
8529
8530 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8531   pr "PREINIT:\n";
8532   pr "      struct guestfs_%s_list *%s;\n" typ n;
8533   pr "      size_t i;\n";
8534   pr "      HV *hv;\n";
8535   pr " PPCODE:\n";
8536   pr "      %s = guestfs_%s " n name;
8537   generate_c_call_args ~handle:"g" style;
8538   pr ";\n";
8539   do_cleanups ();
8540   pr "      if (%s == NULL)\n" n;
8541   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8542   pr "      EXTEND (SP, %s->len);\n" n;
8543   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8544   pr "        hv = newHV ();\n";
8545   List.iter (
8546     function
8547     | name, FString ->
8548         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8549           name (String.length name) n name
8550     | name, FUUID ->
8551         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8552           name (String.length name) n name
8553     | name, FBuffer ->
8554         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8555           name (String.length name) n name n name
8556     | name, (FBytes|FUInt64) ->
8557         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8558           name (String.length name) n name
8559     | name, FInt64 ->
8560         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8561           name (String.length name) n name
8562     | name, (FInt32|FUInt32) ->
8563         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8564           name (String.length name) n name
8565     | name, FChar ->
8566         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8567           name (String.length name) n name
8568     | name, FOptPercent ->
8569         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8570           name (String.length name) n name
8571   ) cols;
8572   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8573   pr "      }\n";
8574   pr "      guestfs_free_%s_list (%s);\n" typ n
8575
8576 and generate_perl_struct_code typ cols name style n do_cleanups =
8577   pr "PREINIT:\n";
8578   pr "      struct guestfs_%s *%s;\n" typ n;
8579   pr " PPCODE:\n";
8580   pr "      %s = guestfs_%s " n name;
8581   generate_c_call_args ~handle:"g" style;
8582   pr ";\n";
8583   do_cleanups ();
8584   pr "      if (%s == NULL)\n" n;
8585   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8586   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8587   List.iter (
8588     fun ((name, _) as col) ->
8589       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8590
8591       match col with
8592       | name, FString ->
8593           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8594             n name
8595       | name, FBuffer ->
8596           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8597             n name n name
8598       | name, FUUID ->
8599           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8600             n name
8601       | name, (FBytes|FUInt64) ->
8602           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8603             n name
8604       | name, FInt64 ->
8605           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8606             n name
8607       | name, (FInt32|FUInt32) ->
8608           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8609             n name
8610       | name, FChar ->
8611           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8612             n name
8613       | name, FOptPercent ->
8614           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8615             n name
8616   ) cols;
8617   pr "      free (%s);\n" n
8618
8619 (* Generate Sys/Guestfs.pm. *)
8620 and generate_perl_pm () =
8621   generate_header HashStyle LGPLv2plus;
8622
8623   pr "\
8624 =pod
8625
8626 =head1 NAME
8627
8628 Sys::Guestfs - Perl bindings for libguestfs
8629
8630 =head1 SYNOPSIS
8631
8632  use Sys::Guestfs;
8633
8634  my $h = Sys::Guestfs->new ();
8635  $h->add_drive ('guest.img');
8636  $h->launch ();
8637  $h->mount ('/dev/sda1', '/');
8638  $h->touch ('/hello');
8639  $h->sync ();
8640
8641 =head1 DESCRIPTION
8642
8643 The C<Sys::Guestfs> module provides a Perl XS binding to the
8644 libguestfs API for examining and modifying virtual machine
8645 disk images.
8646
8647 Amongst the things this is good for: making batch configuration
8648 changes to guests, getting disk used/free statistics (see also:
8649 virt-df), migrating between virtualization systems (see also:
8650 virt-p2v), performing partial backups, performing partial guest
8651 clones, cloning guests and changing registry/UUID/hostname info, and
8652 much else besides.
8653
8654 Libguestfs uses Linux kernel and qemu code, and can access any type of
8655 guest filesystem that Linux and qemu can, including but not limited
8656 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8657 schemes, qcow, qcow2, vmdk.
8658
8659 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8660 LVs, what filesystem is in each LV, etc.).  It can also run commands
8661 in the context of the guest.  Also you can access filesystems over
8662 FUSE.
8663
8664 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8665 functions for using libguestfs from Perl, including integration
8666 with libvirt.
8667
8668 =head1 ERRORS
8669
8670 All errors turn into calls to C<croak> (see L<Carp(3)>).
8671
8672 =head1 METHODS
8673
8674 =over 4
8675
8676 =cut
8677
8678 package Sys::Guestfs;
8679
8680 use strict;
8681 use warnings;
8682
8683 require XSLoader;
8684 XSLoader::load ('Sys::Guestfs');
8685
8686 =item $h = Sys::Guestfs->new ();
8687
8688 Create a new guestfs handle.
8689
8690 =cut
8691
8692 sub new {
8693   my $proto = shift;
8694   my $class = ref ($proto) || $proto;
8695
8696   my $self = Sys::Guestfs::_create ();
8697   bless $self, $class;
8698   return $self;
8699 }
8700
8701 ";
8702
8703   (* Actions.  We only need to print documentation for these as
8704    * they are pulled in from the XS code automatically.
8705    *)
8706   List.iter (
8707     fun (name, style, _, flags, _, _, longdesc) ->
8708       if not (List.mem NotInDocs flags) then (
8709         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8710         pr "=item ";
8711         generate_perl_prototype name style;
8712         pr "\n\n";
8713         pr "%s\n\n" longdesc;
8714         if List.mem ProtocolLimitWarning flags then
8715           pr "%s\n\n" protocol_limit_warning;
8716         if List.mem DangerWillRobinson flags then
8717           pr "%s\n\n" danger_will_robinson;
8718         match deprecation_notice flags with
8719         | None -> ()
8720         | Some txt -> pr "%s\n\n" txt
8721       )
8722   ) all_functions_sorted;
8723
8724   (* End of file. *)
8725   pr "\
8726 =cut
8727
8728 1;
8729
8730 =back
8731
8732 =head1 COPYRIGHT
8733
8734 Copyright (C) %s Red Hat Inc.
8735
8736 =head1 LICENSE
8737
8738 Please see the file COPYING.LIB for the full license.
8739
8740 =head1 SEE ALSO
8741
8742 L<guestfs(3)>,
8743 L<guestfish(1)>,
8744 L<http://libguestfs.org>,
8745 L<Sys::Guestfs::Lib(3)>.
8746
8747 =cut
8748 " copyright_years
8749
8750 and generate_perl_prototype name style =
8751   (match fst style with
8752    | RErr -> ()
8753    | RBool n
8754    | RInt n
8755    | RInt64 n
8756    | RConstString n
8757    | RConstOptString n
8758    | RString n
8759    | RBufferOut n -> pr "$%s = " n
8760    | RStruct (n,_)
8761    | RHashtable n -> pr "%%%s = " n
8762    | RStringList n
8763    | RStructList (n,_) -> pr "@%s = " n
8764   );
8765   pr "$h->%s (" name;
8766   let comma = ref false in
8767   List.iter (
8768     fun arg ->
8769       if !comma then pr ", ";
8770       comma := true;
8771       match arg with
8772       | Pathname n | Device n | Dev_or_Path n | String n
8773       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8774           pr "$%s" n
8775       | StringList n | DeviceList n ->
8776           pr "\\@%s" n
8777   ) (snd style);
8778   pr ");"
8779
8780 (* Generate Python C module. *)
8781 and generate_python_c () =
8782   generate_header CStyle LGPLv2plus;
8783
8784   pr "\
8785 #include <Python.h>
8786
8787 #include <stdio.h>
8788 #include <stdlib.h>
8789 #include <assert.h>
8790
8791 #include \"guestfs.h\"
8792
8793 typedef struct {
8794   PyObject_HEAD
8795   guestfs_h *g;
8796 } Pyguestfs_Object;
8797
8798 static guestfs_h *
8799 get_handle (PyObject *obj)
8800 {
8801   assert (obj);
8802   assert (obj != Py_None);
8803   return ((Pyguestfs_Object *) obj)->g;
8804 }
8805
8806 static PyObject *
8807 put_handle (guestfs_h *g)
8808 {
8809   assert (g);
8810   return
8811     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8812 }
8813
8814 /* This list should be freed (but not the strings) after use. */
8815 static char **
8816 get_string_list (PyObject *obj)
8817 {
8818   size_t i, len;
8819   char **r;
8820
8821   assert (obj);
8822
8823   if (!PyList_Check (obj)) {
8824     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8825     return NULL;
8826   }
8827
8828   Py_ssize_t slen = PyList_Size (obj);
8829   if (slen == -1) {
8830     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
8831     return NULL;
8832   }
8833   len = (size_t) slen;
8834   r = malloc (sizeof (char *) * (len+1));
8835   if (r == NULL) {
8836     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8837     return NULL;
8838   }
8839
8840   for (i = 0; i < len; ++i)
8841     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8842   r[len] = NULL;
8843
8844   return r;
8845 }
8846
8847 static PyObject *
8848 put_string_list (char * const * const argv)
8849 {
8850   PyObject *list;
8851   int argc, i;
8852
8853   for (argc = 0; argv[argc] != NULL; ++argc)
8854     ;
8855
8856   list = PyList_New (argc);
8857   for (i = 0; i < argc; ++i)
8858     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8859
8860   return list;
8861 }
8862
8863 static PyObject *
8864 put_table (char * const * const argv)
8865 {
8866   PyObject *list, *item;
8867   int argc, i;
8868
8869   for (argc = 0; argv[argc] != NULL; ++argc)
8870     ;
8871
8872   list = PyList_New (argc >> 1);
8873   for (i = 0; i < argc; i += 2) {
8874     item = PyTuple_New (2);
8875     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8876     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8877     PyList_SetItem (list, i >> 1, item);
8878   }
8879
8880   return list;
8881 }
8882
8883 static void
8884 free_strings (char **argv)
8885 {
8886   int argc;
8887
8888   for (argc = 0; argv[argc] != NULL; ++argc)
8889     free (argv[argc]);
8890   free (argv);
8891 }
8892
8893 static PyObject *
8894 py_guestfs_create (PyObject *self, PyObject *args)
8895 {
8896   guestfs_h *g;
8897
8898   g = guestfs_create ();
8899   if (g == NULL) {
8900     PyErr_SetString (PyExc_RuntimeError,
8901                      \"guestfs.create: failed to allocate handle\");
8902     return NULL;
8903   }
8904   guestfs_set_error_handler (g, NULL, NULL);
8905   return put_handle (g);
8906 }
8907
8908 static PyObject *
8909 py_guestfs_close (PyObject *self, PyObject *args)
8910 {
8911   PyObject *py_g;
8912   guestfs_h *g;
8913
8914   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8915     return NULL;
8916   g = get_handle (py_g);
8917
8918   guestfs_close (g);
8919
8920   Py_INCREF (Py_None);
8921   return Py_None;
8922 }
8923
8924 ";
8925
8926   let emit_put_list_function typ =
8927     pr "static PyObject *\n";
8928     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8929     pr "{\n";
8930     pr "  PyObject *list;\n";
8931     pr "  size_t i;\n";
8932     pr "\n";
8933     pr "  list = PyList_New (%ss->len);\n" typ;
8934     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8935     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8936     pr "  return list;\n";
8937     pr "};\n";
8938     pr "\n"
8939   in
8940
8941   (* Structures, turned into Python dictionaries. *)
8942   List.iter (
8943     fun (typ, cols) ->
8944       pr "static PyObject *\n";
8945       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8946       pr "{\n";
8947       pr "  PyObject *dict;\n";
8948       pr "\n";
8949       pr "  dict = PyDict_New ();\n";
8950       List.iter (
8951         function
8952         | name, FString ->
8953             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8954             pr "                        PyString_FromString (%s->%s));\n"
8955               typ name
8956         | name, FBuffer ->
8957             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8958             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8959               typ name typ name
8960         | name, FUUID ->
8961             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8962             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8963               typ name
8964         | name, (FBytes|FUInt64) ->
8965             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8966             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8967               typ name
8968         | name, FInt64 ->
8969             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8970             pr "                        PyLong_FromLongLong (%s->%s));\n"
8971               typ name
8972         | name, FUInt32 ->
8973             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8974             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8975               typ name
8976         | name, FInt32 ->
8977             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8978             pr "                        PyLong_FromLong (%s->%s));\n"
8979               typ name
8980         | name, FOptPercent ->
8981             pr "  if (%s->%s >= 0)\n" typ name;
8982             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8983             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8984               typ name;
8985             pr "  else {\n";
8986             pr "    Py_INCREF (Py_None);\n";
8987             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8988             pr "  }\n"
8989         | name, FChar ->
8990             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8991             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8992       ) cols;
8993       pr "  return dict;\n";
8994       pr "};\n";
8995       pr "\n";
8996
8997   ) structs;
8998
8999   (* Emit a put_TYPE_list function definition only if that function is used. *)
9000   List.iter (
9001     function
9002     | typ, (RStructListOnly | RStructAndList) ->
9003         (* generate the function for typ *)
9004         emit_put_list_function typ
9005     | typ, _ -> () (* empty *)
9006   ) (rstructs_used_by all_functions);
9007
9008   (* Python wrapper functions. *)
9009   List.iter (
9010     fun (name, style, _, _, _, _, _) ->
9011       pr "static PyObject *\n";
9012       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9013       pr "{\n";
9014
9015       pr "  PyObject *py_g;\n";
9016       pr "  guestfs_h *g;\n";
9017       pr "  PyObject *py_r;\n";
9018
9019       let error_code =
9020         match fst style with
9021         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9022         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9023         | RConstString _ | RConstOptString _ ->
9024             pr "  const char *r;\n"; "NULL"
9025         | RString _ -> pr "  char *r;\n"; "NULL"
9026         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9027         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9028         | RStructList (_, typ) ->
9029             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9030         | RBufferOut _ ->
9031             pr "  char *r;\n";
9032             pr "  size_t size;\n";
9033             "NULL" in
9034
9035       List.iter (
9036         function
9037         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9038             pr "  const char *%s;\n" n
9039         | OptString n -> pr "  const char *%s;\n" n
9040         | StringList n | DeviceList n ->
9041             pr "  PyObject *py_%s;\n" n;
9042             pr "  char **%s;\n" n
9043         | Bool n -> pr "  int %s;\n" n
9044         | Int n -> pr "  int %s;\n" n
9045         | Int64 n -> pr "  long long %s;\n" n
9046       ) (snd style);
9047
9048       pr "\n";
9049
9050       (* Convert the parameters. *)
9051       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9052       List.iter (
9053         function
9054         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9055         | OptString _ -> pr "z"
9056         | StringList _ | DeviceList _ -> pr "O"
9057         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9058         | Int _ -> pr "i"
9059         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9060                              * emulate C's int/long/long long in Python?
9061                              *)
9062       ) (snd style);
9063       pr ":guestfs_%s\",\n" name;
9064       pr "                         &py_g";
9065       List.iter (
9066         function
9067         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9068         | OptString n -> pr ", &%s" n
9069         | StringList n | DeviceList n -> pr ", &py_%s" n
9070         | Bool n -> pr ", &%s" n
9071         | Int n -> pr ", &%s" n
9072         | Int64 n -> pr ", &%s" n
9073       ) (snd style);
9074
9075       pr "))\n";
9076       pr "    return NULL;\n";
9077
9078       pr "  g = get_handle (py_g);\n";
9079       List.iter (
9080         function
9081         | Pathname _ | Device _ | Dev_or_Path _ | String _
9082         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9083         | StringList n | DeviceList n ->
9084             pr "  %s = get_string_list (py_%s);\n" n n;
9085             pr "  if (!%s) return NULL;\n" n
9086       ) (snd style);
9087
9088       pr "\n";
9089
9090       pr "  r = guestfs_%s " name;
9091       generate_c_call_args ~handle:"g" style;
9092       pr ";\n";
9093
9094       List.iter (
9095         function
9096         | Pathname _ | Device _ | Dev_or_Path _ | String _
9097         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9098         | StringList n | DeviceList n ->
9099             pr "  free (%s);\n" n
9100       ) (snd style);
9101
9102       pr "  if (r == %s) {\n" error_code;
9103       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9104       pr "    return NULL;\n";
9105       pr "  }\n";
9106       pr "\n";
9107
9108       (match fst style with
9109        | RErr ->
9110            pr "  Py_INCREF (Py_None);\n";
9111            pr "  py_r = Py_None;\n"
9112        | RInt _
9113        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9114        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9115        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9116        | RConstOptString _ ->
9117            pr "  if (r)\n";
9118            pr "    py_r = PyString_FromString (r);\n";
9119            pr "  else {\n";
9120            pr "    Py_INCREF (Py_None);\n";
9121            pr "    py_r = Py_None;\n";
9122            pr "  }\n"
9123        | RString _ ->
9124            pr "  py_r = PyString_FromString (r);\n";
9125            pr "  free (r);\n"
9126        | RStringList _ ->
9127            pr "  py_r = put_string_list (r);\n";
9128            pr "  free_strings (r);\n"
9129        | RStruct (_, typ) ->
9130            pr "  py_r = put_%s (r);\n" typ;
9131            pr "  guestfs_free_%s (r);\n" typ
9132        | RStructList (_, typ) ->
9133            pr "  py_r = put_%s_list (r);\n" typ;
9134            pr "  guestfs_free_%s_list (r);\n" typ
9135        | RHashtable n ->
9136            pr "  py_r = put_table (r);\n";
9137            pr "  free_strings (r);\n"
9138        | RBufferOut _ ->
9139            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9140            pr "  free (r);\n"
9141       );
9142
9143       pr "  return py_r;\n";
9144       pr "}\n";
9145       pr "\n"
9146   ) all_functions;
9147
9148   (* Table of functions. *)
9149   pr "static PyMethodDef methods[] = {\n";
9150   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9151   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9152   List.iter (
9153     fun (name, _, _, _, _, _, _) ->
9154       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9155         name name
9156   ) all_functions;
9157   pr "  { NULL, NULL, 0, NULL }\n";
9158   pr "};\n";
9159   pr "\n";
9160
9161   (* Init function. *)
9162   pr "\
9163 void
9164 initlibguestfsmod (void)
9165 {
9166   static int initialized = 0;
9167
9168   if (initialized) return;
9169   Py_InitModule ((char *) \"libguestfsmod\", methods);
9170   initialized = 1;
9171 }
9172 "
9173
9174 (* Generate Python module. *)
9175 and generate_python_py () =
9176   generate_header HashStyle LGPLv2plus;
9177
9178   pr "\
9179 u\"\"\"Python bindings for libguestfs
9180
9181 import guestfs
9182 g = guestfs.GuestFS ()
9183 g.add_drive (\"guest.img\")
9184 g.launch ()
9185 parts = g.list_partitions ()
9186
9187 The guestfs module provides a Python binding to the libguestfs API
9188 for examining and modifying virtual machine disk images.
9189
9190 Amongst the things this is good for: making batch configuration
9191 changes to guests, getting disk used/free statistics (see also:
9192 virt-df), migrating between virtualization systems (see also:
9193 virt-p2v), performing partial backups, performing partial guest
9194 clones, cloning guests and changing registry/UUID/hostname info, and
9195 much else besides.
9196
9197 Libguestfs uses Linux kernel and qemu code, and can access any type of
9198 guest filesystem that Linux and qemu can, including but not limited
9199 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9200 schemes, qcow, qcow2, vmdk.
9201
9202 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9203 LVs, what filesystem is in each LV, etc.).  It can also run commands
9204 in the context of the guest.  Also you can access filesystems over
9205 FUSE.
9206
9207 Errors which happen while using the API are turned into Python
9208 RuntimeError exceptions.
9209
9210 To create a guestfs handle you usually have to perform the following
9211 sequence of calls:
9212
9213 # Create the handle, call add_drive at least once, and possibly
9214 # several times if the guest has multiple block devices:
9215 g = guestfs.GuestFS ()
9216 g.add_drive (\"guest.img\")
9217
9218 # Launch the qemu subprocess and wait for it to become ready:
9219 g.launch ()
9220
9221 # Now you can issue commands, for example:
9222 logvols = g.lvs ()
9223
9224 \"\"\"
9225
9226 import libguestfsmod
9227
9228 class GuestFS:
9229     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9230
9231     def __init__ (self):
9232         \"\"\"Create a new libguestfs handle.\"\"\"
9233         self._o = libguestfsmod.create ()
9234
9235     def __del__ (self):
9236         libguestfsmod.close (self._o)
9237
9238 ";
9239
9240   List.iter (
9241     fun (name, style, _, flags, _, _, longdesc) ->
9242       pr "    def %s " name;
9243       generate_py_call_args ~handle:"self" (snd style);
9244       pr ":\n";
9245
9246       if not (List.mem NotInDocs flags) then (
9247         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9248         let doc =
9249           match fst style with
9250           | RErr | RInt _ | RInt64 _ | RBool _
9251           | RConstOptString _ | RConstString _
9252           | RString _ | RBufferOut _ -> doc
9253           | RStringList _ ->
9254               doc ^ "\n\nThis function returns a list of strings."
9255           | RStruct (_, typ) ->
9256               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9257           | RStructList (_, typ) ->
9258               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9259           | RHashtable _ ->
9260               doc ^ "\n\nThis function returns a dictionary." in
9261         let doc =
9262           if List.mem ProtocolLimitWarning flags then
9263             doc ^ "\n\n" ^ protocol_limit_warning
9264           else doc in
9265         let doc =
9266           if List.mem DangerWillRobinson flags then
9267             doc ^ "\n\n" ^ danger_will_robinson
9268           else doc in
9269         let doc =
9270           match deprecation_notice flags with
9271           | None -> doc
9272           | Some txt -> doc ^ "\n\n" ^ txt in
9273         let doc = pod2text ~width:60 name doc in
9274         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9275         let doc = String.concat "\n        " doc in
9276         pr "        u\"\"\"%s\"\"\"\n" doc;
9277       );
9278       pr "        return libguestfsmod.%s " name;
9279       generate_py_call_args ~handle:"self._o" (snd style);
9280       pr "\n";
9281       pr "\n";
9282   ) all_functions
9283
9284 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9285 and generate_py_call_args ~handle args =
9286   pr "(%s" handle;
9287   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9288   pr ")"
9289
9290 (* Useful if you need the longdesc POD text as plain text.  Returns a
9291  * list of lines.
9292  *
9293  * Because this is very slow (the slowest part of autogeneration),
9294  * we memoize the results.
9295  *)
9296 and pod2text ~width name longdesc =
9297   let key = width, name, longdesc in
9298   try Hashtbl.find pod2text_memo key
9299   with Not_found ->
9300     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9301     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9302     close_out chan;
9303     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9304     let chan = open_process_in cmd in
9305     let lines = ref [] in
9306     let rec loop i =
9307       let line = input_line chan in
9308       if i = 1 then             (* discard the first line of output *)
9309         loop (i+1)
9310       else (
9311         let line = triml line in
9312         lines := line :: !lines;
9313         loop (i+1)
9314       ) in
9315     let lines = try loop 1 with End_of_file -> List.rev !lines in
9316     unlink filename;
9317     (match close_process_in chan with
9318      | WEXITED 0 -> ()
9319      | WEXITED i ->
9320          failwithf "pod2text: process exited with non-zero status (%d)" i
9321      | WSIGNALED i | WSTOPPED i ->
9322          failwithf "pod2text: process signalled or stopped by signal %d" i
9323     );
9324     Hashtbl.add pod2text_memo key lines;
9325     pod2text_memo_updated ();
9326     lines
9327
9328 (* Generate ruby bindings. *)
9329 and generate_ruby_c () =
9330   generate_header CStyle LGPLv2plus;
9331
9332   pr "\
9333 #include <stdio.h>
9334 #include <stdlib.h>
9335
9336 #include <ruby.h>
9337
9338 #include \"guestfs.h\"
9339
9340 #include \"extconf.h\"
9341
9342 /* For Ruby < 1.9 */
9343 #ifndef RARRAY_LEN
9344 #define RARRAY_LEN(r) (RARRAY((r))->len)
9345 #endif
9346
9347 static VALUE m_guestfs;                 /* guestfs module */
9348 static VALUE c_guestfs;                 /* guestfs_h handle */
9349 static VALUE e_Error;                   /* used for all errors */
9350
9351 static void ruby_guestfs_free (void *p)
9352 {
9353   if (!p) return;
9354   guestfs_close ((guestfs_h *) p);
9355 }
9356
9357 static VALUE ruby_guestfs_create (VALUE m)
9358 {
9359   guestfs_h *g;
9360
9361   g = guestfs_create ();
9362   if (!g)
9363     rb_raise (e_Error, \"failed to create guestfs handle\");
9364
9365   /* Don't print error messages to stderr by default. */
9366   guestfs_set_error_handler (g, NULL, NULL);
9367
9368   /* Wrap it, and make sure the close function is called when the
9369    * handle goes away.
9370    */
9371   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9372 }
9373
9374 static VALUE ruby_guestfs_close (VALUE gv)
9375 {
9376   guestfs_h *g;
9377   Data_Get_Struct (gv, guestfs_h, g);
9378
9379   ruby_guestfs_free (g);
9380   DATA_PTR (gv) = NULL;
9381
9382   return Qnil;
9383 }
9384
9385 ";
9386
9387   List.iter (
9388     fun (name, style, _, _, _, _, _) ->
9389       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9390       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9391       pr ")\n";
9392       pr "{\n";
9393       pr "  guestfs_h *g;\n";
9394       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9395       pr "  if (!g)\n";
9396       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9397         name;
9398       pr "\n";
9399
9400       List.iter (
9401         function
9402         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9403             pr "  Check_Type (%sv, T_STRING);\n" n;
9404             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9405             pr "  if (!%s)\n" n;
9406             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9407             pr "              \"%s\", \"%s\");\n" n name
9408         | OptString n ->
9409             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9410         | StringList n | DeviceList n ->
9411             pr "  char **%s;\n" n;
9412             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9413             pr "  {\n";
9414             pr "    size_t i, len;\n";
9415             pr "    len = RARRAY_LEN (%sv);\n" n;
9416             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9417               n;
9418             pr "    for (i = 0; i < len; ++i) {\n";
9419             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9420             pr "      %s[i] = StringValueCStr (v);\n" n;
9421             pr "    }\n";
9422             pr "    %s[len] = NULL;\n" n;
9423             pr "  }\n";
9424         | Bool n ->
9425             pr "  int %s = RTEST (%sv);\n" n n
9426         | Int n ->
9427             pr "  int %s = NUM2INT (%sv);\n" n n
9428         | Int64 n ->
9429             pr "  long long %s = NUM2LL (%sv);\n" n n
9430       ) (snd style);
9431       pr "\n";
9432
9433       let error_code =
9434         match fst style with
9435         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9436         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9437         | RConstString _ | RConstOptString _ ->
9438             pr "  const char *r;\n"; "NULL"
9439         | RString _ -> pr "  char *r;\n"; "NULL"
9440         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9441         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9442         | RStructList (_, typ) ->
9443             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9444         | RBufferOut _ ->
9445             pr "  char *r;\n";
9446             pr "  size_t size;\n";
9447             "NULL" in
9448       pr "\n";
9449
9450       pr "  r = guestfs_%s " name;
9451       generate_c_call_args ~handle:"g" style;
9452       pr ";\n";
9453
9454       List.iter (
9455         function
9456         | Pathname _ | Device _ | Dev_or_Path _ | String _
9457         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9458         | StringList n | DeviceList n ->
9459             pr "  free (%s);\n" n
9460       ) (snd style);
9461
9462       pr "  if (r == %s)\n" error_code;
9463       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9464       pr "\n";
9465
9466       (match fst style with
9467        | RErr ->
9468            pr "  return Qnil;\n"
9469        | RInt _ | RBool _ ->
9470            pr "  return INT2NUM (r);\n"
9471        | RInt64 _ ->
9472            pr "  return ULL2NUM (r);\n"
9473        | RConstString _ ->
9474            pr "  return rb_str_new2 (r);\n";
9475        | RConstOptString _ ->
9476            pr "  if (r)\n";
9477            pr "    return rb_str_new2 (r);\n";
9478            pr "  else\n";
9479            pr "    return Qnil;\n";
9480        | RString _ ->
9481            pr "  VALUE rv = rb_str_new2 (r);\n";
9482            pr "  free (r);\n";
9483            pr "  return rv;\n";
9484        | RStringList _ ->
9485            pr "  size_t i, len = 0;\n";
9486            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9487            pr "  VALUE rv = rb_ary_new2 (len);\n";
9488            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9489            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9490            pr "    free (r[i]);\n";
9491            pr "  }\n";
9492            pr "  free (r);\n";
9493            pr "  return rv;\n"
9494        | RStruct (_, typ) ->
9495            let cols = cols_of_struct typ in
9496            generate_ruby_struct_code typ cols
9497        | RStructList (_, typ) ->
9498            let cols = cols_of_struct typ in
9499            generate_ruby_struct_list_code typ cols
9500        | RHashtable _ ->
9501            pr "  VALUE rv = rb_hash_new ();\n";
9502            pr "  size_t i;\n";
9503            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9504            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9505            pr "    free (r[i]);\n";
9506            pr "    free (r[i+1]);\n";
9507            pr "  }\n";
9508            pr "  free (r);\n";
9509            pr "  return rv;\n"
9510        | RBufferOut _ ->
9511            pr "  VALUE rv = rb_str_new (r, size);\n";
9512            pr "  free (r);\n";
9513            pr "  return rv;\n";
9514       );
9515
9516       pr "}\n";
9517       pr "\n"
9518   ) all_functions;
9519
9520   pr "\
9521 /* Initialize the module. */
9522 void Init__guestfs ()
9523 {
9524   m_guestfs = rb_define_module (\"Guestfs\");
9525   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9526   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9527
9528   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9529   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9530
9531 ";
9532   (* Define the rest of the methods. *)
9533   List.iter (
9534     fun (name, style, _, _, _, _, _) ->
9535       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9536       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9537   ) all_functions;
9538
9539   pr "}\n"
9540
9541 (* Ruby code to return a struct. *)
9542 and generate_ruby_struct_code typ cols =
9543   pr "  VALUE rv = rb_hash_new ();\n";
9544   List.iter (
9545     function
9546     | name, FString ->
9547         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9548     | name, FBuffer ->
9549         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9550     | name, FUUID ->
9551         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9552     | name, (FBytes|FUInt64) ->
9553         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9554     | name, FInt64 ->
9555         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9556     | name, FUInt32 ->
9557         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9558     | name, FInt32 ->
9559         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9560     | name, FOptPercent ->
9561         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9562     | name, FChar -> (* XXX wrong? *)
9563         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9564   ) cols;
9565   pr "  guestfs_free_%s (r);\n" typ;
9566   pr "  return rv;\n"
9567
9568 (* Ruby code to return a struct list. *)
9569 and generate_ruby_struct_list_code typ cols =
9570   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9571   pr "  size_t i;\n";
9572   pr "  for (i = 0; i < r->len; ++i) {\n";
9573   pr "    VALUE hv = rb_hash_new ();\n";
9574   List.iter (
9575     function
9576     | name, FString ->
9577         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9578     | name, FBuffer ->
9579         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
9580     | name, FUUID ->
9581         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9582     | name, (FBytes|FUInt64) ->
9583         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9584     | name, FInt64 ->
9585         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9586     | name, FUInt32 ->
9587         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9588     | name, FInt32 ->
9589         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9590     | name, FOptPercent ->
9591         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9592     | name, FChar -> (* XXX wrong? *)
9593         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9594   ) cols;
9595   pr "    rb_ary_push (rv, hv);\n";
9596   pr "  }\n";
9597   pr "  guestfs_free_%s_list (r);\n" typ;
9598   pr "  return rv;\n"
9599
9600 (* Generate Java bindings GuestFS.java file. *)
9601 and generate_java_java () =
9602   generate_header CStyle LGPLv2plus;
9603
9604   pr "\
9605 package com.redhat.et.libguestfs;
9606
9607 import java.util.HashMap;
9608 import com.redhat.et.libguestfs.LibGuestFSException;
9609 import com.redhat.et.libguestfs.PV;
9610 import com.redhat.et.libguestfs.VG;
9611 import com.redhat.et.libguestfs.LV;
9612 import com.redhat.et.libguestfs.Stat;
9613 import com.redhat.et.libguestfs.StatVFS;
9614 import com.redhat.et.libguestfs.IntBool;
9615 import com.redhat.et.libguestfs.Dirent;
9616
9617 /**
9618  * The GuestFS object is a libguestfs handle.
9619  *
9620  * @author rjones
9621  */
9622 public class GuestFS {
9623   // Load the native code.
9624   static {
9625     System.loadLibrary (\"guestfs_jni\");
9626   }
9627
9628   /**
9629    * The native guestfs_h pointer.
9630    */
9631   long g;
9632
9633   /**
9634    * Create a libguestfs handle.
9635    *
9636    * @throws LibGuestFSException
9637    */
9638   public GuestFS () throws LibGuestFSException
9639   {
9640     g = _create ();
9641   }
9642   private native long _create () throws LibGuestFSException;
9643
9644   /**
9645    * Close a libguestfs handle.
9646    *
9647    * You can also leave handles to be collected by the garbage
9648    * collector, but this method ensures that the resources used
9649    * by the handle are freed up immediately.  If you call any
9650    * other methods after closing the handle, you will get an
9651    * exception.
9652    *
9653    * @throws LibGuestFSException
9654    */
9655   public void close () throws LibGuestFSException
9656   {
9657     if (g != 0)
9658       _close (g);
9659     g = 0;
9660   }
9661   private native void _close (long g) throws LibGuestFSException;
9662
9663   public void finalize () throws LibGuestFSException
9664   {
9665     close ();
9666   }
9667
9668 ";
9669
9670   List.iter (
9671     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9672       if not (List.mem NotInDocs flags); then (
9673         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9674         let doc =
9675           if List.mem ProtocolLimitWarning flags then
9676             doc ^ "\n\n" ^ protocol_limit_warning
9677           else doc in
9678         let doc =
9679           if List.mem DangerWillRobinson flags then
9680             doc ^ "\n\n" ^ danger_will_robinson
9681           else doc in
9682         let doc =
9683           match deprecation_notice flags with
9684           | None -> doc
9685           | Some txt -> doc ^ "\n\n" ^ txt in
9686         let doc = pod2text ~width:60 name doc in
9687         let doc = List.map (            (* RHBZ#501883 *)
9688           function
9689           | "" -> "<p>"
9690           | nonempty -> nonempty
9691         ) doc in
9692         let doc = String.concat "\n   * " doc in
9693
9694         pr "  /**\n";
9695         pr "   * %s\n" shortdesc;
9696         pr "   * <p>\n";
9697         pr "   * %s\n" doc;
9698         pr "   * @throws LibGuestFSException\n";
9699         pr "   */\n";
9700         pr "  ";
9701       );
9702       generate_java_prototype ~public:true ~semicolon:false name style;
9703       pr "\n";
9704       pr "  {\n";
9705       pr "    if (g == 0)\n";
9706       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9707         name;
9708       pr "    ";
9709       if fst style <> RErr then pr "return ";
9710       pr "_%s " name;
9711       generate_java_call_args ~handle:"g" (snd style);
9712       pr ";\n";
9713       pr "  }\n";
9714       pr "  ";
9715       generate_java_prototype ~privat:true ~native:true name style;
9716       pr "\n";
9717       pr "\n";
9718   ) all_functions;
9719
9720   pr "}\n"
9721
9722 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9723 and generate_java_call_args ~handle args =
9724   pr "(%s" handle;
9725   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9726   pr ")"
9727
9728 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9729     ?(semicolon=true) name style =
9730   if privat then pr "private ";
9731   if public then pr "public ";
9732   if native then pr "native ";
9733
9734   (* return type *)
9735   (match fst style with
9736    | RErr -> pr "void ";
9737    | RInt _ -> pr "int ";
9738    | RInt64 _ -> pr "long ";
9739    | RBool _ -> pr "boolean ";
9740    | RConstString _ | RConstOptString _ | RString _
9741    | RBufferOut _ -> pr "String ";
9742    | RStringList _ -> pr "String[] ";
9743    | RStruct (_, typ) ->
9744        let name = java_name_of_struct typ in
9745        pr "%s " name;
9746    | RStructList (_, typ) ->
9747        let name = java_name_of_struct typ in
9748        pr "%s[] " name;
9749    | RHashtable _ -> pr "HashMap<String,String> ";
9750   );
9751
9752   if native then pr "_%s " name else pr "%s " name;
9753   pr "(";
9754   let needs_comma = ref false in
9755   if native then (
9756     pr "long g";
9757     needs_comma := true
9758   );
9759
9760   (* args *)
9761   List.iter (
9762     fun arg ->
9763       if !needs_comma then pr ", ";
9764       needs_comma := true;
9765
9766       match arg with
9767       | Pathname n
9768       | Device n | Dev_or_Path n
9769       | String n
9770       | OptString n
9771       | FileIn n
9772       | FileOut n ->
9773           pr "String %s" n
9774       | StringList n | DeviceList n ->
9775           pr "String[] %s" n
9776       | Bool n ->
9777           pr "boolean %s" n
9778       | Int n ->
9779           pr "int %s" n
9780       | Int64 n ->
9781           pr "long %s" n
9782   ) (snd style);
9783
9784   pr ")\n";
9785   pr "    throws LibGuestFSException";
9786   if semicolon then pr ";"
9787
9788 and generate_java_struct jtyp cols () =
9789   generate_header CStyle LGPLv2plus;
9790
9791   pr "\
9792 package com.redhat.et.libguestfs;
9793
9794 /**
9795  * Libguestfs %s structure.
9796  *
9797  * @author rjones
9798  * @see GuestFS
9799  */
9800 public class %s {
9801 " jtyp jtyp;
9802
9803   List.iter (
9804     function
9805     | name, FString
9806     | name, FUUID
9807     | name, FBuffer -> pr "  public String %s;\n" name
9808     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9809     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9810     | name, FChar -> pr "  public char %s;\n" name
9811     | name, FOptPercent ->
9812         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9813         pr "  public float %s;\n" name
9814   ) cols;
9815
9816   pr "}\n"
9817
9818 and generate_java_c () =
9819   generate_header CStyle LGPLv2plus;
9820
9821   pr "\
9822 #include <stdio.h>
9823 #include <stdlib.h>
9824 #include <string.h>
9825
9826 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9827 #include \"guestfs.h\"
9828
9829 /* Note that this function returns.  The exception is not thrown
9830  * until after the wrapper function returns.
9831  */
9832 static void
9833 throw_exception (JNIEnv *env, const char *msg)
9834 {
9835   jclass cl;
9836   cl = (*env)->FindClass (env,
9837                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9838   (*env)->ThrowNew (env, cl, msg);
9839 }
9840
9841 JNIEXPORT jlong JNICALL
9842 Java_com_redhat_et_libguestfs_GuestFS__1create
9843   (JNIEnv *env, jobject obj)
9844 {
9845   guestfs_h *g;
9846
9847   g = guestfs_create ();
9848   if (g == NULL) {
9849     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9850     return 0;
9851   }
9852   guestfs_set_error_handler (g, NULL, NULL);
9853   return (jlong) (long) g;
9854 }
9855
9856 JNIEXPORT void JNICALL
9857 Java_com_redhat_et_libguestfs_GuestFS__1close
9858   (JNIEnv *env, jobject obj, jlong jg)
9859 {
9860   guestfs_h *g = (guestfs_h *) (long) jg;
9861   guestfs_close (g);
9862 }
9863
9864 ";
9865
9866   List.iter (
9867     fun (name, style, _, _, _, _, _) ->
9868       pr "JNIEXPORT ";
9869       (match fst style with
9870        | RErr -> pr "void ";
9871        | RInt _ -> pr "jint ";
9872        | RInt64 _ -> pr "jlong ";
9873        | RBool _ -> pr "jboolean ";
9874        | RConstString _ | RConstOptString _ | RString _
9875        | RBufferOut _ -> pr "jstring ";
9876        | RStruct _ | RHashtable _ ->
9877            pr "jobject ";
9878        | RStringList _ | RStructList _ ->
9879            pr "jobjectArray ";
9880       );
9881       pr "JNICALL\n";
9882       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9883       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9884       pr "\n";
9885       pr "  (JNIEnv *env, jobject obj, jlong jg";
9886       List.iter (
9887         function
9888         | Pathname n
9889         | Device n | Dev_or_Path n
9890         | String n
9891         | OptString n
9892         | FileIn n
9893         | FileOut n ->
9894             pr ", jstring j%s" n
9895         | StringList n | DeviceList n ->
9896             pr ", jobjectArray j%s" n
9897         | Bool n ->
9898             pr ", jboolean j%s" n
9899         | Int n ->
9900             pr ", jint j%s" n
9901         | Int64 n ->
9902             pr ", jlong j%s" n
9903       ) (snd style);
9904       pr ")\n";
9905       pr "{\n";
9906       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9907       let error_code, no_ret =
9908         match fst style with
9909         | RErr -> pr "  int r;\n"; "-1", ""
9910         | RBool _
9911         | RInt _ -> pr "  int r;\n"; "-1", "0"
9912         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9913         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9914         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9915         | RString _ ->
9916             pr "  jstring jr;\n";
9917             pr "  char *r;\n"; "NULL", "NULL"
9918         | RStringList _ ->
9919             pr "  jobjectArray jr;\n";
9920             pr "  int r_len;\n";
9921             pr "  jclass cl;\n";
9922             pr "  jstring jstr;\n";
9923             pr "  char **r;\n"; "NULL", "NULL"
9924         | RStruct (_, typ) ->
9925             pr "  jobject jr;\n";
9926             pr "  jclass cl;\n";
9927             pr "  jfieldID fl;\n";
9928             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9929         | RStructList (_, typ) ->
9930             pr "  jobjectArray jr;\n";
9931             pr "  jclass cl;\n";
9932             pr "  jfieldID fl;\n";
9933             pr "  jobject jfl;\n";
9934             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9935         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9936         | RBufferOut _ ->
9937             pr "  jstring jr;\n";
9938             pr "  char *r;\n";
9939             pr "  size_t size;\n";
9940             "NULL", "NULL" in
9941       List.iter (
9942         function
9943         | Pathname n
9944         | Device n | Dev_or_Path n
9945         | String n
9946         | OptString n
9947         | FileIn n
9948         | FileOut n ->
9949             pr "  const char *%s;\n" n
9950         | StringList n | DeviceList n ->
9951             pr "  int %s_len;\n" n;
9952             pr "  const char **%s;\n" n
9953         | Bool n
9954         | Int n ->
9955             pr "  int %s;\n" n
9956         | Int64 n ->
9957             pr "  int64_t %s;\n" n
9958       ) (snd style);
9959
9960       let needs_i =
9961         (match fst style with
9962          | RStringList _ | RStructList _ -> true
9963          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9964          | RConstOptString _
9965          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9966           List.exists (function
9967                        | StringList _ -> true
9968                        | DeviceList _ -> true
9969                        | _ -> false) (snd style) in
9970       if needs_i then
9971         pr "  size_t i;\n";
9972
9973       pr "\n";
9974
9975       (* Get the parameters. *)
9976       List.iter (
9977         function
9978         | Pathname n
9979         | Device n | Dev_or_Path n
9980         | String n
9981         | FileIn n
9982         | FileOut n ->
9983             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9984         | OptString n ->
9985             (* This is completely undocumented, but Java null becomes
9986              * a NULL parameter.
9987              *)
9988             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9989         | StringList n | DeviceList n ->
9990             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9991             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9992             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9993             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9994               n;
9995             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9996             pr "  }\n";
9997             pr "  %s[%s_len] = NULL;\n" n n;
9998         | Bool n
9999         | Int n
10000         | Int64 n ->
10001             pr "  %s = j%s;\n" n n
10002       ) (snd style);
10003
10004       (* Make the call. *)
10005       pr "  r = guestfs_%s " name;
10006       generate_c_call_args ~handle:"g" style;
10007       pr ";\n";
10008
10009       (* Release the parameters. *)
10010       List.iter (
10011         function
10012         | Pathname n
10013         | Device n | Dev_or_Path n
10014         | String n
10015         | FileIn n
10016         | FileOut n ->
10017             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10018         | OptString n ->
10019             pr "  if (j%s)\n" n;
10020             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10021         | StringList n | DeviceList n ->
10022             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10023             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10024               n;
10025             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10026             pr "  }\n";
10027             pr "  free (%s);\n" n
10028         | Bool n
10029         | Int n
10030         | Int64 n -> ()
10031       ) (snd style);
10032
10033       (* Check for errors. *)
10034       pr "  if (r == %s) {\n" error_code;
10035       pr "    throw_exception (env, guestfs_last_error (g));\n";
10036       pr "    return %s;\n" no_ret;
10037       pr "  }\n";
10038
10039       (* Return value. *)
10040       (match fst style with
10041        | RErr -> ()
10042        | RInt _ -> pr "  return (jint) r;\n"
10043        | RBool _ -> pr "  return (jboolean) r;\n"
10044        | RInt64 _ -> pr "  return (jlong) r;\n"
10045        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10046        | RConstOptString _ ->
10047            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10048        | RString _ ->
10049            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10050            pr "  free (r);\n";
10051            pr "  return jr;\n"
10052        | RStringList _ ->
10053            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10054            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10055            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10056            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10057            pr "  for (i = 0; i < r_len; ++i) {\n";
10058            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10059            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10060            pr "    free (r[i]);\n";
10061            pr "  }\n";
10062            pr "  free (r);\n";
10063            pr "  return jr;\n"
10064        | RStruct (_, typ) ->
10065            let jtyp = java_name_of_struct typ in
10066            let cols = cols_of_struct typ in
10067            generate_java_struct_return typ jtyp cols
10068        | RStructList (_, typ) ->
10069            let jtyp = java_name_of_struct typ in
10070            let cols = cols_of_struct typ in
10071            generate_java_struct_list_return typ jtyp cols
10072        | RHashtable _ ->
10073            (* XXX *)
10074            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10075            pr "  return NULL;\n"
10076        | RBufferOut _ ->
10077            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10078            pr "  free (r);\n";
10079            pr "  return jr;\n"
10080       );
10081
10082       pr "}\n";
10083       pr "\n"
10084   ) all_functions
10085
10086 and generate_java_struct_return typ jtyp cols =
10087   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10088   pr "  jr = (*env)->AllocObject (env, cl);\n";
10089   List.iter (
10090     function
10091     | name, FString ->
10092         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10093         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10094     | name, FUUID ->
10095         pr "  {\n";
10096         pr "    char s[33];\n";
10097         pr "    memcpy (s, r->%s, 32);\n" name;
10098         pr "    s[32] = 0;\n";
10099         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10100         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10101         pr "  }\n";
10102     | name, FBuffer ->
10103         pr "  {\n";
10104         pr "    int len = r->%s_len;\n" name;
10105         pr "    char s[len+1];\n";
10106         pr "    memcpy (s, r->%s, len);\n" name;
10107         pr "    s[len] = 0;\n";
10108         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10109         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10110         pr "  }\n";
10111     | name, (FBytes|FUInt64|FInt64) ->
10112         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10113         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10114     | name, (FUInt32|FInt32) ->
10115         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10116         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10117     | name, FOptPercent ->
10118         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10119         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10120     | name, FChar ->
10121         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10122         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10123   ) cols;
10124   pr "  free (r);\n";
10125   pr "  return jr;\n"
10126
10127 and generate_java_struct_list_return typ jtyp cols =
10128   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10129   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10130   pr "  for (i = 0; i < r->len; ++i) {\n";
10131   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10132   List.iter (
10133     function
10134     | name, FString ->
10135         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10136         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10137     | name, FUUID ->
10138         pr "    {\n";
10139         pr "      char s[33];\n";
10140         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10141         pr "      s[32] = 0;\n";
10142         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10143         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10144         pr "    }\n";
10145     | name, FBuffer ->
10146         pr "    {\n";
10147         pr "      int len = r->val[i].%s_len;\n" name;
10148         pr "      char s[len+1];\n";
10149         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10150         pr "      s[len] = 0;\n";
10151         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10152         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10153         pr "    }\n";
10154     | name, (FBytes|FUInt64|FInt64) ->
10155         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10156         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10157     | name, (FUInt32|FInt32) ->
10158         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10159         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10160     | name, FOptPercent ->
10161         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10162         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10163     | name, FChar ->
10164         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10165         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10166   ) cols;
10167   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10168   pr "  }\n";
10169   pr "  guestfs_free_%s_list (r);\n" typ;
10170   pr "  return jr;\n"
10171
10172 and generate_java_makefile_inc () =
10173   generate_header HashStyle GPLv2plus;
10174
10175   pr "java_built_sources = \\\n";
10176   List.iter (
10177     fun (typ, jtyp) ->
10178         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10179   ) java_structs;
10180   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10181
10182 and generate_haskell_hs () =
10183   generate_header HaskellStyle LGPLv2plus;
10184
10185   (* XXX We only know how to generate partial FFI for Haskell
10186    * at the moment.  Please help out!
10187    *)
10188   let can_generate style =
10189     match style with
10190     | RErr, _
10191     | RInt _, _
10192     | RInt64 _, _ -> true
10193     | RBool _, _
10194     | RConstString _, _
10195     | RConstOptString _, _
10196     | RString _, _
10197     | RStringList _, _
10198     | RStruct _, _
10199     | RStructList _, _
10200     | RHashtable _, _
10201     | RBufferOut _, _ -> false in
10202
10203   pr "\
10204 {-# INCLUDE <guestfs.h> #-}
10205 {-# LANGUAGE ForeignFunctionInterface #-}
10206
10207 module Guestfs (
10208   create";
10209
10210   (* List out the names of the actions we want to export. *)
10211   List.iter (
10212     fun (name, style, _, _, _, _, _) ->
10213       if can_generate style then pr ",\n  %s" name
10214   ) all_functions;
10215
10216   pr "
10217   ) where
10218
10219 -- Unfortunately some symbols duplicate ones already present
10220 -- in Prelude.  We don't know which, so we hard-code a list
10221 -- here.
10222 import Prelude hiding (truncate)
10223
10224 import Foreign
10225 import Foreign.C
10226 import Foreign.C.Types
10227 import IO
10228 import Control.Exception
10229 import Data.Typeable
10230
10231 data GuestfsS = GuestfsS            -- represents the opaque C struct
10232 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10233 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10234
10235 -- XXX define properly later XXX
10236 data PV = PV
10237 data VG = VG
10238 data LV = LV
10239 data IntBool = IntBool
10240 data Stat = Stat
10241 data StatVFS = StatVFS
10242 data Hashtable = Hashtable
10243
10244 foreign import ccall unsafe \"guestfs_create\" c_create
10245   :: IO GuestfsP
10246 foreign import ccall unsafe \"&guestfs_close\" c_close
10247   :: FunPtr (GuestfsP -> IO ())
10248 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10249   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10250
10251 create :: IO GuestfsH
10252 create = do
10253   p <- c_create
10254   c_set_error_handler p nullPtr nullPtr
10255   h <- newForeignPtr c_close p
10256   return h
10257
10258 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10259   :: GuestfsP -> IO CString
10260
10261 -- last_error :: GuestfsH -> IO (Maybe String)
10262 -- last_error h = do
10263 --   str <- withForeignPtr h (\\p -> c_last_error p)
10264 --   maybePeek peekCString str
10265
10266 last_error :: GuestfsH -> IO (String)
10267 last_error h = do
10268   str <- withForeignPtr h (\\p -> c_last_error p)
10269   if (str == nullPtr)
10270     then return \"no error\"
10271     else peekCString str
10272
10273 ";
10274
10275   (* Generate wrappers for each foreign function. *)
10276   List.iter (
10277     fun (name, style, _, _, _, _, _) ->
10278       if can_generate style then (
10279         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10280         pr "  :: ";
10281         generate_haskell_prototype ~handle:"GuestfsP" style;
10282         pr "\n";
10283         pr "\n";
10284         pr "%s :: " name;
10285         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10286         pr "\n";
10287         pr "%s %s = do\n" name
10288           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10289         pr "  r <- ";
10290         (* Convert pointer arguments using with* functions. *)
10291         List.iter (
10292           function
10293           | FileIn n
10294           | FileOut n
10295           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10296           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10297           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10298           | Bool _ | Int _ | Int64 _ -> ()
10299         ) (snd style);
10300         (* Convert integer arguments. *)
10301         let args =
10302           List.map (
10303             function
10304             | Bool n -> sprintf "(fromBool %s)" n
10305             | Int n -> sprintf "(fromIntegral %s)" n
10306             | Int64 n -> sprintf "(fromIntegral %s)" n
10307             | FileIn n | FileOut n
10308             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10309           ) (snd style) in
10310         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10311           (String.concat " " ("p" :: args));
10312         (match fst style with
10313          | RErr | RInt _ | RInt64 _ | RBool _ ->
10314              pr "  if (r == -1)\n";
10315              pr "    then do\n";
10316              pr "      err <- last_error h\n";
10317              pr "      fail err\n";
10318          | RConstString _ | RConstOptString _ | RString _
10319          | RStringList _ | RStruct _
10320          | RStructList _ | RHashtable _ | RBufferOut _ ->
10321              pr "  if (r == nullPtr)\n";
10322              pr "    then do\n";
10323              pr "      err <- last_error h\n";
10324              pr "      fail err\n";
10325         );
10326         (match fst style with
10327          | RErr ->
10328              pr "    else return ()\n"
10329          | RInt _ ->
10330              pr "    else return (fromIntegral r)\n"
10331          | RInt64 _ ->
10332              pr "    else return (fromIntegral r)\n"
10333          | RBool _ ->
10334              pr "    else return (toBool r)\n"
10335          | RConstString _
10336          | RConstOptString _
10337          | RString _
10338          | RStringList _
10339          | RStruct _
10340          | RStructList _
10341          | RHashtable _
10342          | RBufferOut _ ->
10343              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10344         );
10345         pr "\n";
10346       )
10347   ) all_functions
10348
10349 and generate_haskell_prototype ~handle ?(hs = false) style =
10350   pr "%s -> " handle;
10351   let string = if hs then "String" else "CString" in
10352   let int = if hs then "Int" else "CInt" in
10353   let bool = if hs then "Bool" else "CInt" in
10354   let int64 = if hs then "Integer" else "Int64" in
10355   List.iter (
10356     fun arg ->
10357       (match arg with
10358        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10359        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10360        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10361        | Bool _ -> pr "%s" bool
10362        | Int _ -> pr "%s" int
10363        | Int64 _ -> pr "%s" int
10364        | FileIn _ -> pr "%s" string
10365        | FileOut _ -> pr "%s" string
10366       );
10367       pr " -> ";
10368   ) (snd style);
10369   pr "IO (";
10370   (match fst style with
10371    | RErr -> if not hs then pr "CInt"
10372    | RInt _ -> pr "%s" int
10373    | RInt64 _ -> pr "%s" int64
10374    | RBool _ -> pr "%s" bool
10375    | RConstString _ -> pr "%s" string
10376    | RConstOptString _ -> pr "Maybe %s" string
10377    | RString _ -> pr "%s" string
10378    | RStringList _ -> pr "[%s]" string
10379    | RStruct (_, typ) ->
10380        let name = java_name_of_struct typ in
10381        pr "%s" name
10382    | RStructList (_, typ) ->
10383        let name = java_name_of_struct typ in
10384        pr "[%s]" name
10385    | RHashtable _ -> pr "Hashtable"
10386    | RBufferOut _ -> pr "%s" string
10387   );
10388   pr ")"
10389
10390 and generate_csharp () =
10391   generate_header CPlusPlusStyle LGPLv2plus;
10392
10393   (* XXX Make this configurable by the C# assembly users. *)
10394   let library = "libguestfs.so.0" in
10395
10396   pr "\
10397 // These C# bindings are highly experimental at present.
10398 //
10399 // Firstly they only work on Linux (ie. Mono).  In order to get them
10400 // to work on Windows (ie. .Net) you would need to port the library
10401 // itself to Windows first.
10402 //
10403 // The second issue is that some calls are known to be incorrect and
10404 // can cause Mono to segfault.  Particularly: calls which pass or
10405 // return string[], or return any structure value.  This is because
10406 // we haven't worked out the correct way to do this from C#.
10407 //
10408 // The third issue is that when compiling you get a lot of warnings.
10409 // We are not sure whether the warnings are important or not.
10410 //
10411 // Fourthly we do not routinely build or test these bindings as part
10412 // of the make && make check cycle, which means that regressions might
10413 // go unnoticed.
10414 //
10415 // Suggestions and patches are welcome.
10416
10417 // To compile:
10418 //
10419 // gmcs Libguestfs.cs
10420 // mono Libguestfs.exe
10421 //
10422 // (You'll probably want to add a Test class / static main function
10423 // otherwise this won't do anything useful).
10424
10425 using System;
10426 using System.IO;
10427 using System.Runtime.InteropServices;
10428 using System.Runtime.Serialization;
10429 using System.Collections;
10430
10431 namespace Guestfs
10432 {
10433   class Error : System.ApplicationException
10434   {
10435     public Error (string message) : base (message) {}
10436     protected Error (SerializationInfo info, StreamingContext context) {}
10437   }
10438
10439   class Guestfs
10440   {
10441     IntPtr _handle;
10442
10443     [DllImport (\"%s\")]
10444     static extern IntPtr guestfs_create ();
10445
10446     public Guestfs ()
10447     {
10448       _handle = guestfs_create ();
10449       if (_handle == IntPtr.Zero)
10450         throw new Error (\"could not create guestfs handle\");
10451     }
10452
10453     [DllImport (\"%s\")]
10454     static extern void guestfs_close (IntPtr h);
10455
10456     ~Guestfs ()
10457     {
10458       guestfs_close (_handle);
10459     }
10460
10461     [DllImport (\"%s\")]
10462     static extern string guestfs_last_error (IntPtr h);
10463
10464 " library library library;
10465
10466   (* Generate C# structure bindings.  We prefix struct names with
10467    * underscore because C# cannot have conflicting struct names and
10468    * method names (eg. "class stat" and "stat").
10469    *)
10470   List.iter (
10471     fun (typ, cols) ->
10472       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10473       pr "    public class _%s {\n" typ;
10474       List.iter (
10475         function
10476         | name, FChar -> pr "      char %s;\n" name
10477         | name, FString -> pr "      string %s;\n" name
10478         | name, FBuffer ->
10479             pr "      uint %s_len;\n" name;
10480             pr "      string %s;\n" name
10481         | name, FUUID ->
10482             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10483             pr "      string %s;\n" name
10484         | name, FUInt32 -> pr "      uint %s;\n" name
10485         | name, FInt32 -> pr "      int %s;\n" name
10486         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10487         | name, FInt64 -> pr "      long %s;\n" name
10488         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10489       ) cols;
10490       pr "    }\n";
10491       pr "\n"
10492   ) structs;
10493
10494   (* Generate C# function bindings. *)
10495   List.iter (
10496     fun (name, style, _, _, _, shortdesc, _) ->
10497       let rec csharp_return_type () =
10498         match fst style with
10499         | RErr -> "void"
10500         | RBool n -> "bool"
10501         | RInt n -> "int"
10502         | RInt64 n -> "long"
10503         | RConstString n
10504         | RConstOptString n
10505         | RString n
10506         | RBufferOut n -> "string"
10507         | RStruct (_,n) -> "_" ^ n
10508         | RHashtable n -> "Hashtable"
10509         | RStringList n -> "string[]"
10510         | RStructList (_,n) -> sprintf "_%s[]" n
10511
10512       and c_return_type () =
10513         match fst style with
10514         | RErr
10515         | RBool _
10516         | RInt _ -> "int"
10517         | RInt64 _ -> "long"
10518         | RConstString _
10519         | RConstOptString _
10520         | RString _
10521         | RBufferOut _ -> "string"
10522         | RStruct (_,n) -> "_" ^ n
10523         | RHashtable _
10524         | RStringList _ -> "string[]"
10525         | RStructList (_,n) -> sprintf "_%s[]" n
10526
10527       and c_error_comparison () =
10528         match fst style with
10529         | RErr
10530         | RBool _
10531         | RInt _
10532         | RInt64 _ -> "== -1"
10533         | RConstString _
10534         | RConstOptString _
10535         | RString _
10536         | RBufferOut _
10537         | RStruct (_,_)
10538         | RHashtable _
10539         | RStringList _
10540         | RStructList (_,_) -> "== null"
10541
10542       and generate_extern_prototype () =
10543         pr "    static extern %s guestfs_%s (IntPtr h"
10544           (c_return_type ()) name;
10545         List.iter (
10546           function
10547           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10548           | FileIn n | FileOut n ->
10549               pr ", [In] string %s" n
10550           | StringList n | DeviceList n ->
10551               pr ", [In] string[] %s" n
10552           | Bool n ->
10553               pr ", bool %s" n
10554           | Int n ->
10555               pr ", int %s" n
10556           | Int64 n ->
10557               pr ", long %s" n
10558         ) (snd style);
10559         pr ");\n"
10560
10561       and generate_public_prototype () =
10562         pr "    public %s %s (" (csharp_return_type ()) name;
10563         let comma = ref false in
10564         let next () =
10565           if !comma then pr ", ";
10566           comma := true
10567         in
10568         List.iter (
10569           function
10570           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10571           | FileIn n | FileOut n ->
10572               next (); pr "string %s" n
10573           | StringList n | DeviceList n ->
10574               next (); pr "string[] %s" n
10575           | Bool n ->
10576               next (); pr "bool %s" n
10577           | Int n ->
10578               next (); pr "int %s" n
10579           | Int64 n ->
10580               next (); pr "long %s" n
10581         ) (snd style);
10582         pr ")\n"
10583
10584       and generate_call () =
10585         pr "guestfs_%s (_handle" name;
10586         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10587         pr ");\n";
10588       in
10589
10590       pr "    [DllImport (\"%s\")]\n" library;
10591       generate_extern_prototype ();
10592       pr "\n";
10593       pr "    /// <summary>\n";
10594       pr "    /// %s\n" shortdesc;
10595       pr "    /// </summary>\n";
10596       generate_public_prototype ();
10597       pr "    {\n";
10598       pr "      %s r;\n" (c_return_type ());
10599       pr "      r = ";
10600       generate_call ();
10601       pr "      if (r %s)\n" (c_error_comparison ());
10602       pr "        throw new Error (guestfs_last_error (_handle));\n";
10603       (match fst style with
10604        | RErr -> ()
10605        | RBool _ ->
10606            pr "      return r != 0 ? true : false;\n"
10607        | RHashtable _ ->
10608            pr "      Hashtable rr = new Hashtable ();\n";
10609            pr "      for (size_t i = 0; i < r.Length; i += 2)\n";
10610            pr "        rr.Add (r[i], r[i+1]);\n";
10611            pr "      return rr;\n"
10612        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10613        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10614        | RStructList _ ->
10615            pr "      return r;\n"
10616       );
10617       pr "    }\n";
10618       pr "\n";
10619   ) all_functions_sorted;
10620
10621   pr "  }
10622 }
10623 "
10624
10625 and generate_bindtests () =
10626   generate_header CStyle LGPLv2plus;
10627
10628   pr "\
10629 #include <stdio.h>
10630 #include <stdlib.h>
10631 #include <inttypes.h>
10632 #include <string.h>
10633
10634 #include \"guestfs.h\"
10635 #include \"guestfs-internal.h\"
10636 #include \"guestfs-internal-actions.h\"
10637 #include \"guestfs_protocol.h\"
10638
10639 #define error guestfs_error
10640 #define safe_calloc guestfs_safe_calloc
10641 #define safe_malloc guestfs_safe_malloc
10642
10643 static void
10644 print_strings (char *const *argv)
10645 {
10646   size_t argc;
10647
10648   printf (\"[\");
10649   for (argc = 0; argv[argc] != NULL; ++argc) {
10650     if (argc > 0) printf (\", \");
10651     printf (\"\\\"%%s\\\"\", argv[argc]);
10652   }
10653   printf (\"]\\n\");
10654 }
10655
10656 /* The test0 function prints its parameters to stdout. */
10657 ";
10658
10659   let test0, tests =
10660     match test_functions with
10661     | [] -> assert false
10662     | test0 :: tests -> test0, tests in
10663
10664   let () =
10665     let (name, style, _, _, _, _, _) = test0 in
10666     generate_prototype ~extern:false ~semicolon:false ~newline:true
10667       ~handle:"g" ~prefix:"guestfs__" name style;
10668     pr "{\n";
10669     List.iter (
10670       function
10671       | Pathname n
10672       | Device n | Dev_or_Path n
10673       | String n
10674       | FileIn n
10675       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10676       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10677       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10678       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10679       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10680       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10681     ) (snd style);
10682     pr "  /* Java changes stdout line buffering so we need this: */\n";
10683     pr "  fflush (stdout);\n";
10684     pr "  return 0;\n";
10685     pr "}\n";
10686     pr "\n" in
10687
10688   List.iter (
10689     fun (name, style, _, _, _, _, _) ->
10690       if String.sub name (String.length name - 3) 3 <> "err" then (
10691         pr "/* Test normal return. */\n";
10692         generate_prototype ~extern:false ~semicolon:false ~newline:true
10693           ~handle:"g" ~prefix:"guestfs__" name style;
10694         pr "{\n";
10695         (match fst style with
10696          | RErr ->
10697              pr "  return 0;\n"
10698          | RInt _ ->
10699              pr "  int r;\n";
10700              pr "  sscanf (val, \"%%d\", &r);\n";
10701              pr "  return r;\n"
10702          | RInt64 _ ->
10703              pr "  int64_t r;\n";
10704              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10705              pr "  return r;\n"
10706          | RBool _ ->
10707              pr "  return STREQ (val, \"true\");\n"
10708          | RConstString _
10709          | RConstOptString _ ->
10710              (* Can't return the input string here.  Return a static
10711               * string so we ensure we get a segfault if the caller
10712               * tries to free it.
10713               *)
10714              pr "  return \"static string\";\n"
10715          | RString _ ->
10716              pr "  return strdup (val);\n"
10717          | RStringList _ ->
10718              pr "  char **strs;\n";
10719              pr "  int n, i;\n";
10720              pr "  sscanf (val, \"%%d\", &n);\n";
10721              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10722              pr "  for (i = 0; i < n; ++i) {\n";
10723              pr "    strs[i] = safe_malloc (g, 16);\n";
10724              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10725              pr "  }\n";
10726              pr "  strs[n] = NULL;\n";
10727              pr "  return strs;\n"
10728          | RStruct (_, typ) ->
10729              pr "  struct guestfs_%s *r;\n" typ;
10730              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10731              pr "  return r;\n"
10732          | RStructList (_, typ) ->
10733              pr "  struct guestfs_%s_list *r;\n" typ;
10734              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10735              pr "  sscanf (val, \"%%d\", &r->len);\n";
10736              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10737              pr "  return r;\n"
10738          | RHashtable _ ->
10739              pr "  char **strs;\n";
10740              pr "  int n, i;\n";
10741              pr "  sscanf (val, \"%%d\", &n);\n";
10742              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10743              pr "  for (i = 0; i < n; ++i) {\n";
10744              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10745              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10746              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10747              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10748              pr "  }\n";
10749              pr "  strs[n*2] = NULL;\n";
10750              pr "  return strs;\n"
10751          | RBufferOut _ ->
10752              pr "  return strdup (val);\n"
10753         );
10754         pr "}\n";
10755         pr "\n"
10756       ) else (
10757         pr "/* Test error return. */\n";
10758         generate_prototype ~extern:false ~semicolon:false ~newline:true
10759           ~handle:"g" ~prefix:"guestfs__" name style;
10760         pr "{\n";
10761         pr "  error (g, \"error\");\n";
10762         (match fst style with
10763          | RErr | RInt _ | RInt64 _ | RBool _ ->
10764              pr "  return -1;\n"
10765          | RConstString _ | RConstOptString _
10766          | RString _ | RStringList _ | RStruct _
10767          | RStructList _
10768          | RHashtable _
10769          | RBufferOut _ ->
10770              pr "  return NULL;\n"
10771         );
10772         pr "}\n";
10773         pr "\n"
10774       )
10775   ) tests
10776
10777 and generate_ocaml_bindtests () =
10778   generate_header OCamlStyle GPLv2plus;
10779
10780   pr "\
10781 let () =
10782   let g = Guestfs.create () in
10783 ";
10784
10785   let mkargs args =
10786     String.concat " " (
10787       List.map (
10788         function
10789         | CallString s -> "\"" ^ s ^ "\""
10790         | CallOptString None -> "None"
10791         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10792         | CallStringList xs ->
10793             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10794         | CallInt i when i >= 0 -> string_of_int i
10795         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10796         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10797         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10798         | CallBool b -> string_of_bool b
10799       ) args
10800     )
10801   in
10802
10803   generate_lang_bindtests (
10804     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10805   );
10806
10807   pr "print_endline \"EOF\"\n"
10808
10809 and generate_perl_bindtests () =
10810   pr "#!/usr/bin/perl -w\n";
10811   generate_header HashStyle GPLv2plus;
10812
10813   pr "\
10814 use strict;
10815
10816 use Sys::Guestfs;
10817
10818 my $g = Sys::Guestfs->new ();
10819 ";
10820
10821   let mkargs args =
10822     String.concat ", " (
10823       List.map (
10824         function
10825         | CallString s -> "\"" ^ s ^ "\""
10826         | CallOptString None -> "undef"
10827         | CallOptString (Some s) -> sprintf "\"%s\"" s
10828         | CallStringList xs ->
10829             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10830         | CallInt i -> string_of_int i
10831         | CallInt64 i -> Int64.to_string i
10832         | CallBool b -> if b then "1" else "0"
10833       ) args
10834     )
10835   in
10836
10837   generate_lang_bindtests (
10838     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10839   );
10840
10841   pr "print \"EOF\\n\"\n"
10842
10843 and generate_python_bindtests () =
10844   generate_header HashStyle GPLv2plus;
10845
10846   pr "\
10847 import guestfs
10848
10849 g = guestfs.GuestFS ()
10850 ";
10851
10852   let mkargs args =
10853     String.concat ", " (
10854       List.map (
10855         function
10856         | CallString s -> "\"" ^ s ^ "\""
10857         | CallOptString None -> "None"
10858         | CallOptString (Some s) -> sprintf "\"%s\"" s
10859         | CallStringList xs ->
10860             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10861         | CallInt i -> string_of_int i
10862         | CallInt64 i -> Int64.to_string i
10863         | CallBool b -> if b then "1" else "0"
10864       ) args
10865     )
10866   in
10867
10868   generate_lang_bindtests (
10869     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10870   );
10871
10872   pr "print \"EOF\"\n"
10873
10874 and generate_ruby_bindtests () =
10875   generate_header HashStyle GPLv2plus;
10876
10877   pr "\
10878 require 'guestfs'
10879
10880 g = Guestfs::create()
10881 ";
10882
10883   let mkargs args =
10884     String.concat ", " (
10885       List.map (
10886         function
10887         | CallString s -> "\"" ^ s ^ "\""
10888         | CallOptString None -> "nil"
10889         | CallOptString (Some s) -> sprintf "\"%s\"" s
10890         | CallStringList xs ->
10891             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10892         | CallInt i -> string_of_int i
10893         | CallInt64 i -> Int64.to_string i
10894         | CallBool b -> string_of_bool b
10895       ) args
10896     )
10897   in
10898
10899   generate_lang_bindtests (
10900     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10901   );
10902
10903   pr "print \"EOF\\n\"\n"
10904
10905 and generate_java_bindtests () =
10906   generate_header CStyle GPLv2plus;
10907
10908   pr "\
10909 import com.redhat.et.libguestfs.*;
10910
10911 public class Bindtests {
10912     public static void main (String[] argv)
10913     {
10914         try {
10915             GuestFS g = new GuestFS ();
10916 ";
10917
10918   let mkargs args =
10919     String.concat ", " (
10920       List.map (
10921         function
10922         | CallString s -> "\"" ^ s ^ "\""
10923         | CallOptString None -> "null"
10924         | CallOptString (Some s) -> sprintf "\"%s\"" s
10925         | CallStringList xs ->
10926             "new String[]{" ^
10927               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10928         | CallInt i -> string_of_int i
10929         | CallInt64 i -> Int64.to_string i
10930         | CallBool b -> string_of_bool b
10931       ) args
10932     )
10933   in
10934
10935   generate_lang_bindtests (
10936     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10937   );
10938
10939   pr "
10940             System.out.println (\"EOF\");
10941         }
10942         catch (Exception exn) {
10943             System.err.println (exn);
10944             System.exit (1);
10945         }
10946     }
10947 }
10948 "
10949
10950 and generate_haskell_bindtests () =
10951   generate_header HaskellStyle GPLv2plus;
10952
10953   pr "\
10954 module Bindtests where
10955 import qualified Guestfs
10956
10957 main = do
10958   g <- Guestfs.create
10959 ";
10960
10961   let mkargs args =
10962     String.concat " " (
10963       List.map (
10964         function
10965         | CallString s -> "\"" ^ s ^ "\""
10966         | CallOptString None -> "Nothing"
10967         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10968         | CallStringList xs ->
10969             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10970         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10971         | CallInt i -> string_of_int i
10972         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10973         | CallInt64 i -> Int64.to_string i
10974         | CallBool true -> "True"
10975         | CallBool false -> "False"
10976       ) args
10977     )
10978   in
10979
10980   generate_lang_bindtests (
10981     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10982   );
10983
10984   pr "  putStrLn \"EOF\"\n"
10985
10986 (* Language-independent bindings tests - we do it this way to
10987  * ensure there is parity in testing bindings across all languages.
10988  *)
10989 and generate_lang_bindtests call =
10990   call "test0" [CallString "abc"; CallOptString (Some "def");
10991                 CallStringList []; CallBool false;
10992                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10993   call "test0" [CallString "abc"; CallOptString None;
10994                 CallStringList []; CallBool false;
10995                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10996   call "test0" [CallString ""; CallOptString (Some "def");
10997                 CallStringList []; CallBool false;
10998                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10999   call "test0" [CallString ""; CallOptString (Some "");
11000                 CallStringList []; CallBool false;
11001                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11002   call "test0" [CallString "abc"; CallOptString (Some "def");
11003                 CallStringList ["1"]; CallBool false;
11004                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11005   call "test0" [CallString "abc"; CallOptString (Some "def");
11006                 CallStringList ["1"; "2"]; CallBool false;
11007                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11008   call "test0" [CallString "abc"; CallOptString (Some "def");
11009                 CallStringList ["1"]; CallBool true;
11010                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
11011   call "test0" [CallString "abc"; CallOptString (Some "def");
11012                 CallStringList ["1"]; CallBool false;
11013                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
11014   call "test0" [CallString "abc"; CallOptString (Some "def");
11015                 CallStringList ["1"]; CallBool false;
11016                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
11017   call "test0" [CallString "abc"; CallOptString (Some "def");
11018                 CallStringList ["1"]; CallBool false;
11019                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
11020   call "test0" [CallString "abc"; CallOptString (Some "def");
11021                 CallStringList ["1"]; CallBool false;
11022                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11023   call "test0" [CallString "abc"; CallOptString (Some "def");
11024                 CallStringList ["1"]; CallBool false;
11025                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11026   call "test0" [CallString "abc"; CallOptString (Some "def");
11027                 CallStringList ["1"]; CallBool false;
11028                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11029
11030 (* XXX Add here tests of the return and error functions. *)
11031
11032 (* Code to generator bindings for virt-inspector.  Currently only
11033  * implemented for OCaml code (for virt-p2v 2.0).
11034  *)
11035 let rng_input = "inspector/virt-inspector.rng"
11036
11037 (* Read the input file and parse it into internal structures.  This is
11038  * by no means a complete RELAX NG parser, but is just enough to be
11039  * able to parse the specific input file.
11040  *)
11041 type rng =
11042   | Element of string * rng list        (* <element name=name/> *)
11043   | Attribute of string * rng list        (* <attribute name=name/> *)
11044   | Interleave of rng list                (* <interleave/> *)
11045   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11046   | OneOrMore of rng                        (* <oneOrMore/> *)
11047   | Optional of rng                        (* <optional/> *)
11048   | Choice of string list                (* <choice><value/>*</choice> *)
11049   | Value of string                        (* <value>str</value> *)
11050   | Text                                (* <text/> *)
11051
11052 let rec string_of_rng = function
11053   | Element (name, xs) ->
11054       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11055   | Attribute (name, xs) ->
11056       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11057   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11058   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11059   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11060   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11061   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11062   | Value value -> "Value \"" ^ value ^ "\""
11063   | Text -> "Text"
11064
11065 and string_of_rng_list xs =
11066   String.concat ", " (List.map string_of_rng xs)
11067
11068 let rec parse_rng ?defines context = function
11069   | [] -> []
11070   | Xml.Element ("element", ["name", name], children) :: rest ->
11071       Element (name, parse_rng ?defines context children)
11072       :: parse_rng ?defines context rest
11073   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11074       Attribute (name, parse_rng ?defines context children)
11075       :: parse_rng ?defines context rest
11076   | Xml.Element ("interleave", [], children) :: rest ->
11077       Interleave (parse_rng ?defines context children)
11078       :: parse_rng ?defines context rest
11079   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11080       let rng = parse_rng ?defines context [child] in
11081       (match rng with
11082        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11083        | _ ->
11084            failwithf "%s: <zeroOrMore> contains more than one child element"
11085              context
11086       )
11087   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11088       let rng = parse_rng ?defines context [child] in
11089       (match rng with
11090        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11091        | _ ->
11092            failwithf "%s: <oneOrMore> contains more than one child element"
11093              context
11094       )
11095   | Xml.Element ("optional", [], [child]) :: rest ->
11096       let rng = parse_rng ?defines context [child] in
11097       (match rng with
11098        | [child] -> Optional child :: parse_rng ?defines context rest
11099        | _ ->
11100            failwithf "%s: <optional> contains more than one child element"
11101              context
11102       )
11103   | Xml.Element ("choice", [], children) :: rest ->
11104       let values = List.map (
11105         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11106         | _ ->
11107             failwithf "%s: can't handle anything except <value> in <choice>"
11108               context
11109       ) children in
11110       Choice values
11111       :: parse_rng ?defines context rest
11112   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11113       Value value :: parse_rng ?defines context rest
11114   | Xml.Element ("text", [], []) :: rest ->
11115       Text :: parse_rng ?defines context rest
11116   | Xml.Element ("ref", ["name", name], []) :: rest ->
11117       (* Look up the reference.  Because of limitations in this parser,
11118        * we can't handle arbitrarily nested <ref> yet.  You can only
11119        * use <ref> from inside <start>.
11120        *)
11121       (match defines with
11122        | None ->
11123            failwithf "%s: contains <ref>, but no refs are defined yet" context
11124        | Some map ->
11125            let rng = StringMap.find name map in
11126            rng @ parse_rng ?defines context rest
11127       )
11128   | x :: _ ->
11129       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11130
11131 let grammar =
11132   let xml = Xml.parse_file rng_input in
11133   match xml with
11134   | Xml.Element ("grammar", _,
11135                  Xml.Element ("start", _, gram) :: defines) ->
11136       (* The <define/> elements are referenced in the <start> section,
11137        * so build a map of those first.
11138        *)
11139       let defines = List.fold_left (
11140         fun map ->
11141           function Xml.Element ("define", ["name", name], defn) ->
11142             StringMap.add name defn map
11143           | _ ->
11144               failwithf "%s: expected <define name=name/>" rng_input
11145       ) StringMap.empty defines in
11146       let defines = StringMap.mapi parse_rng defines in
11147
11148       (* Parse the <start> clause, passing the defines. *)
11149       parse_rng ~defines "<start>" gram
11150   | _ ->
11151       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11152         rng_input
11153
11154 let name_of_field = function
11155   | Element (name, _) | Attribute (name, _)
11156   | ZeroOrMore (Element (name, _))
11157   | OneOrMore (Element (name, _))
11158   | Optional (Element (name, _)) -> name
11159   | Optional (Attribute (name, _)) -> name
11160   | Text -> (* an unnamed field in an element *)
11161       "data"
11162   | rng ->
11163       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11164
11165 (* At the moment this function only generates OCaml types.  However we
11166  * should parameterize it later so it can generate types/structs in a
11167  * variety of languages.
11168  *)
11169 let generate_types xs =
11170   (* A simple type is one that can be printed out directly, eg.
11171    * "string option".  A complex type is one which has a name and has
11172    * to be defined via another toplevel definition, eg. a struct.
11173    *
11174    * generate_type generates code for either simple or complex types.
11175    * In the simple case, it returns the string ("string option").  In
11176    * the complex case, it returns the name ("mountpoint").  In the
11177    * complex case it has to print out the definition before returning,
11178    * so it should only be called when we are at the beginning of a
11179    * new line (BOL context).
11180    *)
11181   let rec generate_type = function
11182     | Text ->                                (* string *)
11183         "string", true
11184     | Choice values ->                        (* [`val1|`val2|...] *)
11185         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11186     | ZeroOrMore rng ->                        (* <rng> list *)
11187         let t, is_simple = generate_type rng in
11188         t ^ " list (* 0 or more *)", is_simple
11189     | OneOrMore rng ->                        (* <rng> list *)
11190         let t, is_simple = generate_type rng in
11191         t ^ " list (* 1 or more *)", is_simple
11192                                         (* virt-inspector hack: bool *)
11193     | Optional (Attribute (name, [Value "1"])) ->
11194         "bool", true
11195     | Optional rng ->                        (* <rng> list *)
11196         let t, is_simple = generate_type rng in
11197         t ^ " option", is_simple
11198                                         (* type name = { fields ... } *)
11199     | Element (name, fields) when is_attrs_interleave fields ->
11200         generate_type_struct name (get_attrs_interleave fields)
11201     | Element (name, [field])                (* type name = field *)
11202     | Attribute (name, [field]) ->
11203         let t, is_simple = generate_type field in
11204         if is_simple then (t, true)
11205         else (
11206           pr "type %s = %s\n" name t;
11207           name, false
11208         )
11209     | Element (name, fields) ->              (* type name = { fields ... } *)
11210         generate_type_struct name fields
11211     | rng ->
11212         failwithf "generate_type failed at: %s" (string_of_rng rng)
11213
11214   and is_attrs_interleave = function
11215     | [Interleave _] -> true
11216     | Attribute _ :: fields -> is_attrs_interleave fields
11217     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11218     | _ -> false
11219
11220   and get_attrs_interleave = function
11221     | [Interleave fields] -> fields
11222     | ((Attribute _) as field) :: fields
11223     | ((Optional (Attribute _)) as field) :: fields ->
11224         field :: get_attrs_interleave fields
11225     | _ -> assert false
11226
11227   and generate_types xs =
11228     List.iter (fun x -> ignore (generate_type x)) xs
11229
11230   and generate_type_struct name fields =
11231     (* Calculate the types of the fields first.  We have to do this
11232      * before printing anything so we are still in BOL context.
11233      *)
11234     let types = List.map fst (List.map generate_type fields) in
11235
11236     (* Special case of a struct containing just a string and another
11237      * field.  Turn it into an assoc list.
11238      *)
11239     match types with
11240     | ["string"; other] ->
11241         let fname1, fname2 =
11242           match fields with
11243           | [f1; f2] -> name_of_field f1, name_of_field f2
11244           | _ -> assert false in
11245         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11246         name, false
11247
11248     | types ->
11249         pr "type %s = {\n" name;
11250         List.iter (
11251           fun (field, ftype) ->
11252             let fname = name_of_field field in
11253             pr "  %s_%s : %s;\n" name fname ftype
11254         ) (List.combine fields types);
11255         pr "}\n";
11256         (* Return the name of this type, and
11257          * false because it's not a simple type.
11258          *)
11259         name, false
11260   in
11261
11262   generate_types xs
11263
11264 let generate_parsers xs =
11265   (* As for generate_type above, generate_parser makes a parser for
11266    * some type, and returns the name of the parser it has generated.
11267    * Because it (may) need to print something, it should always be
11268    * called in BOL context.
11269    *)
11270   let rec generate_parser = function
11271     | Text ->                                (* string *)
11272         "string_child_or_empty"
11273     | Choice values ->                        (* [`val1|`val2|...] *)
11274         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11275           (String.concat "|"
11276              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11277     | ZeroOrMore rng ->                        (* <rng> list *)
11278         let pa = generate_parser rng in
11279         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11280     | OneOrMore rng ->                        (* <rng> list *)
11281         let pa = generate_parser rng in
11282         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11283                                         (* virt-inspector hack: bool *)
11284     | Optional (Attribute (name, [Value "1"])) ->
11285         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11286     | Optional rng ->                        (* <rng> list *)
11287         let pa = generate_parser rng in
11288         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11289                                         (* type name = { fields ... } *)
11290     | Element (name, fields) when is_attrs_interleave fields ->
11291         generate_parser_struct name (get_attrs_interleave fields)
11292     | Element (name, [field]) ->        (* type 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     | Attribute (name, [field]) ->
11300         let pa = generate_parser field in
11301         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11302         pr "let %s =\n" parser_name;
11303         pr "  %s\n" pa;
11304         pr "let parse_%s = %s\n" name parser_name;
11305         parser_name
11306     | Element (name, fields) ->              (* type name = { fields ... } *)
11307         generate_parser_struct name ([], fields)
11308     | rng ->
11309         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11310
11311   and is_attrs_interleave = function
11312     | [Interleave _] -> true
11313     | Attribute _ :: fields -> is_attrs_interleave fields
11314     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11315     | _ -> false
11316
11317   and get_attrs_interleave = function
11318     | [Interleave fields] -> [], fields
11319     | ((Attribute _) as field) :: fields
11320     | ((Optional (Attribute _)) as field) :: fields ->
11321         let attrs, interleaves = get_attrs_interleave fields in
11322         (field :: attrs), interleaves
11323     | _ -> assert false
11324
11325   and generate_parsers xs =
11326     List.iter (fun x -> ignore (generate_parser x)) xs
11327
11328   and generate_parser_struct name (attrs, interleaves) =
11329     (* Generate parsers for the fields first.  We have to do this
11330      * before printing anything so we are still in BOL context.
11331      *)
11332     let fields = attrs @ interleaves in
11333     let pas = List.map generate_parser fields in
11334
11335     (* Generate an intermediate tuple from all the fields first.
11336      * If the type is just a string + another field, then we will
11337      * return this directly, otherwise it is turned into a record.
11338      *
11339      * RELAX NG note: This code treats <interleave> and plain lists of
11340      * fields the same.  In other words, it doesn't bother enforcing
11341      * any ordering of fields in the XML.
11342      *)
11343     pr "let parse_%s x =\n" name;
11344     pr "  let t = (\n    ";
11345     let comma = ref false in
11346     List.iter (
11347       fun x ->
11348         if !comma then pr ",\n    ";
11349         comma := true;
11350         match x with
11351         | Optional (Attribute (fname, [field])), pa ->
11352             pr "%s x" pa
11353         | Optional (Element (fname, [field])), pa ->
11354             pr "%s (optional_child %S x)" pa fname
11355         | Attribute (fname, [Text]), _ ->
11356             pr "attribute %S x" fname
11357         | (ZeroOrMore _ | OneOrMore _), pa ->
11358             pr "%s x" pa
11359         | Text, pa ->
11360             pr "%s x" pa
11361         | (field, pa) ->
11362             let fname = name_of_field field in
11363             pr "%s (child %S x)" pa fname
11364     ) (List.combine fields pas);
11365     pr "\n  ) in\n";
11366
11367     (match fields with
11368      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11369          pr "  t\n"
11370
11371      | _ ->
11372          pr "  (Obj.magic t : %s)\n" name
11373 (*
11374          List.iter (
11375            function
11376            | (Optional (Attribute (fname, [field])), pa) ->
11377                pr "  %s_%s =\n" name fname;
11378                pr "    %s x;\n" pa
11379            | (Optional (Element (fname, [field])), pa) ->
11380                pr "  %s_%s =\n" name fname;
11381                pr "    (let x = optional_child %S x in\n" fname;
11382                pr "     %s x);\n" pa
11383            | (field, pa) ->
11384                let fname = name_of_field field in
11385                pr "  %s_%s =\n" name fname;
11386                pr "    (let x = child %S x in\n" fname;
11387                pr "     %s x);\n" pa
11388          ) (List.combine fields pas);
11389          pr "}\n"
11390 *)
11391     );
11392     sprintf "parse_%s" name
11393   in
11394
11395   generate_parsers xs
11396
11397 (* Generate ocaml/guestfs_inspector.mli. *)
11398 let generate_ocaml_inspector_mli () =
11399   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11400
11401   pr "\
11402 (** This is an OCaml language binding to the external [virt-inspector]
11403     program.
11404
11405     For more information, please read the man page [virt-inspector(1)].
11406 *)
11407
11408 ";
11409
11410   generate_types grammar;
11411   pr "(** The nested information returned from the {!inspect} function. *)\n";
11412   pr "\n";
11413
11414   pr "\
11415 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11416 (** To inspect a libvirt domain called [name], pass a singleton
11417     list: [inspect [name]].  When using libvirt only, you may
11418     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11419
11420     To inspect a disk image or images, pass a list of the filenames
11421     of the disk images: [inspect filenames]
11422
11423     This function inspects the given guest or disk images and
11424     returns a list of operating system(s) found and a large amount
11425     of information about them.  In the vast majority of cases,
11426     a virtual machine only contains a single operating system.
11427
11428     If the optional [~xml] parameter is given, then this function
11429     skips running the external virt-inspector program and just
11430     parses the given XML directly (which is expected to be XML
11431     produced from a previous run of virt-inspector).  The list of
11432     names and connect URI are ignored in this case.
11433
11434     This function can throw a wide variety of exceptions, for example
11435     if the external virt-inspector program cannot be found, or if
11436     it doesn't generate valid XML.
11437 *)
11438 "
11439
11440 (* Generate ocaml/guestfs_inspector.ml. *)
11441 let generate_ocaml_inspector_ml () =
11442   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11443
11444   pr "open Unix\n";
11445   pr "\n";
11446
11447   generate_types grammar;
11448   pr "\n";
11449
11450   pr "\
11451 (* Misc functions which are used by the parser code below. *)
11452 let first_child = function
11453   | Xml.Element (_, _, c::_) -> c
11454   | Xml.Element (name, _, []) ->
11455       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11456   | Xml.PCData str ->
11457       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11458
11459 let string_child_or_empty = function
11460   | Xml.Element (_, _, [Xml.PCData s]) -> s
11461   | Xml.Element (_, _, []) -> \"\"
11462   | Xml.Element (x, _, _) ->
11463       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11464                 x ^ \" instead\")
11465   | Xml.PCData str ->
11466       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11467
11468 let optional_child name xml =
11469   let children = Xml.children xml in
11470   try
11471     Some (List.find (function
11472                      | Xml.Element (n, _, _) when n = name -> true
11473                      | _ -> false) children)
11474   with
11475     Not_found -> None
11476
11477 let child name xml =
11478   match optional_child name xml with
11479   | Some c -> c
11480   | None ->
11481       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11482
11483 let attribute name xml =
11484   try Xml.attrib xml name
11485   with Xml.No_attribute _ ->
11486     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11487
11488 ";
11489
11490   generate_parsers grammar;
11491   pr "\n";
11492
11493   pr "\
11494 (* Run external virt-inspector, then use parser to parse the XML. *)
11495 let inspect ?connect ?xml names =
11496   let xml =
11497     match xml with
11498     | None ->
11499         if names = [] then invalid_arg \"inspect: no names given\";
11500         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11501           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11502           names in
11503         let cmd = List.map Filename.quote cmd in
11504         let cmd = String.concat \" \" cmd in
11505         let chan = open_process_in cmd in
11506         let xml = Xml.parse_in chan in
11507         (match close_process_in chan with
11508          | WEXITED 0 -> ()
11509          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11510          | WSIGNALED i | WSTOPPED i ->
11511              failwith (\"external virt-inspector command died or stopped on sig \" ^
11512                        string_of_int i)
11513         );
11514         xml
11515     | Some doc ->
11516         Xml.parse_string doc in
11517   parse_operatingsystems xml
11518 "
11519
11520 (* This is used to generate the src/MAX_PROC_NR file which
11521  * contains the maximum procedure number, a surrogate for the
11522  * ABI version number.  See src/Makefile.am for the details.
11523  *)
11524 and generate_max_proc_nr () =
11525   let proc_nrs = List.map (
11526     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11527   ) daemon_functions in
11528
11529   let max_proc_nr = List.fold_left max 0 proc_nrs in
11530
11531   pr "%d\n" max_proc_nr
11532
11533 let output_to filename k =
11534   let filename_new = filename ^ ".new" in
11535   chan := open_out filename_new;
11536   k ();
11537   close_out !chan;
11538   chan := Pervasives.stdout;
11539
11540   (* Is the new file different from the current file? *)
11541   if Sys.file_exists filename && files_equal filename filename_new then
11542     unlink filename_new                 (* same, so skip it *)
11543   else (
11544     (* different, overwrite old one *)
11545     (try chmod filename 0o644 with Unix_error _ -> ());
11546     rename filename_new filename;
11547     chmod filename 0o444;
11548     printf "written %s\n%!" filename;
11549   )
11550
11551 let perror msg = function
11552   | Unix_error (err, _, _) ->
11553       eprintf "%s: %s\n" msg (error_message err)
11554   | exn ->
11555       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11556
11557 (* Main program. *)
11558 let () =
11559   let lock_fd =
11560     try openfile "HACKING" [O_RDWR] 0
11561     with
11562     | Unix_error (ENOENT, _, _) ->
11563         eprintf "\
11564 You are probably running this from the wrong directory.
11565 Run it from the top source directory using the command
11566   src/generator.ml
11567 ";
11568         exit 1
11569     | exn ->
11570         perror "open: HACKING" exn;
11571         exit 1 in
11572
11573   (* Acquire a lock so parallel builds won't try to run the generator
11574    * twice at the same time.  Subsequent builds will wait for the first
11575    * one to finish.  Note the lock is released implicitly when the
11576    * program exits.
11577    *)
11578   (try lockf lock_fd F_LOCK 1
11579    with exn ->
11580      perror "lock: HACKING" exn;
11581      exit 1);
11582
11583   check_functions ();
11584
11585   output_to "src/guestfs_protocol.x" generate_xdr;
11586   output_to "src/guestfs-structs.h" generate_structs_h;
11587   output_to "src/guestfs-actions.h" generate_actions_h;
11588   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11589   output_to "src/guestfs-actions.c" generate_client_actions;
11590   output_to "src/guestfs-bindtests.c" generate_bindtests;
11591   output_to "src/guestfs-structs.pod" generate_structs_pod;
11592   output_to "src/guestfs-actions.pod" generate_actions_pod;
11593   output_to "src/guestfs-availability.pod" generate_availability_pod;
11594   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11595   output_to "src/libguestfs.syms" generate_linker_script;
11596   output_to "daemon/actions.h" generate_daemon_actions_h;
11597   output_to "daemon/stubs.c" generate_daemon_actions;
11598   output_to "daemon/names.c" generate_daemon_names;
11599   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11600   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11601   output_to "capitests/tests.c" generate_tests;
11602   output_to "fish/cmds.c" generate_fish_cmds;
11603   output_to "fish/completion.c" generate_fish_completion;
11604   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11605   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11606   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11607   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11608   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11609   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11610   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11611   output_to "perl/Guestfs.xs" generate_perl_xs;
11612   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11613   output_to "perl/bindtests.pl" generate_perl_bindtests;
11614   output_to "python/guestfs-py.c" generate_python_c;
11615   output_to "python/guestfs.py" generate_python_py;
11616   output_to "python/bindtests.py" generate_python_bindtests;
11617   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11618   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11619   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11620
11621   List.iter (
11622     fun (typ, jtyp) ->
11623       let cols = cols_of_struct typ in
11624       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11625       output_to filename (generate_java_struct jtyp cols);
11626   ) java_structs;
11627
11628   output_to "java/Makefile.inc" generate_java_makefile_inc;
11629   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11630   output_to "java/Bindtests.java" generate_java_bindtests;
11631   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11632   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11633   output_to "csharp/Libguestfs.cs" generate_csharp;
11634
11635   (* Always generate this file last, and unconditionally.  It's used
11636    * by the Makefile to know when we must re-run the generator.
11637    *)
11638   let chan = open_out "src/stamp-generator" in
11639   fprintf chan "1\n";
11640   close_out chan;
11641
11642   printf "generated %d lines of code\n" !lines