generator: Missing newline character.
[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     (* Opaque buffer which can contain arbitrary 8 bit data.
168      * In the C API, this is expressed as <const char *, size_t> pair.
169      * Most other languages have a string type which can contain
170      * ASCII NUL.  We use whatever type is appropriate for each
171      * language.
172      * Buffers are limited by the total message size.  To transfer
173      * large blocks of data, use FileIn/FileOut parameters instead.
174      * To return an arbitrary buffer, use RBufferOut.
175      *)
176   | BufferIn of string
177
178 type flags =
179   | ProtocolLimitWarning  (* display warning about protocol size limits *)
180   | DangerWillRobinson    (* flags particularly dangerous commands *)
181   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
182   | FishOutput of fish_output_t (* how to display output in guestfish *)
183   | NotInFish             (* do not export via guestfish *)
184   | NotInDocs             (* do not add this function to documentation *)
185   | DeprecatedBy of string (* function is deprecated, use .. instead *)
186   | Optional of string    (* function is part of an optional group *)
187
188 and fish_output_t =
189   | FishOutputOctal       (* for int return, print in octal *)
190   | FishOutputHexadecimal (* for int return, print in hex *)
191
192 (* You can supply zero or as many tests as you want per API call.
193  *
194  * Note that the test environment has 3 block devices, of size 500MB,
195  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
196  * a fourth ISO block device with some known files on it (/dev/sdd).
197  *
198  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
199  * Number of cylinders was 63 for IDE emulated disks with precisely
200  * the same size.  How exactly this is calculated is a mystery.
201  *
202  * The ISO block device (/dev/sdd) comes from images/test.iso.
203  *
204  * To be able to run the tests in a reasonable amount of time,
205  * the virtual machine and block devices are reused between tests.
206  * So don't try testing kill_subprocess :-x
207  *
208  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
209  *
210  * Don't assume anything about the previous contents of the block
211  * devices.  Use 'Init*' to create some initial scenarios.
212  *
213  * You can add a prerequisite clause to any individual test.  This
214  * is a run-time check, which, if it fails, causes the test to be
215  * skipped.  Useful if testing a command which might not work on
216  * all variations of libguestfs builds.  A test that has prerequisite
217  * of 'Always' is run unconditionally.
218  *
219  * In addition, packagers can skip individual tests by setting the
220  * environment variables:     eg:
221  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
222  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
223  *)
224 type tests = (test_init * test_prereq * test) list
225 and test =
226     (* Run the command sequence and just expect nothing to fail. *)
227   | TestRun of seq
228
229     (* Run the command sequence and expect the output of the final
230      * command to be the string.
231      *)
232   | TestOutput of seq * string
233
234     (* Run the command sequence and expect the output of the final
235      * command to be the list of strings.
236      *)
237   | TestOutputList of seq * string list
238
239     (* Run the command sequence and expect the output of the final
240      * command to be the list of block devices (could be either
241      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
242      * character of each string).
243      *)
244   | TestOutputListOfDevices of seq * string list
245
246     (* Run the command sequence and expect the output of the final
247      * command to be the integer.
248      *)
249   | TestOutputInt of seq * int
250
251     (* Run the command sequence and expect the output of the final
252      * command to be <op> <int>, eg. ">=", "1".
253      *)
254   | TestOutputIntOp of seq * string * int
255
256     (* Run the command sequence and expect the output of the final
257      * command to be a true value (!= 0 or != NULL).
258      *)
259   | TestOutputTrue of seq
260
261     (* Run the command sequence and expect the output of the final
262      * command to be a false value (== 0 or == NULL, but not an error).
263      *)
264   | TestOutputFalse of seq
265
266     (* Run the command sequence and expect the output of the final
267      * command to be a list of the given length (but don't care about
268      * content).
269      *)
270   | TestOutputLength of seq * int
271
272     (* Run the command sequence and expect the output of the final
273      * command to be a buffer (RBufferOut), ie. string + size.
274      *)
275   | TestOutputBuffer of seq * string
276
277     (* Run the command sequence and expect the output of the final
278      * command to be a structure.
279      *)
280   | TestOutputStruct of seq * test_field_compare list
281
282     (* Run the command sequence and expect the final command (only)
283      * to fail.
284      *)
285   | TestLastFail of seq
286
287 and test_field_compare =
288   | CompareWithInt of string * int
289   | CompareWithIntOp of string * string * int
290   | CompareWithString of string * string
291   | CompareFieldsIntEq of string * string
292   | CompareFieldsStrEq of string * string
293
294 (* Test prerequisites. *)
295 and test_prereq =
296     (* Test always runs. *)
297   | Always
298
299     (* Test is currently disabled - eg. it fails, or it tests some
300      * unimplemented feature.
301      *)
302   | Disabled
303
304     (* 'string' is some C code (a function body) that should return
305      * true or false.  The test will run if the code returns true.
306      *)
307   | If of string
308
309     (* As for 'If' but the test runs _unless_ the code returns true. *)
310   | Unless of string
311
312     (* Run the test only if 'string' is available in the daemon. *)
313   | IfAvailable of string
314
315 (* Some initial scenarios for testing. *)
316 and test_init =
317     (* Do nothing, block devices could contain random stuff including
318      * LVM PVs, and some filesystems might be mounted.  This is usually
319      * a bad idea.
320      *)
321   | InitNone
322
323     (* Block devices are empty and no filesystems are mounted. *)
324   | InitEmpty
325
326     (* /dev/sda contains a single partition /dev/sda1, with random
327      * content.  /dev/sdb and /dev/sdc may have random content.
328      * No LVM.
329      *)
330   | InitPartition
331
332     (* /dev/sda contains a single partition /dev/sda1, which is formatted
333      * as ext2, empty [except for lost+found] and mounted on /.
334      * /dev/sdb and /dev/sdc may have random content.
335      * No LVM.
336      *)
337   | InitBasicFS
338
339     (* /dev/sda:
340      *   /dev/sda1 (is a PV):
341      *     /dev/VG/LV (size 8MB):
342      *       formatted as ext2, empty [except for lost+found], mounted on /
343      * /dev/sdb and /dev/sdc may have random content.
344      *)
345   | InitBasicFSonLVM
346
347     (* /dev/sdd (the ISO, see images/ directory in source)
348      * is mounted on /
349      *)
350   | InitISOFS
351
352 (* Sequence of commands for testing. *)
353 and seq = cmd list
354 and cmd = string list
355
356 (* Note about long descriptions: When referring to another
357  * action, use the format C<guestfs_other> (ie. the full name of
358  * the C function).  This will be replaced as appropriate in other
359  * language bindings.
360  *
361  * Apart from that, long descriptions are just perldoc paragraphs.
362  *)
363
364 (* Generate a uuidgen-compatible UUID (used in tests).  However to
365  * avoid having the UUID change every time we rebuild the tests,
366  * generate it as a function of the contents of the
367  * generator.ml file.
368  * 
369  * Originally I thought uuidgen was using RFC 4122, but it doesn't
370  * appear to.
371  *
372  * Note that the format must be 01234567-0123-0123-0123-0123456789ab
373  *)
374 let uuidgen () =
375   let s = Digest.to_hex (Digest.file "src/generator.ml") in
376   String.sub s 0 8 ^ "-"
377   ^ String.sub s 8 4 ^ "-"
378   ^ String.sub s 12 4 ^ "-"
379   ^ String.sub s 16 4 ^ "-"
380   ^ String.sub s 20 12
381
382 (* These test functions are used in the language binding tests. *)
383
384 let test_all_args = [
385   String "str";
386   OptString "optstr";
387   StringList "strlist";
388   Bool "b";
389   Int "integer";
390   Int64 "integer64";
391   FileIn "filein";
392   FileOut "fileout";
393   BufferIn "bufferin";
394 ]
395
396 let test_all_rets = [
397   (* except for RErr, which is tested thoroughly elsewhere *)
398   "test0rint",         RInt "valout";
399   "test0rint64",       RInt64 "valout";
400   "test0rbool",        RBool "valout";
401   "test0rconststring", RConstString "valout";
402   "test0rconstoptstring", RConstOptString "valout";
403   "test0rstring",      RString "valout";
404   "test0rstringlist",  RStringList "valout";
405   "test0rstruct",      RStruct ("valout", "lvm_pv");
406   "test0rstructlist",  RStructList ("valout", "lvm_pv");
407   "test0rhashtable",   RHashtable "valout";
408 ]
409
410 let test_functions = [
411   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
412    [],
413    "internal test function - do not use",
414    "\
415 This is an internal test function which is used to test whether
416 the automatically generated bindings can handle every possible
417 parameter type correctly.
418
419 It echos the contents of each parameter to stdout.
420
421 You probably don't want to call this function.");
422 ] @ List.flatten (
423   List.map (
424     fun (name, ret) ->
425       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
426         [],
427         "internal test function - do not use",
428         "\
429 This is an internal test function which is used to test whether
430 the automatically generated bindings can handle every possible
431 return type correctly.
432
433 It converts string C<val> to the return type.
434
435 You probably don't want to call this function.");
436        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
437         [],
438         "internal test function - do not use",
439         "\
440 This is an internal test function which is used to test whether
441 the automatically generated bindings can handle every possible
442 return type correctly.
443
444 This function always returns an error.
445
446 You probably don't want to call this function.")]
447   ) test_all_rets
448 )
449
450 (* non_daemon_functions are any functions which don't get processed
451  * in the daemon, eg. functions for setting and getting local
452  * configuration values.
453  *)
454
455 let non_daemon_functions = test_functions @ [
456   ("launch", (RErr, []), -1, [FishAlias "run"],
457    [],
458    "launch the qemu subprocess",
459    "\
460 Internally libguestfs is implemented by running a virtual machine
461 using L<qemu(1)>.
462
463 You should call this after configuring the handle
464 (eg. adding drives) but before performing any actions.");
465
466   ("wait_ready", (RErr, []), -1, [NotInFish],
467    [],
468    "wait until the qemu subprocess launches (no op)",
469    "\
470 This function is a no op.
471
472 In versions of the API E<lt> 1.0.71 you had to call this function
473 just after calling C<guestfs_launch> to wait for the launch
474 to complete.  However this is no longer necessary because
475 C<guestfs_launch> now does the waiting.
476
477 If you see any calls to this function in code then you can just
478 remove them, unless you want to retain compatibility with older
479 versions of the API.");
480
481   ("kill_subprocess", (RErr, []), -1, [],
482    [],
483    "kill the qemu subprocess",
484    "\
485 This kills the qemu subprocess.  You should never need to call this.");
486
487   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
488    [],
489    "add an image to examine or modify",
490    "\
491 This function adds a virtual machine disk image C<filename> to the
492 guest.  The first time you call this function, the disk appears as IDE
493 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
494 so on.
495
496 You don't necessarily need to be root when using libguestfs.  However
497 you obviously do need sufficient permissions to access the filename
498 for whatever operations you want to perform (ie. read access if you
499 just want to read the image or write access if you want to modify the
500 image).
501
502 This is equivalent to the qemu parameter
503 C<-drive file=filename,cache=off,if=...>.
504
505 C<cache=off> is omitted in cases where it is not supported by
506 the underlying filesystem.
507
508 C<if=...> is set at compile time by the configuration option
509 C<./configure --with-drive-if=...>.  In the rare case where you
510 might need to change this at run time, use C<guestfs_add_drive_with_if>
511 or C<guestfs_add_drive_ro_with_if>.
512
513 Note that this call checks for the existence of C<filename>.  This
514 stops you from specifying other types of drive which are supported
515 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
516 the general C<guestfs_config> call instead.");
517
518   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
519    [],
520    "add a CD-ROM disk image to examine",
521    "\
522 This function adds a virtual CD-ROM disk image to the guest.
523
524 This is equivalent to the qemu parameter C<-cdrom filename>.
525
526 Notes:
527
528 =over 4
529
530 =item *
531
532 This call checks for the existence of C<filename>.  This
533 stops you from specifying other types of drive which are supported
534 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
535 the general C<guestfs_config> call instead.
536
537 =item *
538
539 If you just want to add an ISO file (often you use this as an
540 efficient way to transfer large files into the guest), then you
541 should probably use C<guestfs_add_drive_ro> instead.
542
543 =back");
544
545   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
546    [],
547    "add a drive in snapshot mode (read-only)",
548    "\
549 This adds a drive in snapshot mode, making it effectively
550 read-only.
551
552 Note that writes to the device are allowed, and will be seen for
553 the duration of the guestfs handle, but they are written
554 to a temporary file which is discarded as soon as the guestfs
555 handle is closed.  We don't currently have any method to enable
556 changes to be committed, although qemu can support this.
557
558 This is equivalent to the qemu parameter
559 C<-drive file=filename,snapshot=on,if=...>.
560
561 C<if=...> is set at compile time by the configuration option
562 C<./configure --with-drive-if=...>.  In the rare case where you
563 might need to change this at run time, use C<guestfs_add_drive_with_if>
564 or C<guestfs_add_drive_ro_with_if>.
565
566 Note that this call checks for the existence of C<filename>.  This
567 stops you from specifying other types of drive which are supported
568 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
569 the general C<guestfs_config> call instead.");
570
571   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
572    [],
573    "add qemu parameters",
574    "\
575 This can be used to add arbitrary qemu command line parameters
576 of the form C<-param value>.  Actually it's not quite arbitrary - we
577 prevent you from setting some parameters which would interfere with
578 parameters that we use.
579
580 The first character of C<param> string must be a C<-> (dash).
581
582 C<value> can be NULL.");
583
584   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
585    [],
586    "set the qemu binary",
587    "\
588 Set the qemu binary that we will use.
589
590 The default is chosen when the library was compiled by the
591 configure script.
592
593 You can also override this by setting the C<LIBGUESTFS_QEMU>
594 environment variable.
595
596 Setting C<qemu> to C<NULL> restores the default qemu binary.
597
598 Note that you should call this function as early as possible
599 after creating the handle.  This is because some pre-launch
600 operations depend on testing qemu features (by running C<qemu -help>).
601 If the qemu binary changes, we don't retest features, and
602 so you might see inconsistent results.  Using the environment
603 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
604 the qemu binary at the same time as the handle is created.");
605
606   ("get_qemu", (RConstString "qemu", []), -1, [],
607    [InitNone, Always, TestRun (
608       [["get_qemu"]])],
609    "get the qemu binary",
610    "\
611 Return the current qemu binary.
612
613 This is always non-NULL.  If it wasn't set already, then this will
614 return the default qemu binary name.");
615
616   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
617    [],
618    "set the search path",
619    "\
620 Set the path that libguestfs searches for kernel and initrd.img.
621
622 The default is C<$libdir/guestfs> unless overridden by setting
623 C<LIBGUESTFS_PATH> environment variable.
624
625 Setting C<path> to C<NULL> restores the default path.");
626
627   ("get_path", (RConstString "path", []), -1, [],
628    [InitNone, Always, TestRun (
629       [["get_path"]])],
630    "get the search path",
631    "\
632 Return the current search path.
633
634 This is always non-NULL.  If it wasn't set already, then this will
635 return the default path.");
636
637   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
638    [],
639    "add options to kernel command line",
640    "\
641 This function is used to add additional options to the
642 guest kernel command line.
643
644 The default is C<NULL> unless overridden by setting
645 C<LIBGUESTFS_APPEND> environment variable.
646
647 Setting C<append> to C<NULL> means I<no> additional options
648 are passed (libguestfs always adds a few of its own).");
649
650   ("get_append", (RConstOptString "append", []), -1, [],
651    (* This cannot be tested with the current framework.  The
652     * function can return NULL in normal operations, which the
653     * test framework interprets as an error.
654     *)
655    [],
656    "get the additional kernel options",
657    "\
658 Return the additional kernel options which are added to the
659 guest kernel command line.
660
661 If C<NULL> then no options are added.");
662
663   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
664    [],
665    "set autosync mode",
666    "\
667 If C<autosync> is true, this enables autosync.  Libguestfs will make a
668 best effort attempt to run C<guestfs_umount_all> followed by
669 C<guestfs_sync> when the handle is closed
670 (also if the program exits without closing handles).
671
672 This is disabled by default (except in guestfish where it is
673 enabled by default).");
674
675   ("get_autosync", (RBool "autosync", []), -1, [],
676    [InitNone, Always, TestRun (
677       [["get_autosync"]])],
678    "get autosync mode",
679    "\
680 Get the autosync flag.");
681
682   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
683    [],
684    "set verbose mode",
685    "\
686 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
687
688 Verbose messages are disabled unless the environment variable
689 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
690
691   ("get_verbose", (RBool "verbose", []), -1, [],
692    [],
693    "get verbose mode",
694    "\
695 This returns the verbose messages flag.");
696
697   ("is_ready", (RBool "ready", []), -1, [],
698    [InitNone, Always, TestOutputTrue (
699       [["is_ready"]])],
700    "is ready to accept commands",
701    "\
702 This returns true iff this handle is ready to accept commands
703 (in the C<READY> state).
704
705 For more information on states, see L<guestfs(3)>.");
706
707   ("is_config", (RBool "config", []), -1, [],
708    [InitNone, Always, TestOutputFalse (
709       [["is_config"]])],
710    "is in configuration state",
711    "\
712 This returns true iff this handle is being configured
713 (in the C<CONFIG> state).
714
715 For more information on states, see L<guestfs(3)>.");
716
717   ("is_launching", (RBool "launching", []), -1, [],
718    [InitNone, Always, TestOutputFalse (
719       [["is_launching"]])],
720    "is launching subprocess",
721    "\
722 This returns true iff this handle is launching the subprocess
723 (in the C<LAUNCHING> state).
724
725 For more information on states, see L<guestfs(3)>.");
726
727   ("is_busy", (RBool "busy", []), -1, [],
728    [InitNone, Always, TestOutputFalse (
729       [["is_busy"]])],
730    "is busy processing a command",
731    "\
732 This returns true iff this handle is busy processing a command
733 (in the C<BUSY> state).
734
735 For more information on states, see L<guestfs(3)>.");
736
737   ("get_state", (RInt "state", []), -1, [],
738    [],
739    "get the current state",
740    "\
741 This returns the current state as an opaque integer.  This is
742 only useful for printing debug and internal error messages.
743
744 For more information on states, see L<guestfs(3)>.");
745
746   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
747    [InitNone, Always, TestOutputInt (
748       [["set_memsize"; "500"];
749        ["get_memsize"]], 500)],
750    "set memory allocated to the qemu subprocess",
751    "\
752 This sets the memory size in megabytes allocated to the
753 qemu subprocess.  This only has any effect if called before
754 C<guestfs_launch>.
755
756 You can also change this by setting the environment
757 variable C<LIBGUESTFS_MEMSIZE> before the handle is
758 created.
759
760 For more information on the architecture of libguestfs,
761 see L<guestfs(3)>.");
762
763   ("get_memsize", (RInt "memsize", []), -1, [],
764    [InitNone, Always, TestOutputIntOp (
765       [["get_memsize"]], ">=", 256)],
766    "get memory allocated to the qemu subprocess",
767    "\
768 This gets the memory size in megabytes allocated to the
769 qemu subprocess.
770
771 If C<guestfs_set_memsize> was not called
772 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
773 then this returns the compiled-in default value for memsize.
774
775 For more information on the architecture of libguestfs,
776 see L<guestfs(3)>.");
777
778   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
779    [InitNone, Always, TestOutputIntOp (
780       [["get_pid"]], ">=", 1)],
781    "get PID of qemu subprocess",
782    "\
783 Return the process ID of the qemu subprocess.  If there is no
784 qemu subprocess, then this will return an error.
785
786 This is an internal call used for debugging and testing.");
787
788   ("version", (RStruct ("version", "version"), []), -1, [],
789    [InitNone, Always, TestOutputStruct (
790       [["version"]], [CompareWithInt ("major", 1)])],
791    "get the library version number",
792    "\
793 Return the libguestfs version number that the program is linked
794 against.
795
796 Note that because of dynamic linking this is not necessarily
797 the version of libguestfs that you compiled against.  You can
798 compile the program, and then at runtime dynamically link
799 against a completely different C<libguestfs.so> library.
800
801 This call was added in version C<1.0.58>.  In previous
802 versions of libguestfs there was no way to get the version
803 number.  From C code you can use dynamic linker functions
804 to find out if this symbol exists (if it doesn't, then
805 it's an earlier version).
806
807 The call returns a structure with four elements.  The first
808 three (C<major>, C<minor> and C<release>) are numbers and
809 correspond to the usual version triplet.  The fourth element
810 (C<extra>) is a string and is normally empty, but may be
811 used for distro-specific information.
812
813 To construct the original version string:
814 C<$major.$minor.$release$extra>
815
816 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
817
818 I<Note:> Don't use this call to test for availability
819 of features.  In enterprise distributions we backport
820 features from later versions into earlier versions,
821 making this an unreliable way to test for features.
822 Use C<guestfs_available> instead.");
823
824   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
825    [InitNone, Always, TestOutputTrue (
826       [["set_selinux"; "true"];
827        ["get_selinux"]])],
828    "set SELinux enabled or disabled at appliance boot",
829    "\
830 This sets the selinux flag that is passed to the appliance
831 at boot time.  The default is C<selinux=0> (disabled).
832
833 Note that if SELinux is enabled, it is always in
834 Permissive mode (C<enforcing=0>).
835
836 For more information on the architecture of libguestfs,
837 see L<guestfs(3)>.");
838
839   ("get_selinux", (RBool "selinux", []), -1, [],
840    [],
841    "get SELinux enabled flag",
842    "\
843 This returns the current setting of the selinux flag which
844 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
845
846 For more information on the architecture of libguestfs,
847 see L<guestfs(3)>.");
848
849   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
850    [InitNone, Always, TestOutputFalse (
851       [["set_trace"; "false"];
852        ["get_trace"]])],
853    "enable or disable command traces",
854    "\
855 If the command trace flag is set to 1, then commands are
856 printed on stdout before they are executed in a format
857 which is very similar to the one used by guestfish.  In
858 other words, you can run a program with this enabled, and
859 you will get out a script which you can feed to guestfish
860 to perform the same set of actions.
861
862 If you want to trace C API calls into libguestfs (and
863 other libraries) then possibly a better way is to use
864 the external ltrace(1) command.
865
866 Command traces are disabled unless the environment variable
867 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
868
869   ("get_trace", (RBool "trace", []), -1, [],
870    [],
871    "get command trace enabled flag",
872    "\
873 Return the command trace flag.");
874
875   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
876    [InitNone, Always, TestOutputFalse (
877       [["set_direct"; "false"];
878        ["get_direct"]])],
879    "enable or disable direct appliance mode",
880    "\
881 If the direct appliance mode flag is enabled, then stdin and
882 stdout are passed directly through to the appliance once it
883 is launched.
884
885 One consequence of this is that log messages aren't caught
886 by the library and handled by C<guestfs_set_log_message_callback>,
887 but go straight to stdout.
888
889 You probably don't want to use this unless you know what you
890 are doing.
891
892 The default is disabled.");
893
894   ("get_direct", (RBool "direct", []), -1, [],
895    [],
896    "get direct appliance mode flag",
897    "\
898 Return the direct appliance mode flag.");
899
900   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
901    [InitNone, Always, TestOutputTrue (
902       [["set_recovery_proc"; "true"];
903        ["get_recovery_proc"]])],
904    "enable or disable the recovery process",
905    "\
906 If this is called with the parameter C<false> then
907 C<guestfs_launch> does not create a recovery process.  The
908 purpose of the recovery process is to stop runaway qemu
909 processes in the case where the main program aborts abruptly.
910
911 This only has any effect if called before C<guestfs_launch>,
912 and the default is true.
913
914 About the only time when you would want to disable this is
915 if the main process will fork itself into the background
916 (\"daemonize\" itself).  In this case the recovery process
917 thinks that the main program has disappeared and so kills
918 qemu, which is not very helpful.");
919
920   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
921    [],
922    "get recovery process enabled flag",
923    "\
924 Return the recovery process enabled flag.");
925
926   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
927    [],
928    "add a drive specifying the QEMU block emulation to use",
929    "\
930 This is the same as C<guestfs_add_drive> but it allows you
931 to specify the QEMU interface emulation to use at run time.");
932
933   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
934    [],
935    "add a drive read-only specifying the QEMU block emulation to use",
936    "\
937 This is the same as C<guestfs_add_drive_ro> but it allows you
938 to specify the QEMU interface emulation to use at run time.");
939
940 ]
941
942 (* daemon_functions are any functions which cause some action
943  * to take place in the daemon.
944  *)
945
946 let daemon_functions = [
947   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
948    [InitEmpty, Always, TestOutput (
949       [["part_disk"; "/dev/sda"; "mbr"];
950        ["mkfs"; "ext2"; "/dev/sda1"];
951        ["mount"; "/dev/sda1"; "/"];
952        ["write"; "/new"; "new file contents"];
953        ["cat"; "/new"]], "new file contents")],
954    "mount a guest disk at a position in the filesystem",
955    "\
956 Mount a guest disk at a position in the filesystem.  Block devices
957 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
958 the guest.  If those block devices contain partitions, they will have
959 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
960 names can be used.
961
962 The rules are the same as for L<mount(2)>:  A filesystem must
963 first be mounted on C</> before others can be mounted.  Other
964 filesystems can only be mounted on directories which already
965 exist.
966
967 The mounted filesystem is writable, if we have sufficient permissions
968 on the underlying device.
969
970 B<Important note:>
971 When you use this call, the filesystem options C<sync> and C<noatime>
972 are set implicitly.  This was originally done because we thought it
973 would improve reliability, but it turns out that I<-o sync> has a
974 very large negative performance impact and negligible effect on
975 reliability.  Therefore we recommend that you avoid using
976 C<guestfs_mount> in any code that needs performance, and instead
977 use C<guestfs_mount_options> (use an empty string for the first
978 parameter if you don't want any options).");
979
980   ("sync", (RErr, []), 2, [],
981    [ InitEmpty, Always, TestRun [["sync"]]],
982    "sync disks, writes are flushed through to the disk image",
983    "\
984 This syncs the disk, so that any writes are flushed through to the
985 underlying disk image.
986
987 You should always call this if you have modified a disk image, before
988 closing the handle.");
989
990   ("touch", (RErr, [Pathname "path"]), 3, [],
991    [InitBasicFS, Always, TestOutputTrue (
992       [["touch"; "/new"];
993        ["exists"; "/new"]])],
994    "update file timestamps or create a new file",
995    "\
996 Touch acts like the L<touch(1)> command.  It can be used to
997 update the timestamps on a file, or, if the file does not exist,
998 to create a new zero-length file.
999
1000 This command only works on regular files, and will fail on other
1001 file types such as directories, symbolic links, block special etc.");
1002
1003   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
1004    [InitISOFS, Always, TestOutput (
1005       [["cat"; "/known-2"]], "abcdef\n")],
1006    "list the contents of a file",
1007    "\
1008 Return the contents of the file named C<path>.
1009
1010 Note that this function cannot correctly handle binary files
1011 (specifically, files containing C<\\0> character which is treated
1012 as end of string).  For those you need to use the C<guestfs_read_file>
1013 or C<guestfs_download> functions which have a more complex interface.");
1014
1015   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1016    [], (* XXX Tricky to test because it depends on the exact format
1017         * of the 'ls -l' command, which changes between F10 and F11.
1018         *)
1019    "list the files in a directory (long format)",
1020    "\
1021 List the files in C<directory> (relative to the root directory,
1022 there is no cwd) in the format of 'ls -la'.
1023
1024 This command is mostly useful for interactive sessions.  It
1025 is I<not> intended that you try to parse the output string.");
1026
1027   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1028    [InitBasicFS, Always, TestOutputList (
1029       [["touch"; "/new"];
1030        ["touch"; "/newer"];
1031        ["touch"; "/newest"];
1032        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1033    "list the files in a directory",
1034    "\
1035 List the files in C<directory> (relative to the root directory,
1036 there is no cwd).  The '.' and '..' entries are not returned, but
1037 hidden files are shown.
1038
1039 This command is mostly useful for interactive sessions.  Programs
1040 should probably use C<guestfs_readdir> instead.");
1041
1042   ("list_devices", (RStringList "devices", []), 7, [],
1043    [InitEmpty, Always, TestOutputListOfDevices (
1044       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1045    "list the block devices",
1046    "\
1047 List all the block devices.
1048
1049 The full block device names are returned, eg. C</dev/sda>");
1050
1051   ("list_partitions", (RStringList "partitions", []), 8, [],
1052    [InitBasicFS, Always, TestOutputListOfDevices (
1053       [["list_partitions"]], ["/dev/sda1"]);
1054     InitEmpty, Always, TestOutputListOfDevices (
1055       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1056        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1057    "list the partitions",
1058    "\
1059 List all the partitions detected on all block devices.
1060
1061 The full partition device names are returned, eg. C</dev/sda1>
1062
1063 This does not return logical volumes.  For that you will need to
1064 call C<guestfs_lvs>.");
1065
1066   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1067    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1068       [["pvs"]], ["/dev/sda1"]);
1069     InitEmpty, Always, TestOutputListOfDevices (
1070       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1071        ["pvcreate"; "/dev/sda1"];
1072        ["pvcreate"; "/dev/sda2"];
1073        ["pvcreate"; "/dev/sda3"];
1074        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1075    "list the LVM physical volumes (PVs)",
1076    "\
1077 List all the physical volumes detected.  This is the equivalent
1078 of the L<pvs(8)> command.
1079
1080 This returns a list of just the device names that contain
1081 PVs (eg. C</dev/sda2>).
1082
1083 See also C<guestfs_pvs_full>.");
1084
1085   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1086    [InitBasicFSonLVM, Always, TestOutputList (
1087       [["vgs"]], ["VG"]);
1088     InitEmpty, Always, TestOutputList (
1089       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1090        ["pvcreate"; "/dev/sda1"];
1091        ["pvcreate"; "/dev/sda2"];
1092        ["pvcreate"; "/dev/sda3"];
1093        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1094        ["vgcreate"; "VG2"; "/dev/sda3"];
1095        ["vgs"]], ["VG1"; "VG2"])],
1096    "list the LVM volume groups (VGs)",
1097    "\
1098 List all the volumes groups detected.  This is the equivalent
1099 of the L<vgs(8)> command.
1100
1101 This returns a list of just the volume group names that were
1102 detected (eg. C<VolGroup00>).
1103
1104 See also C<guestfs_vgs_full>.");
1105
1106   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1107    [InitBasicFSonLVM, Always, TestOutputList (
1108       [["lvs"]], ["/dev/VG/LV"]);
1109     InitEmpty, Always, TestOutputList (
1110       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1111        ["pvcreate"; "/dev/sda1"];
1112        ["pvcreate"; "/dev/sda2"];
1113        ["pvcreate"; "/dev/sda3"];
1114        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1115        ["vgcreate"; "VG2"; "/dev/sda3"];
1116        ["lvcreate"; "LV1"; "VG1"; "50"];
1117        ["lvcreate"; "LV2"; "VG1"; "50"];
1118        ["lvcreate"; "LV3"; "VG2"; "50"];
1119        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1120    "list the LVM logical volumes (LVs)",
1121    "\
1122 List all the logical volumes detected.  This is the equivalent
1123 of the L<lvs(8)> command.
1124
1125 This returns a list of the logical volume device names
1126 (eg. C</dev/VolGroup00/LogVol00>).
1127
1128 See also C<guestfs_lvs_full>.");
1129
1130   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1131    [], (* XXX how to test? *)
1132    "list the LVM physical volumes (PVs)",
1133    "\
1134 List all the physical volumes detected.  This is the equivalent
1135 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1136
1137   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1138    [], (* XXX how to test? *)
1139    "list the LVM volume groups (VGs)",
1140    "\
1141 List all the volumes groups detected.  This is the equivalent
1142 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1143
1144   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1145    [], (* XXX how to test? *)
1146    "list the LVM logical volumes (LVs)",
1147    "\
1148 List all the logical volumes detected.  This is the equivalent
1149 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1150
1151   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1152    [InitISOFS, Always, TestOutputList (
1153       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1154     InitISOFS, Always, TestOutputList (
1155       [["read_lines"; "/empty"]], [])],
1156    "read file as lines",
1157    "\
1158 Return the contents of the file named C<path>.
1159
1160 The file contents are returned as a list of lines.  Trailing
1161 C<LF> and C<CRLF> character sequences are I<not> returned.
1162
1163 Note that this function cannot correctly handle binary files
1164 (specifically, files containing C<\\0> character which is treated
1165 as end of line).  For those you need to use the C<guestfs_read_file>
1166 function which has a more complex interface.");
1167
1168   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1169    [], (* XXX Augeas code needs tests. *)
1170    "create a new Augeas handle",
1171    "\
1172 Create a new Augeas handle for editing configuration files.
1173 If there was any previous Augeas handle associated with this
1174 guestfs session, then it is closed.
1175
1176 You must call this before using any other C<guestfs_aug_*>
1177 commands.
1178
1179 C<root> is the filesystem root.  C<root> must not be NULL,
1180 use C</> instead.
1181
1182 The flags are the same as the flags defined in
1183 E<lt>augeas.hE<gt>, the logical I<or> of the following
1184 integers:
1185
1186 =over 4
1187
1188 =item C<AUG_SAVE_BACKUP> = 1
1189
1190 Keep the original file with a C<.augsave> extension.
1191
1192 =item C<AUG_SAVE_NEWFILE> = 2
1193
1194 Save changes into a file with extension C<.augnew>, and
1195 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1196
1197 =item C<AUG_TYPE_CHECK> = 4
1198
1199 Typecheck lenses (can be expensive).
1200
1201 =item C<AUG_NO_STDINC> = 8
1202
1203 Do not use standard load path for modules.
1204
1205 =item C<AUG_SAVE_NOOP> = 16
1206
1207 Make save a no-op, just record what would have been changed.
1208
1209 =item C<AUG_NO_LOAD> = 32
1210
1211 Do not load the tree in C<guestfs_aug_init>.
1212
1213 =back
1214
1215 To close the handle, you can call C<guestfs_aug_close>.
1216
1217 To find out more about Augeas, see L<http://augeas.net/>.");
1218
1219   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1220    [], (* XXX Augeas code needs tests. *)
1221    "close the current Augeas handle",
1222    "\
1223 Close the current Augeas handle and free up any resources
1224 used by it.  After calling this, you have to call
1225 C<guestfs_aug_init> again before you can use any other
1226 Augeas functions.");
1227
1228   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1229    [], (* XXX Augeas code needs tests. *)
1230    "define an Augeas variable",
1231    "\
1232 Defines an Augeas variable C<name> whose value is the result
1233 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1234 undefined.
1235
1236 On success this returns the number of nodes in C<expr>, or
1237 C<0> if C<expr> evaluates to something which is not a nodeset.");
1238
1239   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1240    [], (* XXX Augeas code needs tests. *)
1241    "define an Augeas node",
1242    "\
1243 Defines a variable C<name> whose value is the result of
1244 evaluating C<expr>.
1245
1246 If C<expr> evaluates to an empty nodeset, a node is created,
1247 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1248 C<name> will be the nodeset containing that single node.
1249
1250 On success this returns a pair containing the
1251 number of nodes in the nodeset, and a boolean flag
1252 if a node was created.");
1253
1254   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1255    [], (* XXX Augeas code needs tests. *)
1256    "look up the value of an Augeas path",
1257    "\
1258 Look up the value associated with C<path>.  If C<path>
1259 matches exactly one node, the C<value> is returned.");
1260
1261   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1262    [], (* XXX Augeas code needs tests. *)
1263    "set Augeas path to value",
1264    "\
1265 Set the value associated with C<path> to C<val>.
1266
1267 In the Augeas API, it is possible to clear a node by setting
1268 the value to NULL.  Due to an oversight in the libguestfs API
1269 you cannot do that with this call.  Instead you must use the
1270 C<guestfs_aug_clear> call.");
1271
1272   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1273    [], (* XXX Augeas code needs tests. *)
1274    "insert a sibling Augeas node",
1275    "\
1276 Create a new sibling C<label> for C<path>, inserting it into
1277 the tree before or after C<path> (depending on the boolean
1278 flag C<before>).
1279
1280 C<path> must match exactly one existing node in the tree, and
1281 C<label> must be a label, ie. not contain C</>, C<*> or end
1282 with a bracketed index C<[N]>.");
1283
1284   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1285    [], (* XXX Augeas code needs tests. *)
1286    "remove an Augeas path",
1287    "\
1288 Remove C<path> and all of its children.
1289
1290 On success this returns the number of entries which were removed.");
1291
1292   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1293    [], (* XXX Augeas code needs tests. *)
1294    "move Augeas node",
1295    "\
1296 Move the node C<src> to C<dest>.  C<src> must match exactly
1297 one node.  C<dest> is overwritten if it exists.");
1298
1299   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1300    [], (* XXX Augeas code needs tests. *)
1301    "return Augeas nodes which match augpath",
1302    "\
1303 Returns a list of paths which match the path expression C<path>.
1304 The returned paths are sufficiently qualified so that they match
1305 exactly one node in the current tree.");
1306
1307   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1308    [], (* XXX Augeas code needs tests. *)
1309    "write all pending Augeas changes to disk",
1310    "\
1311 This writes all pending changes to disk.
1312
1313 The flags which were passed to C<guestfs_aug_init> affect exactly
1314 how files are saved.");
1315
1316   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1317    [], (* XXX Augeas code needs tests. *)
1318    "load files into the tree",
1319    "\
1320 Load files into the tree.
1321
1322 See C<aug_load> in the Augeas documentation for the full gory
1323 details.");
1324
1325   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1326    [], (* XXX Augeas code needs tests. *)
1327    "list Augeas nodes under augpath",
1328    "\
1329 This is just a shortcut for listing C<guestfs_aug_match>
1330 C<path/*> and sorting the resulting nodes into alphabetical order.");
1331
1332   ("rm", (RErr, [Pathname "path"]), 29, [],
1333    [InitBasicFS, Always, TestRun
1334       [["touch"; "/new"];
1335        ["rm"; "/new"]];
1336     InitBasicFS, Always, TestLastFail
1337       [["rm"; "/new"]];
1338     InitBasicFS, Always, TestLastFail
1339       [["mkdir"; "/new"];
1340        ["rm"; "/new"]]],
1341    "remove a file",
1342    "\
1343 Remove the single file C<path>.");
1344
1345   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1346    [InitBasicFS, Always, TestRun
1347       [["mkdir"; "/new"];
1348        ["rmdir"; "/new"]];
1349     InitBasicFS, Always, TestLastFail
1350       [["rmdir"; "/new"]];
1351     InitBasicFS, Always, TestLastFail
1352       [["touch"; "/new"];
1353        ["rmdir"; "/new"]]],
1354    "remove a directory",
1355    "\
1356 Remove the single directory C<path>.");
1357
1358   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1359    [InitBasicFS, Always, TestOutputFalse
1360       [["mkdir"; "/new"];
1361        ["mkdir"; "/new/foo"];
1362        ["touch"; "/new/foo/bar"];
1363        ["rm_rf"; "/new"];
1364        ["exists"; "/new"]]],
1365    "remove a file or directory recursively",
1366    "\
1367 Remove the file or directory C<path>, recursively removing the
1368 contents if its a directory.  This is like the C<rm -rf> shell
1369 command.");
1370
1371   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1372    [InitBasicFS, Always, TestOutputTrue
1373       [["mkdir"; "/new"];
1374        ["is_dir"; "/new"]];
1375     InitBasicFS, Always, TestLastFail
1376       [["mkdir"; "/new/foo/bar"]]],
1377    "create a directory",
1378    "\
1379 Create a directory named C<path>.");
1380
1381   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1382    [InitBasicFS, Always, TestOutputTrue
1383       [["mkdir_p"; "/new/foo/bar"];
1384        ["is_dir"; "/new/foo/bar"]];
1385     InitBasicFS, Always, TestOutputTrue
1386       [["mkdir_p"; "/new/foo/bar"];
1387        ["is_dir"; "/new/foo"]];
1388     InitBasicFS, Always, TestOutputTrue
1389       [["mkdir_p"; "/new/foo/bar"];
1390        ["is_dir"; "/new"]];
1391     (* Regression tests for RHBZ#503133: *)
1392     InitBasicFS, Always, TestRun
1393       [["mkdir"; "/new"];
1394        ["mkdir_p"; "/new"]];
1395     InitBasicFS, Always, TestLastFail
1396       [["touch"; "/new"];
1397        ["mkdir_p"; "/new"]]],
1398    "create a directory and parents",
1399    "\
1400 Create a directory named C<path>, creating any parent directories
1401 as necessary.  This is like the C<mkdir -p> shell command.");
1402
1403   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1404    [], (* XXX Need stat command to test *)
1405    "change file mode",
1406    "\
1407 Change the mode (permissions) of C<path> to C<mode>.  Only
1408 numeric modes are supported.
1409
1410 I<Note>: When using this command from guestfish, C<mode>
1411 by default would be decimal, unless you prefix it with
1412 C<0> to get octal, ie. use C<0700> not C<700>.
1413
1414 The mode actually set is affected by the umask.");
1415
1416   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1417    [], (* XXX Need stat command to test *)
1418    "change file owner and group",
1419    "\
1420 Change the file owner to C<owner> and group to C<group>.
1421
1422 Only numeric uid and gid are supported.  If you want to use
1423 names, you will need to locate and parse the password file
1424 yourself (Augeas support makes this relatively easy).");
1425
1426   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1427    [InitISOFS, Always, TestOutputTrue (
1428       [["exists"; "/empty"]]);
1429     InitISOFS, Always, TestOutputTrue (
1430       [["exists"; "/directory"]])],
1431    "test if file or directory exists",
1432    "\
1433 This returns C<true> if and only if there is a file, directory
1434 (or anything) with the given C<path> name.
1435
1436 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1437
1438   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1439    [InitISOFS, Always, TestOutputTrue (
1440       [["is_file"; "/known-1"]]);
1441     InitISOFS, Always, TestOutputFalse (
1442       [["is_file"; "/directory"]])],
1443    "test if a regular file",
1444    "\
1445 This returns C<true> if and only if there is a regular file
1446 with the given C<path> name.  Note that it returns false for
1447 other objects like directories.
1448
1449 See also C<guestfs_stat>.");
1450
1451   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1452    [InitISOFS, Always, TestOutputFalse (
1453       [["is_dir"; "/known-3"]]);
1454     InitISOFS, Always, TestOutputTrue (
1455       [["is_dir"; "/directory"]])],
1456    "test if a directory",
1457    "\
1458 This returns C<true> if and only if there is a directory
1459 with the given C<path> name.  Note that it returns false for
1460 other objects like files.
1461
1462 See also C<guestfs_stat>.");
1463
1464   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1465    [InitEmpty, Always, TestOutputListOfDevices (
1466       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1467        ["pvcreate"; "/dev/sda1"];
1468        ["pvcreate"; "/dev/sda2"];
1469        ["pvcreate"; "/dev/sda3"];
1470        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1471    "create an LVM physical volume",
1472    "\
1473 This creates an LVM physical volume on the named C<device>,
1474 where C<device> should usually be a partition name such
1475 as C</dev/sda1>.");
1476
1477   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1478    [InitEmpty, Always, TestOutputList (
1479       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1480        ["pvcreate"; "/dev/sda1"];
1481        ["pvcreate"; "/dev/sda2"];
1482        ["pvcreate"; "/dev/sda3"];
1483        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1484        ["vgcreate"; "VG2"; "/dev/sda3"];
1485        ["vgs"]], ["VG1"; "VG2"])],
1486    "create an LVM volume group",
1487    "\
1488 This creates an LVM volume group called C<volgroup>
1489 from the non-empty list of physical volumes C<physvols>.");
1490
1491   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1492    [InitEmpty, Always, TestOutputList (
1493       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1494        ["pvcreate"; "/dev/sda1"];
1495        ["pvcreate"; "/dev/sda2"];
1496        ["pvcreate"; "/dev/sda3"];
1497        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1498        ["vgcreate"; "VG2"; "/dev/sda3"];
1499        ["lvcreate"; "LV1"; "VG1"; "50"];
1500        ["lvcreate"; "LV2"; "VG1"; "50"];
1501        ["lvcreate"; "LV3"; "VG2"; "50"];
1502        ["lvcreate"; "LV4"; "VG2"; "50"];
1503        ["lvcreate"; "LV5"; "VG2"; "50"];
1504        ["lvs"]],
1505       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1506        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1507    "create an LVM logical volume",
1508    "\
1509 This creates an LVM logical volume called C<logvol>
1510 on the volume group C<volgroup>, with C<size> megabytes.");
1511
1512   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1513    [InitEmpty, Always, TestOutput (
1514       [["part_disk"; "/dev/sda"; "mbr"];
1515        ["mkfs"; "ext2"; "/dev/sda1"];
1516        ["mount_options"; ""; "/dev/sda1"; "/"];
1517        ["write"; "/new"; "new file contents"];
1518        ["cat"; "/new"]], "new file contents")],
1519    "make a filesystem",
1520    "\
1521 This creates a filesystem on C<device> (usually a partition
1522 or LVM logical volume).  The filesystem type is C<fstype>, for
1523 example C<ext3>.");
1524
1525   ("sfdisk", (RErr, [Device "device";
1526                      Int "cyls"; Int "heads"; Int "sectors";
1527                      StringList "lines"]), 43, [DangerWillRobinson],
1528    [],
1529    "create partitions on a block device",
1530    "\
1531 This is a direct interface to the L<sfdisk(8)> program for creating
1532 partitions on block devices.
1533
1534 C<device> should be a block device, for example C</dev/sda>.
1535
1536 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1537 and sectors on the device, which are passed directly to sfdisk as
1538 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1539 of these, then the corresponding parameter is omitted.  Usually for
1540 'large' disks, you can just pass C<0> for these, but for small
1541 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1542 out the right geometry and you will need to tell it.
1543
1544 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1545 information refer to the L<sfdisk(8)> manpage.
1546
1547 To create a single partition occupying the whole disk, you would
1548 pass C<lines> as a single element list, when the single element being
1549 the string C<,> (comma).
1550
1551 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1552 C<guestfs_part_init>");
1553
1554   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],
1555    (* Regression test for RHBZ#597135. *)
1556    [InitBasicFS, Always, TestLastFail
1557       [["write_file"; "/new"; "abc"; "10000"]]],
1558    "create a file",
1559    "\
1560 This call creates a file called C<path>.  The contents of the
1561 file is the string C<content> (which can contain any 8 bit data),
1562 with length C<size>.
1563
1564 As a special case, if C<size> is C<0>
1565 then the length is calculated using C<strlen> (so in this case
1566 the content cannot contain embedded ASCII NULs).
1567
1568 I<NB.> Owing to a bug, writing content containing ASCII NUL
1569 characters does I<not> work, even if the length is specified.");
1570
1571   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1572    [InitEmpty, Always, TestOutputListOfDevices (
1573       [["part_disk"; "/dev/sda"; "mbr"];
1574        ["mkfs"; "ext2"; "/dev/sda1"];
1575        ["mount_options"; ""; "/dev/sda1"; "/"];
1576        ["mounts"]], ["/dev/sda1"]);
1577     InitEmpty, Always, TestOutputList (
1578       [["part_disk"; "/dev/sda"; "mbr"];
1579        ["mkfs"; "ext2"; "/dev/sda1"];
1580        ["mount_options"; ""; "/dev/sda1"; "/"];
1581        ["umount"; "/"];
1582        ["mounts"]], [])],
1583    "unmount a filesystem",
1584    "\
1585 This unmounts the given filesystem.  The filesystem may be
1586 specified either by its mountpoint (path) or the device which
1587 contains the filesystem.");
1588
1589   ("mounts", (RStringList "devices", []), 46, [],
1590    [InitBasicFS, Always, TestOutputListOfDevices (
1591       [["mounts"]], ["/dev/sda1"])],
1592    "show mounted filesystems",
1593    "\
1594 This returns the list of currently mounted filesystems.  It returns
1595 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1596
1597 Some internal mounts are not shown.
1598
1599 See also: C<guestfs_mountpoints>");
1600
1601   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1602    [InitBasicFS, Always, TestOutputList (
1603       [["umount_all"];
1604        ["mounts"]], []);
1605     (* check that umount_all can unmount nested mounts correctly: *)
1606     InitEmpty, Always, TestOutputList (
1607       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1608        ["mkfs"; "ext2"; "/dev/sda1"];
1609        ["mkfs"; "ext2"; "/dev/sda2"];
1610        ["mkfs"; "ext2"; "/dev/sda3"];
1611        ["mount_options"; ""; "/dev/sda1"; "/"];
1612        ["mkdir"; "/mp1"];
1613        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1614        ["mkdir"; "/mp1/mp2"];
1615        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1616        ["mkdir"; "/mp1/mp2/mp3"];
1617        ["umount_all"];
1618        ["mounts"]], [])],
1619    "unmount all filesystems",
1620    "\
1621 This unmounts all mounted filesystems.
1622
1623 Some internal mounts are not unmounted by this call.");
1624
1625   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1626    [],
1627    "remove all LVM LVs, VGs and PVs",
1628    "\
1629 This command removes all LVM logical volumes, volume groups
1630 and physical volumes.");
1631
1632   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1633    [InitISOFS, Always, TestOutput (
1634       [["file"; "/empty"]], "empty");
1635     InitISOFS, Always, TestOutput (
1636       [["file"; "/known-1"]], "ASCII text");
1637     InitISOFS, Always, TestLastFail (
1638       [["file"; "/notexists"]]);
1639     InitISOFS, Always, TestOutput (
1640       [["file"; "/abssymlink"]], "symbolic link");
1641     InitISOFS, Always, TestOutput (
1642       [["file"; "/directory"]], "directory")],
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.
1647
1648 This call will also transparently look inside various types
1649 of compressed file.
1650
1651 The exact command which runs is C<file -zb path>.  Note in
1652 particular that the filename is not prepended to the output
1653 (the C<-b> option).
1654
1655 This command can also be used on C</dev/> devices
1656 (and partitions, LV names).  You can for example use this
1657 to determine if a device contains a filesystem, although
1658 it's usually better to use C<guestfs_vfs_type>.
1659
1660 If the C<path> does not begin with C</dev/> then
1661 this command only works for the content of regular files.
1662 For other file types (directory, symbolic link etc) it
1663 will just return the string C<directory> etc.");
1664
1665   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1666    [InitBasicFS, Always, TestOutput (
1667       [["upload"; "test-command"; "/test-command"];
1668        ["chmod"; "0o755"; "/test-command"];
1669        ["command"; "/test-command 1"]], "Result1");
1670     InitBasicFS, Always, TestOutput (
1671       [["upload"; "test-command"; "/test-command"];
1672        ["chmod"; "0o755"; "/test-command"];
1673        ["command"; "/test-command 2"]], "Result2\n");
1674     InitBasicFS, Always, TestOutput (
1675       [["upload"; "test-command"; "/test-command"];
1676        ["chmod"; "0o755"; "/test-command"];
1677        ["command"; "/test-command 3"]], "\nResult3");
1678     InitBasicFS, Always, TestOutput (
1679       [["upload"; "test-command"; "/test-command"];
1680        ["chmod"; "0o755"; "/test-command"];
1681        ["command"; "/test-command 4"]], "\nResult4\n");
1682     InitBasicFS, Always, TestOutput (
1683       [["upload"; "test-command"; "/test-command"];
1684        ["chmod"; "0o755"; "/test-command"];
1685        ["command"; "/test-command 5"]], "\nResult5\n\n");
1686     InitBasicFS, Always, TestOutput (
1687       [["upload"; "test-command"; "/test-command"];
1688        ["chmod"; "0o755"; "/test-command"];
1689        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1690     InitBasicFS, Always, TestOutput (
1691       [["upload"; "test-command"; "/test-command"];
1692        ["chmod"; "0o755"; "/test-command"];
1693        ["command"; "/test-command 7"]], "");
1694     InitBasicFS, Always, TestOutput (
1695       [["upload"; "test-command"; "/test-command"];
1696        ["chmod"; "0o755"; "/test-command"];
1697        ["command"; "/test-command 8"]], "\n");
1698     InitBasicFS, Always, TestOutput (
1699       [["upload"; "test-command"; "/test-command"];
1700        ["chmod"; "0o755"; "/test-command"];
1701        ["command"; "/test-command 9"]], "\n\n");
1702     InitBasicFS, Always, TestOutput (
1703       [["upload"; "test-command"; "/test-command"];
1704        ["chmod"; "0o755"; "/test-command"];
1705        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1706     InitBasicFS, Always, TestOutput (
1707       [["upload"; "test-command"; "/test-command"];
1708        ["chmod"; "0o755"; "/test-command"];
1709        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1710     InitBasicFS, Always, TestLastFail (
1711       [["upload"; "test-command"; "/test-command"];
1712        ["chmod"; "0o755"; "/test-command"];
1713        ["command"; "/test-command"]])],
1714    "run a command from the guest filesystem",
1715    "\
1716 This call runs a command from the guest filesystem.  The
1717 filesystem must be mounted, and must contain a compatible
1718 operating system (ie. something Linux, with the same
1719 or compatible processor architecture).
1720
1721 The single parameter is an argv-style list of arguments.
1722 The first element is the name of the program to run.
1723 Subsequent elements are parameters.  The list must be
1724 non-empty (ie. must contain a program name).  Note that
1725 the command runs directly, and is I<not> invoked via
1726 the shell (see C<guestfs_sh>).
1727
1728 The return value is anything printed to I<stdout> by
1729 the command.
1730
1731 If the command returns a non-zero exit status, then
1732 this function returns an error message.  The error message
1733 string is the content of I<stderr> from the command.
1734
1735 The C<$PATH> environment variable will contain at least
1736 C</usr/bin> and C</bin>.  If you require a program from
1737 another location, you should provide the full path in the
1738 first parameter.
1739
1740 Shared libraries and data files required by the program
1741 must be available on filesystems which are mounted in the
1742 correct places.  It is the caller's responsibility to ensure
1743 all filesystems that are needed are mounted at the right
1744 locations.");
1745
1746   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1747    [InitBasicFS, Always, TestOutputList (
1748       [["upload"; "test-command"; "/test-command"];
1749        ["chmod"; "0o755"; "/test-command"];
1750        ["command_lines"; "/test-command 1"]], ["Result1"]);
1751     InitBasicFS, Always, TestOutputList (
1752       [["upload"; "test-command"; "/test-command"];
1753        ["chmod"; "0o755"; "/test-command"];
1754        ["command_lines"; "/test-command 2"]], ["Result2"]);
1755     InitBasicFS, Always, TestOutputList (
1756       [["upload"; "test-command"; "/test-command"];
1757        ["chmod"; "0o755"; "/test-command"];
1758        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1759     InitBasicFS, Always, TestOutputList (
1760       [["upload"; "test-command"; "/test-command"];
1761        ["chmod"; "0o755"; "/test-command"];
1762        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1763     InitBasicFS, Always, TestOutputList (
1764       [["upload"; "test-command"; "/test-command"];
1765        ["chmod"; "0o755"; "/test-command"];
1766        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1767     InitBasicFS, Always, TestOutputList (
1768       [["upload"; "test-command"; "/test-command"];
1769        ["chmod"; "0o755"; "/test-command"];
1770        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1771     InitBasicFS, Always, TestOutputList (
1772       [["upload"; "test-command"; "/test-command"];
1773        ["chmod"; "0o755"; "/test-command"];
1774        ["command_lines"; "/test-command 7"]], []);
1775     InitBasicFS, Always, TestOutputList (
1776       [["upload"; "test-command"; "/test-command"];
1777        ["chmod"; "0o755"; "/test-command"];
1778        ["command_lines"; "/test-command 8"]], [""]);
1779     InitBasicFS, Always, TestOutputList (
1780       [["upload"; "test-command"; "/test-command"];
1781        ["chmod"; "0o755"; "/test-command"];
1782        ["command_lines"; "/test-command 9"]], ["";""]);
1783     InitBasicFS, Always, TestOutputList (
1784       [["upload"; "test-command"; "/test-command"];
1785        ["chmod"; "0o755"; "/test-command"];
1786        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1787     InitBasicFS, Always, TestOutputList (
1788       [["upload"; "test-command"; "/test-command"];
1789        ["chmod"; "0o755"; "/test-command"];
1790        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1791    "run a command, returning lines",
1792    "\
1793 This is the same as C<guestfs_command>, but splits the
1794 result into a list of lines.
1795
1796 See also: C<guestfs_sh_lines>");
1797
1798   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1799    [InitISOFS, Always, TestOutputStruct (
1800       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1801    "get file information",
1802    "\
1803 Returns file information for the given C<path>.
1804
1805 This is the same as the C<stat(2)> system call.");
1806
1807   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1808    [InitISOFS, Always, TestOutputStruct (
1809       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1810    "get file information for a symbolic link",
1811    "\
1812 Returns file information for the given C<path>.
1813
1814 This is the same as C<guestfs_stat> except that if C<path>
1815 is a symbolic link, then the link is stat-ed, not the file it
1816 refers to.
1817
1818 This is the same as the C<lstat(2)> system call.");
1819
1820   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1821    [InitISOFS, Always, TestOutputStruct (
1822       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1823    "get file system statistics",
1824    "\
1825 Returns file system statistics for any mounted file system.
1826 C<path> should be a file or directory in the mounted file system
1827 (typically it is the mount point itself, but it doesn't need to be).
1828
1829 This is the same as the C<statvfs(2)> system call.");
1830
1831   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1832    [], (* XXX test *)
1833    "get ext2/ext3/ext4 superblock details",
1834    "\
1835 This returns the contents of the ext2, ext3 or ext4 filesystem
1836 superblock on C<device>.
1837
1838 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1839 manpage for more details.  The list of fields returned isn't
1840 clearly defined, and depends on both the version of C<tune2fs>
1841 that libguestfs was built against, and the filesystem itself.");
1842
1843   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1844    [InitEmpty, Always, TestOutputTrue (
1845       [["blockdev_setro"; "/dev/sda"];
1846        ["blockdev_getro"; "/dev/sda"]])],
1847    "set block device to read-only",
1848    "\
1849 Sets the block device named C<device> to read-only.
1850
1851 This uses the L<blockdev(8)> command.");
1852
1853   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1854    [InitEmpty, Always, TestOutputFalse (
1855       [["blockdev_setrw"; "/dev/sda"];
1856        ["blockdev_getro"; "/dev/sda"]])],
1857    "set block device to read-write",
1858    "\
1859 Sets the block device named C<device> to read-write.
1860
1861 This uses the L<blockdev(8)> command.");
1862
1863   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1864    [InitEmpty, Always, TestOutputTrue (
1865       [["blockdev_setro"; "/dev/sda"];
1866        ["blockdev_getro"; "/dev/sda"]])],
1867    "is block device set to read-only",
1868    "\
1869 Returns a boolean indicating if the block device is read-only
1870 (true if read-only, false if not).
1871
1872 This uses the L<blockdev(8)> command.");
1873
1874   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1875    [InitEmpty, Always, TestOutputInt (
1876       [["blockdev_getss"; "/dev/sda"]], 512)],
1877    "get sectorsize of block device",
1878    "\
1879 This returns the size of sectors on a block device.
1880 Usually 512, but can be larger for modern devices.
1881
1882 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1883 for that).
1884
1885 This uses the L<blockdev(8)> command.");
1886
1887   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1888    [InitEmpty, Always, TestOutputInt (
1889       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1890    "get blocksize of block device",
1891    "\
1892 This returns the block size of a device.
1893
1894 (Note this is different from both I<size in blocks> and
1895 I<filesystem block size>).
1896
1897 This uses the L<blockdev(8)> command.");
1898
1899   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1900    [], (* XXX test *)
1901    "set blocksize of block device",
1902    "\
1903 This sets the block size of a device.
1904
1905 (Note this is different from both I<size in blocks> and
1906 I<filesystem block size>).
1907
1908 This uses the L<blockdev(8)> command.");
1909
1910   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1911    [InitEmpty, Always, TestOutputInt (
1912       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1913    "get total size of device in 512-byte sectors",
1914    "\
1915 This returns the size of the device in units of 512-byte sectors
1916 (even if the sectorsize isn't 512 bytes ... weird).
1917
1918 See also C<guestfs_blockdev_getss> for the real sector size of
1919 the device, and C<guestfs_blockdev_getsize64> for the more
1920 useful I<size in bytes>.
1921
1922 This uses the L<blockdev(8)> command.");
1923
1924   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1925    [InitEmpty, Always, TestOutputInt (
1926       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1927    "get total size of device in bytes",
1928    "\
1929 This returns the size of the device in bytes.
1930
1931 See also C<guestfs_blockdev_getsz>.
1932
1933 This uses the L<blockdev(8)> command.");
1934
1935   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1936    [InitEmpty, Always, TestRun
1937       [["blockdev_flushbufs"; "/dev/sda"]]],
1938    "flush device buffers",
1939    "\
1940 This tells the kernel to flush internal buffers associated
1941 with C<device>.
1942
1943 This uses the L<blockdev(8)> command.");
1944
1945   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1946    [InitEmpty, Always, TestRun
1947       [["blockdev_rereadpt"; "/dev/sda"]]],
1948    "reread partition table",
1949    "\
1950 Reread the partition table on C<device>.
1951
1952 This uses the L<blockdev(8)> command.");
1953
1954   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1955    [InitBasicFS, Always, TestOutput (
1956       (* Pick a file from cwd which isn't likely to change. *)
1957       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1958        ["checksum"; "md5"; "/COPYING.LIB"]],
1959       Digest.to_hex (Digest.file "COPYING.LIB"))],
1960    "upload a file from the local machine",
1961    "\
1962 Upload local file C<filename> to C<remotefilename> on the
1963 filesystem.
1964
1965 C<filename> can also be a named pipe.
1966
1967 See also C<guestfs_download>.");
1968
1969   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1970    [InitBasicFS, Always, TestOutput (
1971       (* Pick a file from cwd which isn't likely to change. *)
1972       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1973        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1974        ["upload"; "testdownload.tmp"; "/upload"];
1975        ["checksum"; "md5"; "/upload"]],
1976       Digest.to_hex (Digest.file "COPYING.LIB"))],
1977    "download a file to the local machine",
1978    "\
1979 Download file C<remotefilename> and save it as C<filename>
1980 on the local machine.
1981
1982 C<filename> can also be a named pipe.
1983
1984 See also C<guestfs_upload>, C<guestfs_cat>.");
1985
1986   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1987    [InitISOFS, Always, TestOutput (
1988       [["checksum"; "crc"; "/known-3"]], "2891671662");
1989     InitISOFS, Always, TestLastFail (
1990       [["checksum"; "crc"; "/notexists"]]);
1991     InitISOFS, Always, TestOutput (
1992       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1993     InitISOFS, Always, TestOutput (
1994       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1995     InitISOFS, Always, TestOutput (
1996       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1997     InitISOFS, Always, TestOutput (
1998       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1999     InitISOFS, Always, TestOutput (
2000       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
2001     InitISOFS, Always, TestOutput (
2002       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6");
2003     (* Test for RHBZ#579608, absolute symbolic links. *)
2004     InitISOFS, Always, TestOutput (
2005       [["checksum"; "sha512"; "/abssymlink"]], "5f57d0639bc95081c53afc63a449403883818edc64da48930ad6b1a4fb49be90404686877743fbcd7c99811f3def7df7bc22635c885c6a8cf79c806b43451c1a")],
2006    "compute MD5, SHAx or CRC checksum of file",
2007    "\
2008 This call computes the MD5, SHAx or CRC checksum of the
2009 file named C<path>.
2010
2011 The type of checksum to compute is given by the C<csumtype>
2012 parameter which must have one of the following values:
2013
2014 =over 4
2015
2016 =item C<crc>
2017
2018 Compute the cyclic redundancy check (CRC) specified by POSIX
2019 for the C<cksum> command.
2020
2021 =item C<md5>
2022
2023 Compute the MD5 hash (using the C<md5sum> program).
2024
2025 =item C<sha1>
2026
2027 Compute the SHA1 hash (using the C<sha1sum> program).
2028
2029 =item C<sha224>
2030
2031 Compute the SHA224 hash (using the C<sha224sum> program).
2032
2033 =item C<sha256>
2034
2035 Compute the SHA256 hash (using the C<sha256sum> program).
2036
2037 =item C<sha384>
2038
2039 Compute the SHA384 hash (using the C<sha384sum> program).
2040
2041 =item C<sha512>
2042
2043 Compute the SHA512 hash (using the C<sha512sum> program).
2044
2045 =back
2046
2047 The checksum is returned as a printable string.
2048
2049 To get the checksum for a device, use C<guestfs_checksum_device>.
2050
2051 To get the checksums for many files, use C<guestfs_checksums_out>.");
2052
2053   ("tar_in", (RErr, [FileIn "tarfile"; Pathname "directory"]), 69, [],
2054    [InitBasicFS, Always, TestOutput (
2055       [["tar_in"; "../images/helloworld.tar"; "/"];
2056        ["cat"; "/hello"]], "hello\n")],
2057    "unpack tarfile to directory",
2058    "\
2059 This command uploads and unpacks local file C<tarfile> (an
2060 I<uncompressed> tar file) into C<directory>.
2061
2062 To upload a compressed tarball, use C<guestfs_tgz_in>
2063 or C<guestfs_txz_in>.");
2064
2065   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2066    [],
2067    "pack directory into tarfile",
2068    "\
2069 This command packs the contents of C<directory> and downloads
2070 it to local file C<tarfile>.
2071
2072 To download a compressed tarball, use C<guestfs_tgz_out>
2073 or C<guestfs_txz_out>.");
2074
2075   ("tgz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 71, [],
2076    [InitBasicFS, Always, TestOutput (
2077       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2078        ["cat"; "/hello"]], "hello\n")],
2079    "unpack compressed tarball to directory",
2080    "\
2081 This command uploads and unpacks local file C<tarball> (a
2082 I<gzip compressed> tar file) into C<directory>.
2083
2084 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2085
2086   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2087    [],
2088    "pack directory into compressed tarball",
2089    "\
2090 This command packs the contents of C<directory> and downloads
2091 it to local file C<tarball>.
2092
2093 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2094
2095   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2096    [InitBasicFS, Always, TestLastFail (
2097       [["umount"; "/"];
2098        ["mount_ro"; "/dev/sda1"; "/"];
2099        ["touch"; "/new"]]);
2100     InitBasicFS, Always, TestOutput (
2101       [["write"; "/new"; "data"];
2102        ["umount"; "/"];
2103        ["mount_ro"; "/dev/sda1"; "/"];
2104        ["cat"; "/new"]], "data")],
2105    "mount a guest disk, read-only",
2106    "\
2107 This is the same as the C<guestfs_mount> command, but it
2108 mounts the filesystem with the read-only (I<-o ro>) flag.");
2109
2110   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2111    [],
2112    "mount a guest disk with mount options",
2113    "\
2114 This is the same as the C<guestfs_mount> command, but it
2115 allows you to set the mount options as for the
2116 L<mount(8)> I<-o> flag.
2117
2118 If the C<options> parameter is an empty string, then
2119 no options are passed (all options default to whatever
2120 the filesystem uses).");
2121
2122   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2123    [],
2124    "mount a guest disk with mount options and vfstype",
2125    "\
2126 This is the same as the C<guestfs_mount> command, but it
2127 allows you to set both the mount options and the vfstype
2128 as for the L<mount(8)> I<-o> and I<-t> flags.");
2129
2130   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2131    [],
2132    "debugging and internals",
2133    "\
2134 The C<guestfs_debug> command exposes some internals of
2135 C<guestfsd> (the guestfs daemon) that runs inside the
2136 qemu subprocess.
2137
2138 There is no comprehensive help for this command.  You have
2139 to look at the file C<daemon/debug.c> in the libguestfs source
2140 to find out what you can do.");
2141
2142   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2143    [InitEmpty, Always, TestOutputList (
2144       [["part_disk"; "/dev/sda"; "mbr"];
2145        ["pvcreate"; "/dev/sda1"];
2146        ["vgcreate"; "VG"; "/dev/sda1"];
2147        ["lvcreate"; "LV1"; "VG"; "50"];
2148        ["lvcreate"; "LV2"; "VG"; "50"];
2149        ["lvremove"; "/dev/VG/LV1"];
2150        ["lvs"]], ["/dev/VG/LV2"]);
2151     InitEmpty, Always, TestOutputList (
2152       [["part_disk"; "/dev/sda"; "mbr"];
2153        ["pvcreate"; "/dev/sda1"];
2154        ["vgcreate"; "VG"; "/dev/sda1"];
2155        ["lvcreate"; "LV1"; "VG"; "50"];
2156        ["lvcreate"; "LV2"; "VG"; "50"];
2157        ["lvremove"; "/dev/VG"];
2158        ["lvs"]], []);
2159     InitEmpty, Always, TestOutputList (
2160       [["part_disk"; "/dev/sda"; "mbr"];
2161        ["pvcreate"; "/dev/sda1"];
2162        ["vgcreate"; "VG"; "/dev/sda1"];
2163        ["lvcreate"; "LV1"; "VG"; "50"];
2164        ["lvcreate"; "LV2"; "VG"; "50"];
2165        ["lvremove"; "/dev/VG"];
2166        ["vgs"]], ["VG"])],
2167    "remove an LVM logical volume",
2168    "\
2169 Remove an LVM logical volume C<device>, where C<device> is
2170 the path to the LV, such as C</dev/VG/LV>.
2171
2172 You can also remove all LVs in a volume group by specifying
2173 the VG name, C</dev/VG>.");
2174
2175   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2176    [InitEmpty, Always, TestOutputList (
2177       [["part_disk"; "/dev/sda"; "mbr"];
2178        ["pvcreate"; "/dev/sda1"];
2179        ["vgcreate"; "VG"; "/dev/sda1"];
2180        ["lvcreate"; "LV1"; "VG"; "50"];
2181        ["lvcreate"; "LV2"; "VG"; "50"];
2182        ["vgremove"; "VG"];
2183        ["lvs"]], []);
2184     InitEmpty, Always, TestOutputList (
2185       [["part_disk"; "/dev/sda"; "mbr"];
2186        ["pvcreate"; "/dev/sda1"];
2187        ["vgcreate"; "VG"; "/dev/sda1"];
2188        ["lvcreate"; "LV1"; "VG"; "50"];
2189        ["lvcreate"; "LV2"; "VG"; "50"];
2190        ["vgremove"; "VG"];
2191        ["vgs"]], [])],
2192    "remove an LVM volume group",
2193    "\
2194 Remove an LVM volume group C<vgname>, (for example C<VG>).
2195
2196 This also forcibly removes all logical volumes in the volume
2197 group (if any).");
2198
2199   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
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        ["lvs"]], []);
2209     InitEmpty, Always, TestOutputListOfDevices (
2210       [["part_disk"; "/dev/sda"; "mbr"];
2211        ["pvcreate"; "/dev/sda1"];
2212        ["vgcreate"; "VG"; "/dev/sda1"];
2213        ["lvcreate"; "LV1"; "VG"; "50"];
2214        ["lvcreate"; "LV2"; "VG"; "50"];
2215        ["vgremove"; "VG"];
2216        ["pvremove"; "/dev/sda1"];
2217        ["vgs"]], []);
2218     InitEmpty, Always, TestOutputListOfDevices (
2219       [["part_disk"; "/dev/sda"; "mbr"];
2220        ["pvcreate"; "/dev/sda1"];
2221        ["vgcreate"; "VG"; "/dev/sda1"];
2222        ["lvcreate"; "LV1"; "VG"; "50"];
2223        ["lvcreate"; "LV2"; "VG"; "50"];
2224        ["vgremove"; "VG"];
2225        ["pvremove"; "/dev/sda1"];
2226        ["pvs"]], [])],
2227    "remove an LVM physical volume",
2228    "\
2229 This wipes a physical volume C<device> so that LVM will no longer
2230 recognise it.
2231
2232 The implementation uses the C<pvremove> command which refuses to
2233 wipe physical volumes that contain any volume groups, so you have
2234 to remove those first.");
2235
2236   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2237    [InitBasicFS, Always, TestOutput (
2238       [["set_e2label"; "/dev/sda1"; "testlabel"];
2239        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2240    "set the ext2/3/4 filesystem label",
2241    "\
2242 This sets the ext2/3/4 filesystem label of the filesystem on
2243 C<device> to C<label>.  Filesystem labels are limited to
2244 16 characters.
2245
2246 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2247 to return the existing label on a filesystem.");
2248
2249   ("get_e2label", (RString "label", [Device "device"]), 81, [DeprecatedBy "vfs_label"],
2250    [],
2251    "get the ext2/3/4 filesystem label",
2252    "\
2253 This returns the ext2/3/4 filesystem label of the filesystem on
2254 C<device>.");
2255
2256   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2257    (let uuid = uuidgen () in
2258     [InitBasicFS, Always, TestOutput (
2259        [["set_e2uuid"; "/dev/sda1"; uuid];
2260         ["get_e2uuid"; "/dev/sda1"]], uuid);
2261      InitBasicFS, Always, TestOutput (
2262        [["set_e2uuid"; "/dev/sda1"; "clear"];
2263         ["get_e2uuid"; "/dev/sda1"]], "");
2264      (* We can't predict what UUIDs will be, so just check the commands run. *)
2265      InitBasicFS, Always, TestRun (
2266        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2267      InitBasicFS, Always, TestRun (
2268        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2269    "set the ext2/3/4 filesystem UUID",
2270    "\
2271 This sets the ext2/3/4 filesystem UUID of the filesystem on
2272 C<device> to C<uuid>.  The format of the UUID and alternatives
2273 such as C<clear>, C<random> and C<time> are described in the
2274 L<tune2fs(8)> manpage.
2275
2276 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2277 to return the existing UUID of a filesystem.");
2278
2279   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [DeprecatedBy "vfs_uuid"],
2280    (* Regression test for RHBZ#597112. *)
2281    (let uuid = uuidgen () in
2282     [InitBasicFS, Always, TestOutput (
2283        [["mke2journal"; "1024"; "/dev/sdb"];
2284         ["set_e2uuid"; "/dev/sdb"; uuid];
2285         ["get_e2uuid"; "/dev/sdb"]], uuid)]),
2286    "get the ext2/3/4 filesystem UUID",
2287    "\
2288 This returns the ext2/3/4 filesystem UUID of the filesystem on
2289 C<device>.");
2290
2291   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [FishOutput FishOutputHexadecimal],
2292    [InitBasicFS, Always, TestOutputInt (
2293       [["umount"; "/dev/sda1"];
2294        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2295     InitBasicFS, Always, TestOutputInt (
2296       [["umount"; "/dev/sda1"];
2297        ["zero"; "/dev/sda1"];
2298        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2299    "run the filesystem checker",
2300    "\
2301 This runs the filesystem checker (fsck) on C<device> which
2302 should have filesystem type C<fstype>.
2303
2304 The returned integer is the status.  See L<fsck(8)> for the
2305 list of status codes from C<fsck>.
2306
2307 Notes:
2308
2309 =over 4
2310
2311 =item *
2312
2313 Multiple status codes can be summed together.
2314
2315 =item *
2316
2317 A non-zero return code can mean \"success\", for example if
2318 errors have been corrected on the filesystem.
2319
2320 =item *
2321
2322 Checking or repairing NTFS volumes is not supported
2323 (by linux-ntfs).
2324
2325 =back
2326
2327 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2328
2329   ("zero", (RErr, [Device "device"]), 85, [],
2330    [InitBasicFS, Always, TestOutput (
2331       [["umount"; "/dev/sda1"];
2332        ["zero"; "/dev/sda1"];
2333        ["file"; "/dev/sda1"]], "data")],
2334    "write zeroes to the device",
2335    "\
2336 This command writes zeroes over the first few blocks of C<device>.
2337
2338 How many blocks are zeroed isn't specified (but it's I<not> enough
2339 to securely wipe the device).  It should be sufficient to remove
2340 any partition tables, filesystem superblocks and so on.
2341
2342 See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
2343
2344   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2345    (* See:
2346     * https://bugzilla.redhat.com/show_bug.cgi?id=484986
2347     * https://bugzilla.redhat.com/show_bug.cgi?id=479760
2348     *)
2349    [InitBasicFS, Always, TestOutputTrue (
2350       [["mkdir_p"; "/boot/grub"];
2351        ["write"; "/boot/grub/device.map"; "(hd0) /dev/vda"];
2352        ["grub_install"; "/"; "/dev/vda"];
2353        ["is_dir"; "/boot"]])],
2354    "install GRUB",
2355    "\
2356 This command installs GRUB (the Grand Unified Bootloader) on
2357 C<device>, with the root directory being C<root>.
2358
2359 Note: If grub-install reports the error
2360 \"No suitable drive was found in the generated device map.\"
2361 it may be that you need to create a C</boot/grub/device.map>
2362 file first that contains the mapping between grub device names
2363 and Linux device names.  It is usually sufficient to create
2364 a file containing:
2365
2366  (hd0) /dev/vda
2367
2368 replacing C</dev/vda> with the name of the installation device.");
2369
2370   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2371    [InitBasicFS, Always, TestOutput (
2372       [["write"; "/old"; "file content"];
2373        ["cp"; "/old"; "/new"];
2374        ["cat"; "/new"]], "file content");
2375     InitBasicFS, Always, TestOutputTrue (
2376       [["write"; "/old"; "file content"];
2377        ["cp"; "/old"; "/new"];
2378        ["is_file"; "/old"]]);
2379     InitBasicFS, Always, TestOutput (
2380       [["write"; "/old"; "file content"];
2381        ["mkdir"; "/dir"];
2382        ["cp"; "/old"; "/dir/new"];
2383        ["cat"; "/dir/new"]], "file content")],
2384    "copy a file",
2385    "\
2386 This copies a file from C<src> to C<dest> where C<dest> is
2387 either a destination filename or destination directory.");
2388
2389   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2390    [InitBasicFS, Always, TestOutput (
2391       [["mkdir"; "/olddir"];
2392        ["mkdir"; "/newdir"];
2393        ["write"; "/olddir/file"; "file content"];
2394        ["cp_a"; "/olddir"; "/newdir"];
2395        ["cat"; "/newdir/olddir/file"]], "file content")],
2396    "copy a file or directory recursively",
2397    "\
2398 This copies a file or directory from C<src> to C<dest>
2399 recursively using the C<cp -a> command.");
2400
2401   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2402    [InitBasicFS, Always, TestOutput (
2403       [["write"; "/old"; "file content"];
2404        ["mv"; "/old"; "/new"];
2405        ["cat"; "/new"]], "file content");
2406     InitBasicFS, Always, TestOutputFalse (
2407       [["write"; "/old"; "file content"];
2408        ["mv"; "/old"; "/new"];
2409        ["is_file"; "/old"]])],
2410    "move a file",
2411    "\
2412 This moves a file from C<src> to C<dest> where C<dest> is
2413 either a destination filename or destination directory.");
2414
2415   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2416    [InitEmpty, Always, TestRun (
2417       [["drop_caches"; "3"]])],
2418    "drop kernel page cache, dentries and inodes",
2419    "\
2420 This instructs the guest kernel to drop its page cache,
2421 and/or dentries and inode caches.  The parameter C<whattodrop>
2422 tells the kernel what precisely to drop, see
2423 L<http://linux-mm.org/Drop_Caches>
2424
2425 Setting C<whattodrop> to 3 should drop everything.
2426
2427 This automatically calls L<sync(2)> before the operation,
2428 so that the maximum guest memory is freed.");
2429
2430   ("dmesg", (RString "kmsgs", []), 91, [],
2431    [InitEmpty, Always, TestRun (
2432       [["dmesg"]])],
2433    "return kernel messages",
2434    "\
2435 This returns the kernel messages (C<dmesg> output) from
2436 the guest kernel.  This is sometimes useful for extended
2437 debugging of problems.
2438
2439 Another way to get the same information is to enable
2440 verbose messages with C<guestfs_set_verbose> or by setting
2441 the environment variable C<LIBGUESTFS_DEBUG=1> before
2442 running the program.");
2443
2444   ("ping_daemon", (RErr, []), 92, [],
2445    [InitEmpty, Always, TestRun (
2446       [["ping_daemon"]])],
2447    "ping the guest daemon",
2448    "\
2449 This is a test probe into the guestfs daemon running inside
2450 the qemu subprocess.  Calling this function checks that the
2451 daemon responds to the ping message, without affecting the daemon
2452 or attached block device(s) in any other way.");
2453
2454   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2455    [InitBasicFS, Always, TestOutputTrue (
2456       [["write"; "/file1"; "contents of a file"];
2457        ["cp"; "/file1"; "/file2"];
2458        ["equal"; "/file1"; "/file2"]]);
2459     InitBasicFS, Always, TestOutputFalse (
2460       [["write"; "/file1"; "contents of a file"];
2461        ["write"; "/file2"; "contents of another file"];
2462        ["equal"; "/file1"; "/file2"]]);
2463     InitBasicFS, Always, TestLastFail (
2464       [["equal"; "/file1"; "/file2"]])],
2465    "test if two files have equal contents",
2466    "\
2467 This compares the two files C<file1> and C<file2> and returns
2468 true if their content is exactly equal, or false otherwise.
2469
2470 The external L<cmp(1)> program is used for the comparison.");
2471
2472   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2473    [InitISOFS, Always, TestOutputList (
2474       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2475     InitISOFS, Always, TestOutputList (
2476       [["strings"; "/empty"]], []);
2477     (* Test for RHBZ#579608, absolute symbolic links. *)
2478     InitISOFS, Always, TestRun (
2479       [["strings"; "/abssymlink"]])],
2480    "print the printable strings in a file",
2481    "\
2482 This runs the L<strings(1)> command on a file and returns
2483 the list of printable strings found.");
2484
2485   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2486    [InitISOFS, Always, TestOutputList (
2487       [["strings_e"; "b"; "/known-5"]], []);
2488     InitBasicFS, Always, TestOutputList (
2489       [["write"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"];
2490        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2491    "print the printable strings in a file",
2492    "\
2493 This is like the C<guestfs_strings> command, but allows you to
2494 specify the encoding of strings that are looked for in
2495 the source file C<path>.
2496
2497 Allowed encodings are:
2498
2499 =over 4
2500
2501 =item s
2502
2503 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2504 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2505
2506 =item S
2507
2508 Single 8-bit-byte characters.
2509
2510 =item b
2511
2512 16-bit big endian strings such as those encoded in
2513 UTF-16BE or UCS-2BE.
2514
2515 =item l (lower case letter L)
2516
2517 16-bit little endian such as UTF-16LE and UCS-2LE.
2518 This is useful for examining binaries in Windows guests.
2519
2520 =item B
2521
2522 32-bit big endian such as UCS-4BE.
2523
2524 =item L
2525
2526 32-bit little endian such as UCS-4LE.
2527
2528 =back
2529
2530 The returned strings are transcoded to UTF-8.");
2531
2532   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2533    [InitISOFS, Always, TestOutput (
2534       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2535     (* Test for RHBZ#501888c2 regression which caused large hexdump
2536      * commands to segfault.
2537      *)
2538     InitISOFS, Always, TestRun (
2539       [["hexdump"; "/100krandom"]]);
2540     (* Test for RHBZ#579608, absolute symbolic links. *)
2541     InitISOFS, Always, TestRun (
2542       [["hexdump"; "/abssymlink"]])],
2543    "dump a file in hexadecimal",
2544    "\
2545 This runs C<hexdump -C> on the given C<path>.  The result is
2546 the human-readable, canonical hex dump of the file.");
2547
2548   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2549    [InitNone, Always, TestOutput (
2550       [["part_disk"; "/dev/sda"; "mbr"];
2551        ["mkfs"; "ext3"; "/dev/sda1"];
2552        ["mount_options"; ""; "/dev/sda1"; "/"];
2553        ["write"; "/new"; "test file"];
2554        ["umount"; "/dev/sda1"];
2555        ["zerofree"; "/dev/sda1"];
2556        ["mount_options"; ""; "/dev/sda1"; "/"];
2557        ["cat"; "/new"]], "test file")],
2558    "zero unused inodes and disk blocks on ext2/3 filesystem",
2559    "\
2560 This runs the I<zerofree> program on C<device>.  This program
2561 claims to zero unused inodes and disk blocks on an ext2/3
2562 filesystem, thus making it possible to compress the filesystem
2563 more effectively.
2564
2565 You should B<not> run this program if the filesystem is
2566 mounted.
2567
2568 It is possible that using this program can damage the filesystem
2569 or data on the filesystem.");
2570
2571   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2572    [],
2573    "resize an LVM physical volume",
2574    "\
2575 This resizes (expands or shrinks) an existing LVM physical
2576 volume to match the new size of the underlying device.");
2577
2578   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2579                        Int "cyls"; Int "heads"; Int "sectors";
2580                        String "line"]), 99, [DangerWillRobinson],
2581    [],
2582    "modify a single partition on a block device",
2583    "\
2584 This runs L<sfdisk(8)> option to modify just the single
2585 partition C<n> (note: C<n> counts from 1).
2586
2587 For other parameters, see C<guestfs_sfdisk>.  You should usually
2588 pass C<0> for the cyls/heads/sectors parameters.
2589
2590 See also: C<guestfs_part_add>");
2591
2592   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2593    [],
2594    "display the partition table",
2595    "\
2596 This displays the partition table on C<device>, in the
2597 human-readable output of the L<sfdisk(8)> command.  It is
2598 not intended to be parsed.
2599
2600 See also: C<guestfs_part_list>");
2601
2602   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2603    [],
2604    "display the kernel geometry",
2605    "\
2606 This displays the kernel's idea of the geometry of C<device>.
2607
2608 The result is in human-readable format, and not designed to
2609 be parsed.");
2610
2611   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2612    [],
2613    "display the disk geometry from the partition table",
2614    "\
2615 This displays the disk geometry of C<device> read from the
2616 partition table.  Especially in the case where the underlying
2617 block device has been resized, this can be different from the
2618 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2619
2620 The result is in human-readable format, and not designed to
2621 be parsed.");
2622
2623   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2624    [],
2625    "activate or deactivate all volume groups",
2626    "\
2627 This command activates or (if C<activate> is false) deactivates
2628 all logical volumes in all volume groups.
2629 If activated, then they are made known to the
2630 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2631 then those devices disappear.
2632
2633 This command is the same as running C<vgchange -a y|n>");
2634
2635   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2636    [],
2637    "activate or deactivate some volume groups",
2638    "\
2639 This command activates or (if C<activate> is false) deactivates
2640 all logical volumes in the listed volume groups C<volgroups>.
2641 If activated, then they are made known to the
2642 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2643 then those devices disappear.
2644
2645 This command is the same as running C<vgchange -a y|n volgroups...>
2646
2647 Note that if C<volgroups> is an empty list then B<all> volume groups
2648 are activated or deactivated.");
2649
2650   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2651    [InitNone, Always, TestOutput (
2652       [["part_disk"; "/dev/sda"; "mbr"];
2653        ["pvcreate"; "/dev/sda1"];
2654        ["vgcreate"; "VG"; "/dev/sda1"];
2655        ["lvcreate"; "LV"; "VG"; "10"];
2656        ["mkfs"; "ext2"; "/dev/VG/LV"];
2657        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2658        ["write"; "/new"; "test content"];
2659        ["umount"; "/"];
2660        ["lvresize"; "/dev/VG/LV"; "20"];
2661        ["e2fsck_f"; "/dev/VG/LV"];
2662        ["resize2fs"; "/dev/VG/LV"];
2663        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2664        ["cat"; "/new"]], "test content");
2665     InitNone, Always, TestRun (
2666       (* Make an LV smaller to test RHBZ#587484. *)
2667       [["part_disk"; "/dev/sda"; "mbr"];
2668        ["pvcreate"; "/dev/sda1"];
2669        ["vgcreate"; "VG"; "/dev/sda1"];
2670        ["lvcreate"; "LV"; "VG"; "20"];
2671        ["lvresize"; "/dev/VG/LV"; "10"]])],
2672    "resize an LVM logical volume",
2673    "\
2674 This resizes (expands or shrinks) an existing LVM logical
2675 volume to C<mbytes>.  When reducing, data in the reduced part
2676 is lost.");
2677
2678   ("resize2fs", (RErr, [Device "device"]), 106, [],
2679    [], (* lvresize tests this *)
2680    "resize an ext2, ext3 or ext4 filesystem",
2681    "\
2682 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2683 the underlying device.
2684
2685 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2686 on the C<device> before calling this command.  For unknown reasons
2687 C<resize2fs> sometimes gives an error about this and sometimes not.
2688 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2689 calling this function.");
2690
2691   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2692    [InitBasicFS, Always, TestOutputList (
2693       [["find"; "/"]], ["lost+found"]);
2694     InitBasicFS, Always, TestOutputList (
2695       [["touch"; "/a"];
2696        ["mkdir"; "/b"];
2697        ["touch"; "/b/c"];
2698        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2699     InitBasicFS, Always, TestOutputList (
2700       [["mkdir_p"; "/a/b/c"];
2701        ["touch"; "/a/b/c/d"];
2702        ["find"; "/a/b/"]], ["c"; "c/d"])],
2703    "find all files and directories",
2704    "\
2705 This command lists out all files and directories, recursively,
2706 starting at C<directory>.  It is essentially equivalent to
2707 running the shell command C<find directory -print> but some
2708 post-processing happens on the output, described below.
2709
2710 This returns a list of strings I<without any prefix>.  Thus
2711 if the directory structure was:
2712
2713  /tmp/a
2714  /tmp/b
2715  /tmp/c/d
2716
2717 then the returned list from C<guestfs_find> C</tmp> would be
2718 4 elements:
2719
2720  a
2721  b
2722  c
2723  c/d
2724
2725 If C<directory> is not a directory, then this command returns
2726 an error.
2727
2728 The returned list is sorted.
2729
2730 See also C<guestfs_find0>.");
2731
2732   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2733    [], (* lvresize tests this *)
2734    "check an ext2/ext3 filesystem",
2735    "\
2736 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2737 filesystem checker on C<device>, noninteractively (C<-p>),
2738 even if the filesystem appears to be clean (C<-f>).
2739
2740 This command is only needed because of C<guestfs_resize2fs>
2741 (q.v.).  Normally you should use C<guestfs_fsck>.");
2742
2743   ("sleep", (RErr, [Int "secs"]), 109, [],
2744    [InitNone, Always, TestRun (
2745       [["sleep"; "1"]])],
2746    "sleep for some seconds",
2747    "\
2748 Sleep for C<secs> seconds.");
2749
2750   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2751    [InitNone, Always, TestOutputInt (
2752       [["part_disk"; "/dev/sda"; "mbr"];
2753        ["mkfs"; "ntfs"; "/dev/sda1"];
2754        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2755     InitNone, Always, TestOutputInt (
2756       [["part_disk"; "/dev/sda"; "mbr"];
2757        ["mkfs"; "ext2"; "/dev/sda1"];
2758        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2759    "probe NTFS volume",
2760    "\
2761 This command runs the L<ntfs-3g.probe(8)> command which probes
2762 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2763 be mounted read-write, and some cannot be mounted at all).
2764
2765 C<rw> is a boolean flag.  Set it to true if you want to test
2766 if the volume can be mounted read-write.  Set it to false if
2767 you want to test if the volume can be mounted read-only.
2768
2769 The return value is an integer which C<0> if the operation
2770 would succeed, or some non-zero value documented in the
2771 L<ntfs-3g.probe(8)> manual page.");
2772
2773   ("sh", (RString "output", [String "command"]), 111, [],
2774    [], (* XXX needs tests *)
2775    "run a command via the shell",
2776    "\
2777 This call runs a command from the guest filesystem via the
2778 guest's C</bin/sh>.
2779
2780 This is like C<guestfs_command>, but passes the command to:
2781
2782  /bin/sh -c \"command\"
2783
2784 Depending on the guest's shell, this usually results in
2785 wildcards being expanded, shell expressions being interpolated
2786 and so on.
2787
2788 All the provisos about C<guestfs_command> apply to this call.");
2789
2790   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2791    [], (* XXX needs tests *)
2792    "run a command via the shell returning lines",
2793    "\
2794 This is the same as C<guestfs_sh>, but splits the result
2795 into a list of lines.
2796
2797 See also: C<guestfs_command_lines>");
2798
2799   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2800    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2801     * code in stubs.c, since all valid glob patterns must start with "/".
2802     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2803     *)
2804    [InitBasicFS, Always, TestOutputList (
2805       [["mkdir_p"; "/a/b/c"];
2806        ["touch"; "/a/b/c/d"];
2807        ["touch"; "/a/b/c/e"];
2808        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2809     InitBasicFS, Always, TestOutputList (
2810       [["mkdir_p"; "/a/b/c"];
2811        ["touch"; "/a/b/c/d"];
2812        ["touch"; "/a/b/c/e"];
2813        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2814     InitBasicFS, Always, TestOutputList (
2815       [["mkdir_p"; "/a/b/c"];
2816        ["touch"; "/a/b/c/d"];
2817        ["touch"; "/a/b/c/e"];
2818        ["glob_expand"; "/a/*/x/*"]], [])],
2819    "expand a wildcard path",
2820    "\
2821 This command searches for all the pathnames matching
2822 C<pattern> according to the wildcard expansion rules
2823 used by the shell.
2824
2825 If no paths match, then this returns an empty list
2826 (note: not an error).
2827
2828 It is just a wrapper around the C L<glob(3)> function
2829 with flags C<GLOB_MARK|GLOB_BRACE>.
2830 See that manual page for more details.");
2831
2832   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2833    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2834       [["scrub_device"; "/dev/sdc"]])],
2835    "scrub (securely wipe) a device",
2836    "\
2837 This command writes patterns over C<device> to make data retrieval
2838 more difficult.
2839
2840 It is an interface to the L<scrub(1)> program.  See that
2841 manual page for more details.");
2842
2843   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2844    [InitBasicFS, Always, TestRun (
2845       [["write"; "/file"; "content"];
2846        ["scrub_file"; "/file"]])],
2847    "scrub (securely wipe) a file",
2848    "\
2849 This command writes patterns over a file to make data retrieval
2850 more difficult.
2851
2852 The file is I<removed> after scrubbing.
2853
2854 It is an interface to the L<scrub(1)> program.  See that
2855 manual page for more details.");
2856
2857   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2858    [], (* XXX needs testing *)
2859    "scrub (securely wipe) free space",
2860    "\
2861 This command creates the directory C<dir> and then fills it
2862 with files until the filesystem is full, and scrubs the files
2863 as for C<guestfs_scrub_file>, and deletes them.
2864 The intention is to scrub any free space on the partition
2865 containing C<dir>.
2866
2867 It is an interface to the L<scrub(1)> program.  See that
2868 manual page for more details.");
2869
2870   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2871    [InitBasicFS, Always, TestRun (
2872       [["mkdir"; "/tmp"];
2873        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2874    "create a temporary directory",
2875    "\
2876 This command creates a temporary directory.  The
2877 C<template> parameter should be a full pathname for the
2878 temporary directory name with the final six characters being
2879 \"XXXXXX\".
2880
2881 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2882 the second one being suitable for Windows filesystems.
2883
2884 The name of the temporary directory that was created
2885 is returned.
2886
2887 The temporary directory is created with mode 0700
2888 and is owned by root.
2889
2890 The caller is responsible for deleting the temporary
2891 directory and its contents after use.
2892
2893 See also: L<mkdtemp(3)>");
2894
2895   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2896    [InitISOFS, Always, TestOutputInt (
2897       [["wc_l"; "/10klines"]], 10000);
2898     (* Test for RHBZ#579608, absolute symbolic links. *)
2899     InitISOFS, Always, TestOutputInt (
2900       [["wc_l"; "/abssymlink"]], 10000)],
2901    "count lines in a file",
2902    "\
2903 This command counts the lines in a file, using the
2904 C<wc -l> external command.");
2905
2906   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2907    [InitISOFS, Always, TestOutputInt (
2908       [["wc_w"; "/10klines"]], 10000)],
2909    "count words in a file",
2910    "\
2911 This command counts the words in a file, using the
2912 C<wc -w> external command.");
2913
2914   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2915    [InitISOFS, Always, TestOutputInt (
2916       [["wc_c"; "/100kallspaces"]], 102400)],
2917    "count characters in a file",
2918    "\
2919 This command counts the characters in a file, using the
2920 C<wc -c> external command.");
2921
2922   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2923    [InitISOFS, Always, TestOutputList (
2924       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"]);
2925     (* Test for RHBZ#579608, absolute symbolic links. *)
2926     InitISOFS, Always, TestOutputList (
2927       [["head"; "/abssymlink"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2928    "return first 10 lines of a file",
2929    "\
2930 This command returns up to the first 10 lines of a file as
2931 a list of strings.");
2932
2933   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2934    [InitISOFS, Always, TestOutputList (
2935       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2936     InitISOFS, Always, TestOutputList (
2937       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2938     InitISOFS, Always, TestOutputList (
2939       [["head_n"; "0"; "/10klines"]], [])],
2940    "return first N lines of a file",
2941    "\
2942 If the parameter C<nrlines> is a positive number, this returns the first
2943 C<nrlines> lines of the file C<path>.
2944
2945 If the parameter C<nrlines> is a negative number, this returns lines
2946 from the file C<path>, excluding the last C<nrlines> lines.
2947
2948 If the parameter C<nrlines> is zero, this returns an empty list.");
2949
2950   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2951    [InitISOFS, Always, TestOutputList (
2952       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2953    "return last 10 lines of a file",
2954    "\
2955 This command returns up to the last 10 lines of a file as
2956 a list of strings.");
2957
2958   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2959    [InitISOFS, Always, TestOutputList (
2960       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2961     InitISOFS, Always, TestOutputList (
2962       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2963     InitISOFS, Always, TestOutputList (
2964       [["tail_n"; "0"; "/10klines"]], [])],
2965    "return last N lines of a file",
2966    "\
2967 If the parameter C<nrlines> is a positive number, this returns the last
2968 C<nrlines> lines of the file C<path>.
2969
2970 If the parameter C<nrlines> is a negative number, this returns lines
2971 from the file C<path>, starting with the C<-nrlines>th line.
2972
2973 If the parameter C<nrlines> is zero, this returns an empty list.");
2974
2975   ("df", (RString "output", []), 125, [],
2976    [], (* XXX Tricky to test because it depends on the exact format
2977         * of the 'df' command and other imponderables.
2978         *)
2979    "report file system disk space usage",
2980    "\
2981 This command runs the C<df> command to report disk space used.
2982
2983 This command is mostly useful for interactive sessions.  It
2984 is I<not> intended that you try to parse the output string.
2985 Use C<statvfs> from programs.");
2986
2987   ("df_h", (RString "output", []), 126, [],
2988    [], (* XXX Tricky to test because it depends on the exact format
2989         * of the 'df' command and other imponderables.
2990         *)
2991    "report file system disk space usage (human readable)",
2992    "\
2993 This command runs the C<df -h> command to report disk space used
2994 in human-readable format.
2995
2996 This command is mostly useful for interactive sessions.  It
2997 is I<not> intended that you try to parse the output string.
2998 Use C<statvfs> from programs.");
2999
3000   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
3001    [InitISOFS, Always, TestOutputInt (
3002       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
3003    "estimate file space usage",
3004    "\
3005 This command runs the C<du -s> command to estimate file space
3006 usage for C<path>.
3007
3008 C<path> can be a file or a directory.  If C<path> is a directory
3009 then the estimate includes the contents of the directory and all
3010 subdirectories (recursively).
3011
3012 The result is the estimated size in I<kilobytes>
3013 (ie. units of 1024 bytes).");
3014
3015   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
3016    [InitISOFS, Always, TestOutputList (
3017       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
3018    "list files in an initrd",
3019    "\
3020 This command lists out files contained in an initrd.
3021
3022 The files are listed without any initial C</> character.  The
3023 files are listed in the order they appear (not necessarily
3024 alphabetical).  Directory names are listed as separate items.
3025
3026 Old Linux kernels (2.4 and earlier) used a compressed ext2
3027 filesystem as initrd.  We I<only> support the newer initramfs
3028 format (compressed cpio files).");
3029
3030   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
3031    [],
3032    "mount a file using the loop device",
3033    "\
3034 This command lets you mount C<file> (a filesystem image
3035 in a file) on a mount point.  It is entirely equivalent to
3036 the command C<mount -o loop file mountpoint>.");
3037
3038   ("mkswap", (RErr, [Device "device"]), 130, [],
3039    [InitEmpty, Always, TestRun (
3040       [["part_disk"; "/dev/sda"; "mbr"];
3041        ["mkswap"; "/dev/sda1"]])],
3042    "create a swap partition",
3043    "\
3044 Create a swap partition on C<device>.");
3045
3046   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3047    [InitEmpty, Always, TestRun (
3048       [["part_disk"; "/dev/sda"; "mbr"];
3049        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3050    "create a swap partition with a label",
3051    "\
3052 Create a swap partition on C<device> with label C<label>.
3053
3054 Note that you cannot attach a swap label to a block device
3055 (eg. C</dev/sda>), just to a partition.  This appears to be
3056 a limitation of the kernel or swap tools.");
3057
3058   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3059    (let uuid = uuidgen () in
3060     [InitEmpty, Always, TestRun (
3061        [["part_disk"; "/dev/sda"; "mbr"];
3062         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3063    "create a swap partition with an explicit UUID",
3064    "\
3065 Create a swap partition on C<device> with UUID C<uuid>.");
3066
3067   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3068    [InitBasicFS, Always, TestOutputStruct (
3069       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3070        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3071        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3072     InitBasicFS, Always, TestOutputStruct (
3073       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3074        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3075    "make block, character or FIFO devices",
3076    "\
3077 This call creates block or character special devices, or
3078 named pipes (FIFOs).
3079
3080 The C<mode> parameter should be the mode, using the standard
3081 constants.  C<devmajor> and C<devminor> are the
3082 device major and minor numbers, only used when creating block
3083 and character special devices.
3084
3085 Note that, just like L<mknod(2)>, the mode must be bitwise
3086 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3087 just creates a regular file).  These constants are
3088 available in the standard Linux header files, or you can use
3089 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3090 which are wrappers around this command which bitwise OR
3091 in the appropriate constant for you.
3092
3093 The mode actually set is affected by the umask.");
3094
3095   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3096    [InitBasicFS, Always, TestOutputStruct (
3097       [["mkfifo"; "0o777"; "/node"];
3098        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3099    "make FIFO (named pipe)",
3100    "\
3101 This call creates a FIFO (named pipe) called C<path> with
3102 mode C<mode>.  It is just a convenient wrapper around
3103 C<guestfs_mknod>.
3104
3105 The mode actually set is affected by the umask.");
3106
3107   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3108    [InitBasicFS, Always, TestOutputStruct (
3109       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3110        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3111    "make block device node",
3112    "\
3113 This call creates a block device node called C<path> with
3114 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3115 It is just a convenient wrapper around C<guestfs_mknod>.
3116
3117 The mode actually set is affected by the umask.");
3118
3119   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3120    [InitBasicFS, Always, TestOutputStruct (
3121       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3122        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3123    "make char device node",
3124    "\
3125 This call creates a char device node called C<path> with
3126 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3127 It is just a convenient wrapper around C<guestfs_mknod>.
3128
3129 The mode actually set is affected by the umask.");
3130
3131   ("umask", (RInt "oldmask", [Int "mask"]), 137, [FishOutput FishOutputOctal],
3132    [InitEmpty, Always, TestOutputInt (
3133       [["umask"; "0o22"]], 0o22)],
3134    "set file mode creation mask (umask)",
3135    "\
3136 This function sets the mask used for creating new files and
3137 device nodes to C<mask & 0777>.
3138
3139 Typical umask values would be C<022> which creates new files
3140 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3141 C<002> which creates new files with permissions like
3142 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3143
3144 The default umask is C<022>.  This is important because it
3145 means that directories and device nodes will be created with
3146 C<0644> or C<0755> mode even if you specify C<0777>.
3147
3148 See also C<guestfs_get_umask>,
3149 L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3150
3151 This call returns the previous umask.");
3152
3153   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3154    [],
3155    "read directories entries",
3156    "\
3157 This returns the list of directory entries in directory C<dir>.
3158
3159 All entries in the directory are returned, including C<.> and
3160 C<..>.  The entries are I<not> sorted, but returned in the same
3161 order as the underlying filesystem.
3162
3163 Also this call returns basic file type information about each
3164 file.  The C<ftyp> field will contain one of the following characters:
3165
3166 =over 4
3167
3168 =item 'b'
3169
3170 Block special
3171
3172 =item 'c'
3173
3174 Char special
3175
3176 =item 'd'
3177
3178 Directory
3179
3180 =item 'f'
3181
3182 FIFO (named pipe)
3183
3184 =item 'l'
3185
3186 Symbolic link
3187
3188 =item 'r'
3189
3190 Regular file
3191
3192 =item 's'
3193
3194 Socket
3195
3196 =item 'u'
3197
3198 Unknown file type
3199
3200 =item '?'
3201
3202 The L<readdir(3)> call returned a C<d_type> field with an
3203 unexpected value
3204
3205 =back
3206
3207 This function is primarily intended for use by programs.  To
3208 get a simple list of names, use C<guestfs_ls>.  To get a printable
3209 directory for human consumption, use C<guestfs_ll>.");
3210
3211   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3212    [],
3213    "create partitions on a block device",
3214    "\
3215 This is a simplified interface to the C<guestfs_sfdisk>
3216 command, where partition sizes are specified in megabytes
3217 only (rounded to the nearest cylinder) and you don't need
3218 to specify the cyls, heads and sectors parameters which
3219 were rarely if ever used anyway.
3220
3221 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3222 and C<guestfs_part_disk>");
3223
3224   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3225    [],
3226    "determine file type inside a compressed file",
3227    "\
3228 This command runs C<file> after first decompressing C<path>
3229 using C<method>.
3230
3231 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3232
3233 Since 1.0.63, use C<guestfs_file> instead which can now
3234 process compressed files.");
3235
3236   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3237    [],
3238    "list extended attributes of a file or directory",
3239    "\
3240 This call lists the extended attributes of the file or directory
3241 C<path>.
3242
3243 At the system call level, this is a combination of the
3244 L<listxattr(2)> and L<getxattr(2)> calls.
3245
3246 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3247
3248   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3249    [],
3250    "list extended attributes of a file or directory",
3251    "\
3252 This is the same as C<guestfs_getxattrs>, but if C<path>
3253 is a symbolic link, then it returns the extended attributes
3254 of the link itself.");
3255
3256   ("setxattr", (RErr, [String "xattr";
3257                        String "val"; Int "vallen"; (* will be BufferIn *)
3258                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3259    [],
3260    "set extended attribute of a file or directory",
3261    "\
3262 This call sets the extended attribute named C<xattr>
3263 of the file C<path> to the value C<val> (of length C<vallen>).
3264 The value is arbitrary 8 bit data.
3265
3266 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3267
3268   ("lsetxattr", (RErr, [String "xattr";
3269                         String "val"; Int "vallen"; (* will be BufferIn *)
3270                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3271    [],
3272    "set extended attribute of a file or directory",
3273    "\
3274 This is the same as C<guestfs_setxattr>, but if C<path>
3275 is a symbolic link, then it sets an extended attribute
3276 of the link itself.");
3277
3278   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3279    [],
3280    "remove extended attribute of a file or directory",
3281    "\
3282 This call removes the extended attribute named C<xattr>
3283 of the file C<path>.
3284
3285 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3286
3287   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3288    [],
3289    "remove extended attribute of a file or directory",
3290    "\
3291 This is the same as C<guestfs_removexattr>, but if C<path>
3292 is a symbolic link, then it removes an extended attribute
3293 of the link itself.");
3294
3295   ("mountpoints", (RHashtable "mps", []), 147, [],
3296    [],
3297    "show mountpoints",
3298    "\
3299 This call is similar to C<guestfs_mounts>.  That call returns
3300 a list of devices.  This one returns a hash table (map) of
3301 device name to directory where the device is mounted.");
3302
3303   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3304    (* This is a special case: while you would expect a parameter
3305     * of type "Pathname", that doesn't work, because it implies
3306     * NEED_ROOT in the generated calling code in stubs.c, and
3307     * this function cannot use NEED_ROOT.
3308     *)
3309    [],
3310    "create a mountpoint",
3311    "\
3312 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3313 specialized calls that can be used to create extra mountpoints
3314 before mounting the first filesystem.
3315
3316 These calls are I<only> necessary in some very limited circumstances,
3317 mainly the case where you want to mount a mix of unrelated and/or
3318 read-only filesystems together.
3319
3320 For example, live CDs often contain a \"Russian doll\" nest of
3321 filesystems, an ISO outer layer, with a squashfs image inside, with
3322 an ext2/3 image inside that.  You can unpack this as follows
3323 in guestfish:
3324
3325  add-ro Fedora-11-i686-Live.iso
3326  run
3327  mkmountpoint /cd
3328  mkmountpoint /squash
3329  mkmountpoint /ext3
3330  mount /dev/sda /cd
3331  mount-loop /cd/LiveOS/squashfs.img /squash
3332  mount-loop /squash/LiveOS/ext3fs.img /ext3
3333
3334 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3335
3336   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3337    [],
3338    "remove a mountpoint",
3339    "\
3340 This calls removes a mountpoint that was previously created
3341 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3342 for full details.");
3343
3344   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3345    [InitISOFS, Always, TestOutputBuffer (
3346       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3347     (* Test various near large, large and too large files (RHBZ#589039). *)
3348     InitBasicFS, Always, TestLastFail (
3349       [["touch"; "/a"];
3350        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3351        ["read_file"; "/a"]]);
3352     InitBasicFS, Always, TestLastFail (
3353       [["touch"; "/a"];
3354        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3355        ["read_file"; "/a"]]);
3356     InitBasicFS, Always, TestLastFail (
3357       [["touch"; "/a"];
3358        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3359        ["read_file"; "/a"]])],
3360    "read a file",
3361    "\
3362 This calls returns the contents of the file C<path> as a
3363 buffer.
3364
3365 Unlike C<guestfs_cat>, this function can correctly
3366 handle files that contain embedded ASCII NUL characters.
3367 However unlike C<guestfs_download>, this function is limited
3368 in the total size of file that can be handled.");
3369
3370   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3371    [InitISOFS, Always, TestOutputList (
3372       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3373     InitISOFS, Always, TestOutputList (
3374       [["grep"; "nomatch"; "/test-grep.txt"]], []);
3375     (* Test for RHBZ#579608, absolute symbolic links. *)
3376     InitISOFS, Always, TestOutputList (
3377       [["grep"; "nomatch"; "/abssymlink"]], [])],
3378    "return lines matching a pattern",
3379    "\
3380 This calls the external C<grep> program and returns the
3381 matching lines.");
3382
3383   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3384    [InitISOFS, Always, TestOutputList (
3385       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3386    "return lines matching a pattern",
3387    "\
3388 This calls the external C<egrep> program and returns the
3389 matching lines.");
3390
3391   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3392    [InitISOFS, Always, TestOutputList (
3393       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3394    "return lines matching a pattern",
3395    "\
3396 This calls the external C<fgrep> program and returns the
3397 matching lines.");
3398
3399   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3400    [InitISOFS, Always, TestOutputList (
3401       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3402    "return lines matching a pattern",
3403    "\
3404 This calls the external C<grep -i> program and returns the
3405 matching lines.");
3406
3407   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3408    [InitISOFS, Always, TestOutputList (
3409       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3410    "return lines matching a pattern",
3411    "\
3412 This calls the external C<egrep -i> program and returns the
3413 matching lines.");
3414
3415   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3416    [InitISOFS, Always, TestOutputList (
3417       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3418    "return lines matching a pattern",
3419    "\
3420 This calls the external C<fgrep -i> program and returns the
3421 matching lines.");
3422
3423   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3424    [InitISOFS, Always, TestOutputList (
3425       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3426    "return lines matching a pattern",
3427    "\
3428 This calls the external C<zgrep> program and returns the
3429 matching lines.");
3430
3431   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3432    [InitISOFS, Always, TestOutputList (
3433       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3434    "return lines matching a pattern",
3435    "\
3436 This calls the external C<zegrep> program and returns the
3437 matching lines.");
3438
3439   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3440    [InitISOFS, Always, TestOutputList (
3441       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3442    "return lines matching a pattern",
3443    "\
3444 This calls the external C<zfgrep> program and returns the
3445 matching lines.");
3446
3447   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3448    [InitISOFS, Always, TestOutputList (
3449       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3450    "return lines matching a pattern",
3451    "\
3452 This calls the external C<zgrep -i> program and returns the
3453 matching lines.");
3454
3455   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3456    [InitISOFS, Always, TestOutputList (
3457       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3458    "return lines matching a pattern",
3459    "\
3460 This calls the external C<zegrep -i> program and returns the
3461 matching lines.");
3462
3463   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3464    [InitISOFS, Always, TestOutputList (
3465       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3466    "return lines matching a pattern",
3467    "\
3468 This calls the external C<zfgrep -i> program and returns the
3469 matching lines.");
3470
3471   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3472    [InitISOFS, Always, TestOutput (
3473       [["realpath"; "/../directory"]], "/directory")],
3474    "canonicalized absolute pathname",
3475    "\
3476 Return the canonicalized absolute pathname of C<path>.  The
3477 returned path has no C<.>, C<..> or symbolic link path elements.");
3478
3479   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3480    [InitBasicFS, Always, TestOutputStruct (
3481       [["touch"; "/a"];
3482        ["ln"; "/a"; "/b"];
3483        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3484    "create a hard link",
3485    "\
3486 This command creates a hard link using the C<ln> command.");
3487
3488   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3489    [InitBasicFS, Always, TestOutputStruct (
3490       [["touch"; "/a"];
3491        ["touch"; "/b"];
3492        ["ln_f"; "/a"; "/b"];
3493        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3494    "create a hard link",
3495    "\
3496 This command creates a hard link using the C<ln -f> command.
3497 The C<-f> option removes the link (C<linkname>) if it exists already.");
3498
3499   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3500    [InitBasicFS, Always, TestOutputStruct (
3501       [["touch"; "/a"];
3502        ["ln_s"; "a"; "/b"];
3503        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3504    "create a symbolic link",
3505    "\
3506 This command creates a symbolic link using the C<ln -s> command.");
3507
3508   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3509    [InitBasicFS, Always, TestOutput (
3510       [["mkdir_p"; "/a/b"];
3511        ["touch"; "/a/b/c"];
3512        ["ln_sf"; "../d"; "/a/b/c"];
3513        ["readlink"; "/a/b/c"]], "../d")],
3514    "create a symbolic link",
3515    "\
3516 This command creates a symbolic link using the C<ln -sf> command,
3517 The C<-f> option removes the link (C<linkname>) if it exists already.");
3518
3519   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3520    [] (* XXX tested above *),
3521    "read the target of a symbolic link",
3522    "\
3523 This command reads the target of a symbolic link.");
3524
3525   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [DeprecatedBy "fallocate64"],
3526    [InitBasicFS, Always, TestOutputStruct (
3527       [["fallocate"; "/a"; "1000000"];
3528        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3529    "preallocate a file in the guest filesystem",
3530    "\
3531 This command preallocates a file (containing zero bytes) named
3532 C<path> of size C<len> bytes.  If the file exists already, it
3533 is overwritten.
3534
3535 Do not confuse this with the guestfish-specific
3536 C<alloc> command which allocates a file in the host and
3537 attaches it as a device.");
3538
3539   ("swapon_device", (RErr, [Device "device"]), 170, [],
3540    [InitPartition, Always, TestRun (
3541       [["mkswap"; "/dev/sda1"];
3542        ["swapon_device"; "/dev/sda1"];
3543        ["swapoff_device"; "/dev/sda1"]])],
3544    "enable swap on device",
3545    "\
3546 This command enables the libguestfs appliance to use the
3547 swap device or partition named C<device>.  The increased
3548 memory is made available for all commands, for example
3549 those run using C<guestfs_command> or C<guestfs_sh>.
3550
3551 Note that you should not swap to existing guest swap
3552 partitions unless you know what you are doing.  They may
3553 contain hibernation information, or other information that
3554 the guest doesn't want you to trash.  You also risk leaking
3555 information about the host to the guest this way.  Instead,
3556 attach a new host device to the guest and swap on that.");
3557
3558   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3559    [], (* XXX tested by swapon_device *)
3560    "disable swap on device",
3561    "\
3562 This command disables the libguestfs appliance swap
3563 device or partition named C<device>.
3564 See C<guestfs_swapon_device>.");
3565
3566   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3567    [InitBasicFS, Always, TestRun (
3568       [["fallocate"; "/swap"; "8388608"];
3569        ["mkswap_file"; "/swap"];
3570        ["swapon_file"; "/swap"];
3571        ["swapoff_file"; "/swap"]])],
3572    "enable swap on file",
3573    "\
3574 This command enables swap to a file.
3575 See C<guestfs_swapon_device> for other notes.");
3576
3577   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3578    [], (* XXX tested by swapon_file *)
3579    "disable swap on file",
3580    "\
3581 This command disables the libguestfs appliance swap on file.");
3582
3583   ("swapon_label", (RErr, [String "label"]), 174, [],
3584    [InitEmpty, Always, TestRun (
3585       [["part_disk"; "/dev/sdb"; "mbr"];
3586        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3587        ["swapon_label"; "swapit"];
3588        ["swapoff_label"; "swapit"];
3589        ["zero"; "/dev/sdb"];
3590        ["blockdev_rereadpt"; "/dev/sdb"]])],
3591    "enable swap on labeled swap partition",
3592    "\
3593 This command enables swap to a labeled swap partition.
3594 See C<guestfs_swapon_device> for other notes.");
3595
3596   ("swapoff_label", (RErr, [String "label"]), 175, [],
3597    [], (* XXX tested by swapon_label *)
3598    "disable swap on labeled swap partition",
3599    "\
3600 This command disables the libguestfs appliance swap on
3601 labeled swap partition.");
3602
3603   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3604    (let uuid = uuidgen () in
3605     [InitEmpty, Always, TestRun (
3606        [["mkswap_U"; uuid; "/dev/sdb"];
3607         ["swapon_uuid"; uuid];
3608         ["swapoff_uuid"; uuid]])]),
3609    "enable swap on swap partition by UUID",
3610    "\
3611 This command enables swap to a swap partition with the given UUID.
3612 See C<guestfs_swapon_device> for other notes.");
3613
3614   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3615    [], (* XXX tested by swapon_uuid *)
3616    "disable swap on swap partition by UUID",
3617    "\
3618 This command disables the libguestfs appliance swap partition
3619 with the given UUID.");
3620
3621   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3622    [InitBasicFS, Always, TestRun (
3623       [["fallocate"; "/swap"; "8388608"];
3624        ["mkswap_file"; "/swap"]])],
3625    "create a swap file",
3626    "\
3627 Create a swap file.
3628
3629 This command just writes a swap file signature to an existing
3630 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3631
3632   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3633    [InitISOFS, Always, TestRun (
3634       [["inotify_init"; "0"]])],
3635    "create an inotify handle",
3636    "\
3637 This command creates a new inotify handle.
3638 The inotify subsystem can be used to notify events which happen to
3639 objects in the guest filesystem.
3640
3641 C<maxevents> is the maximum number of events which will be
3642 queued up between calls to C<guestfs_inotify_read> or
3643 C<guestfs_inotify_files>.
3644 If this is passed as C<0>, then the kernel (or previously set)
3645 default is used.  For Linux 2.6.29 the default was 16384 events.
3646 Beyond this limit, the kernel throws away events, but records
3647 the fact that it threw them away by setting a flag
3648 C<IN_Q_OVERFLOW> in the returned structure list (see
3649 C<guestfs_inotify_read>).
3650
3651 Before any events are generated, you have to add some
3652 watches to the internal watch list.  See:
3653 C<guestfs_inotify_add_watch>,
3654 C<guestfs_inotify_rm_watch> and
3655 C<guestfs_inotify_watch_all>.
3656
3657 Queued up events should be read periodically by calling
3658 C<guestfs_inotify_read>
3659 (or C<guestfs_inotify_files> which is just a helpful
3660 wrapper around C<guestfs_inotify_read>).  If you don't
3661 read the events out often enough then you risk the internal
3662 queue overflowing.
3663
3664 The handle should be closed after use by calling
3665 C<guestfs_inotify_close>.  This also removes any
3666 watches automatically.
3667
3668 See also L<inotify(7)> for an overview of the inotify interface
3669 as exposed by the Linux kernel, which is roughly what we expose
3670 via libguestfs.  Note that there is one global inotify handle
3671 per libguestfs instance.");
3672
3673   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3674    [InitBasicFS, Always, TestOutputList (
3675       [["inotify_init"; "0"];
3676        ["inotify_add_watch"; "/"; "1073741823"];
3677        ["touch"; "/a"];
3678        ["touch"; "/b"];
3679        ["inotify_files"]], ["a"; "b"])],
3680    "add an inotify watch",
3681    "\
3682 Watch C<path> for the events listed in C<mask>.
3683
3684 Note that if C<path> is a directory then events within that
3685 directory are watched, but this does I<not> happen recursively
3686 (in subdirectories).
3687
3688 Note for non-C or non-Linux callers: the inotify events are
3689 defined by the Linux kernel ABI and are listed in
3690 C</usr/include/sys/inotify.h>.");
3691
3692   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3693    [],
3694    "remove an inotify watch",
3695    "\
3696 Remove a previously defined inotify watch.
3697 See C<guestfs_inotify_add_watch>.");
3698
3699   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3700    [],
3701    "return list of inotify events",
3702    "\
3703 Return the complete queue of events that have happened
3704 since the previous read call.
3705
3706 If no events have happened, this returns an empty list.
3707
3708 I<Note>: In order to make sure that all events have been
3709 read, you must call this function repeatedly until it
3710 returns an empty list.  The reason is that the call will
3711 read events up to the maximum appliance-to-host message
3712 size and leave remaining events in the queue.");
3713
3714   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3715    [],
3716    "return list of watched files that had events",
3717    "\
3718 This function is a helpful wrapper around C<guestfs_inotify_read>
3719 which just returns a list of pathnames of objects that were
3720 touched.  The returned pathnames are sorted and deduplicated.");
3721
3722   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3723    [],
3724    "close the inotify handle",
3725    "\
3726 This closes the inotify handle which was previously
3727 opened by inotify_init.  It removes all watches, throws
3728 away any pending events, and deallocates all resources.");
3729
3730   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3731    [],
3732    "set SELinux security context",
3733    "\
3734 This sets the SELinux security context of the daemon
3735 to the string C<context>.
3736
3737 See the documentation about SELINUX in L<guestfs(3)>.");
3738
3739   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3740    [],
3741    "get SELinux security context",
3742    "\
3743 This gets the SELinux security context of the daemon.
3744
3745 See the documentation about SELINUX in L<guestfs(3)>,
3746 and C<guestfs_setcon>");
3747
3748   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3749    [InitEmpty, Always, TestOutput (
3750       [["part_disk"; "/dev/sda"; "mbr"];
3751        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3752        ["mount_options"; ""; "/dev/sda1"; "/"];
3753        ["write"; "/new"; "new file contents"];
3754        ["cat"; "/new"]], "new file contents");
3755     InitEmpty, Always, TestRun (
3756       [["part_disk"; "/dev/sda"; "mbr"];
3757        ["mkfs_b"; "vfat"; "32768"; "/dev/sda1"]]);
3758     InitEmpty, Always, TestLastFail (
3759       [["part_disk"; "/dev/sda"; "mbr"];
3760        ["mkfs_b"; "vfat"; "32769"; "/dev/sda1"]]);
3761     InitEmpty, Always, TestLastFail (
3762       [["part_disk"; "/dev/sda"; "mbr"];
3763        ["mkfs_b"; "vfat"; "33280"; "/dev/sda1"]]);
3764     InitEmpty, IfAvailable "ntfsprogs", TestRun (
3765       [["part_disk"; "/dev/sda"; "mbr"];
3766        ["mkfs_b"; "ntfs"; "32768"; "/dev/sda1"]])],
3767    "make a filesystem with block size",
3768    "\
3769 This call is similar to C<guestfs_mkfs>, but it allows you to
3770 control the block size of the resulting filesystem.  Supported
3771 block sizes depend on the filesystem type, but typically they
3772 are C<1024>, C<2048> or C<4096> only.
3773
3774 For VFAT and NTFS the C<blocksize> parameter is treated as
3775 the requested cluster size.");
3776
3777   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3778    [InitEmpty, Always, TestOutput (
3779       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3780        ["mke2journal"; "4096"; "/dev/sda1"];
3781        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3782        ["mount_options"; ""; "/dev/sda2"; "/"];
3783        ["write"; "/new"; "new file contents"];
3784        ["cat"; "/new"]], "new file contents")],
3785    "make ext2/3/4 external journal",
3786    "\
3787 This creates an ext2 external journal on C<device>.  It is equivalent
3788 to the command:
3789
3790  mke2fs -O journal_dev -b blocksize device");
3791
3792   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3793    [InitEmpty, Always, TestOutput (
3794       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3795        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3796        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3797        ["mount_options"; ""; "/dev/sda2"; "/"];
3798        ["write"; "/new"; "new file contents"];
3799        ["cat"; "/new"]], "new file contents")],
3800    "make ext2/3/4 external journal with label",
3801    "\
3802 This creates an ext2 external journal on C<device> with label C<label>.");
3803
3804   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3805    (let uuid = uuidgen () in
3806     [InitEmpty, Always, TestOutput (
3807        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3808         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3809         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3810         ["mount_options"; ""; "/dev/sda2"; "/"];
3811         ["write"; "/new"; "new file contents"];
3812         ["cat"; "/new"]], "new file contents")]),
3813    "make ext2/3/4 external journal with UUID",
3814    "\
3815 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3816
3817   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3818    [],
3819    "make ext2/3/4 filesystem with external journal",
3820    "\
3821 This creates an ext2/3/4 filesystem on C<device> with
3822 an external journal on C<journal>.  It is equivalent
3823 to the command:
3824
3825  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3826
3827 See also C<guestfs_mke2journal>.");
3828
3829   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3830    [],
3831    "make ext2/3/4 filesystem with external journal",
3832    "\
3833 This creates an ext2/3/4 filesystem on C<device> with
3834 an external journal on the journal labeled C<label>.
3835
3836 See also C<guestfs_mke2journal_L>.");
3837
3838   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3839    [],
3840    "make ext2/3/4 filesystem with external journal",
3841    "\
3842 This creates an ext2/3/4 filesystem on C<device> with
3843 an external journal on the journal with UUID C<uuid>.
3844
3845 See also C<guestfs_mke2journal_U>.");
3846
3847   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3848    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3849    "load a kernel module",
3850    "\
3851 This loads a kernel module in the appliance.
3852
3853 The kernel module must have been whitelisted when libguestfs
3854 was built (see C<appliance/kmod.whitelist.in> in the source).");
3855
3856   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3857    [InitNone, Always, TestOutput (
3858       [["echo_daemon"; "This is a test"]], "This is a test"
3859     )],
3860    "echo arguments back to the client",
3861    "\
3862 This command concatenates the list of C<words> passed with single spaces
3863 between them and returns the resulting string.
3864
3865 You can use this command to test the connection through to the daemon.
3866
3867 See also C<guestfs_ping_daemon>.");
3868
3869   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3870    [], (* There is a regression test for this. *)
3871    "find all files and directories, returning NUL-separated list",
3872    "\
3873 This command lists out all files and directories, recursively,
3874 starting at C<directory>, placing the resulting list in the
3875 external file called C<files>.
3876
3877 This command works the same way as C<guestfs_find> with the
3878 following exceptions:
3879
3880 =over 4
3881
3882 =item *
3883
3884 The resulting list is written to an external file.
3885
3886 =item *
3887
3888 Items (filenames) in the result are separated
3889 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3890
3891 =item *
3892
3893 This command is not limited in the number of names that it
3894 can return.
3895
3896 =item *
3897
3898 The result list is not sorted.
3899
3900 =back");
3901
3902   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3903    [InitISOFS, Always, TestOutput (
3904       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3905     InitISOFS, Always, TestOutput (
3906       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3907     InitISOFS, Always, TestOutput (
3908       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3909     InitISOFS, Always, TestLastFail (
3910       [["case_sensitive_path"; "/Known-1/"]]);
3911     InitBasicFS, Always, TestOutput (
3912       [["mkdir"; "/a"];
3913        ["mkdir"; "/a/bbb"];
3914        ["touch"; "/a/bbb/c"];
3915        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3916     InitBasicFS, Always, TestOutput (
3917       [["mkdir"; "/a"];
3918        ["mkdir"; "/a/bbb"];
3919        ["touch"; "/a/bbb/c"];
3920        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3921     InitBasicFS, Always, TestLastFail (
3922       [["mkdir"; "/a"];
3923        ["mkdir"; "/a/bbb"];
3924        ["touch"; "/a/bbb/c"];
3925        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3926    "return true path on case-insensitive filesystem",
3927    "\
3928 This can be used to resolve case insensitive paths on
3929 a filesystem which is case sensitive.  The use case is
3930 to resolve paths which you have read from Windows configuration
3931 files or the Windows Registry, to the true path.
3932
3933 The command handles a peculiarity of the Linux ntfs-3g
3934 filesystem driver (and probably others), which is that although
3935 the underlying filesystem is case-insensitive, the driver
3936 exports the filesystem to Linux as case-sensitive.
3937
3938 One consequence of this is that special directories such
3939 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3940 (or other things) depending on the precise details of how
3941 they were created.  In Windows itself this would not be
3942 a problem.
3943
3944 Bug or feature?  You decide:
3945 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3946
3947 This function resolves the true case of each element in the
3948 path and returns the case-sensitive path.
3949
3950 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3951 might return C<\"/WINDOWS/system32\"> (the exact return value
3952 would depend on details of how the directories were originally
3953 created under Windows).
3954
3955 I<Note>:
3956 This function does not handle drive names, backslashes etc.
3957
3958 See also C<guestfs_realpath>.");
3959
3960   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3961    [InitBasicFS, Always, TestOutput (
3962       [["vfs_type"; "/dev/sda1"]], "ext2")],
3963    "get the Linux VFS type corresponding to a mounted device",
3964    "\
3965 This command gets the filesystem type corresponding to
3966 the filesystem on C<device>.
3967
3968 For most filesystems, the result is the name of the Linux
3969 VFS module which would be used to mount this filesystem
3970 if you mounted it without specifying the filesystem type.
3971 For example a string such as C<ext3> or C<ntfs>.");
3972
3973   ("truncate", (RErr, [Pathname "path"]), 199, [],
3974    [InitBasicFS, Always, TestOutputStruct (
3975       [["write"; "/test"; "some stuff so size is not zero"];
3976        ["truncate"; "/test"];
3977        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3978    "truncate a file to zero size",
3979    "\
3980 This command truncates C<path> to a zero-length file.  The
3981 file must exist already.");
3982
3983   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3984    [InitBasicFS, Always, TestOutputStruct (
3985       [["touch"; "/test"];
3986        ["truncate_size"; "/test"; "1000"];
3987        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3988    "truncate a file to a particular size",
3989    "\
3990 This command truncates C<path> to size C<size> bytes.  The file
3991 must exist already.
3992
3993 If the current file size is less than C<size> then
3994 the file is extended to the required size with zero bytes.
3995 This creates a sparse file (ie. disk blocks are not allocated
3996 for the file until you write to it).  To create a non-sparse
3997 file of zeroes, use C<guestfs_fallocate64> instead.");
3998
3999   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
4000    [InitBasicFS, Always, TestOutputStruct (
4001       [["touch"; "/test"];
4002        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
4003        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
4004    "set timestamp of a file with nanosecond precision",
4005    "\
4006 This command sets the timestamps of a file with nanosecond
4007 precision.
4008
4009 C<atsecs, atnsecs> are the last access time (atime) in secs and
4010 nanoseconds from the epoch.
4011
4012 C<mtsecs, mtnsecs> are the last modification time (mtime) in
4013 secs and nanoseconds from the epoch.
4014
4015 If the C<*nsecs> field contains the special value C<-1> then
4016 the corresponding timestamp is set to the current time.  (The
4017 C<*secs> field is ignored in this case).
4018
4019 If the C<*nsecs> field contains the special value C<-2> then
4020 the corresponding timestamp is left unchanged.  (The
4021 C<*secs> field is ignored in this case).");
4022
4023   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
4024    [InitBasicFS, Always, TestOutputStruct (
4025       [["mkdir_mode"; "/test"; "0o111"];
4026        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
4027    "create a directory with a particular mode",
4028    "\
4029 This command creates a directory, setting the initial permissions
4030 of the directory to C<mode>.
4031
4032 For common Linux filesystems, the actual mode which is set will
4033 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
4034 interpret the mode in other ways.
4035
4036 See also C<guestfs_mkdir>, C<guestfs_umask>");
4037
4038   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
4039    [], (* XXX *)
4040    "change file owner and group",
4041    "\
4042 Change the file owner to C<owner> and group to C<group>.
4043 This is like C<guestfs_chown> but if C<path> is a symlink then
4044 the link itself is changed, not the target.
4045
4046 Only numeric uid and gid are supported.  If you want to use
4047 names, you will need to locate and parse the password file
4048 yourself (Augeas support makes this relatively easy).");
4049
4050   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
4051    [], (* XXX *)
4052    "lstat on multiple files",
4053    "\
4054 This call allows you to perform the C<guestfs_lstat> operation
4055 on multiple files, where all files are in the directory C<path>.
4056 C<names> is the list of files from this directory.
4057
4058 On return you get a list of stat structs, with a one-to-one
4059 correspondence to the C<names> list.  If any name did not exist
4060 or could not be lstat'd, then the C<ino> field of that structure
4061 is set to C<-1>.
4062
4063 This call is intended for programs that want to efficiently
4064 list a directory contents without making many round-trips.
4065 See also C<guestfs_lxattrlist> for a similarly efficient call
4066 for getting extended attributes.  Very long directory listings
4067 might cause the protocol message size to be exceeded, causing
4068 this call to fail.  The caller must split up such requests
4069 into smaller groups of names.");
4070
4071   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4072    [], (* XXX *)
4073    "lgetxattr on multiple files",
4074    "\
4075 This call allows you to get the extended attributes
4076 of multiple files, where all files are in the directory C<path>.
4077 C<names> is the list of files from this directory.
4078
4079 On return you get a flat list of xattr structs which must be
4080 interpreted sequentially.  The first xattr struct always has a zero-length
4081 C<attrname>.  C<attrval> in this struct is zero-length
4082 to indicate there was an error doing C<lgetxattr> for this
4083 file, I<or> is a C string which is a decimal number
4084 (the number of following attributes for this file, which could
4085 be C<\"0\">).  Then after the first xattr struct are the
4086 zero or more attributes for the first named file.
4087 This repeats for the second and subsequent files.
4088
4089 This call is intended for programs that want to efficiently
4090 list a directory contents without making many round-trips.
4091 See also C<guestfs_lstatlist> for a similarly efficient call
4092 for getting standard stats.  Very long directory listings
4093 might cause the protocol message size to be exceeded, causing
4094 this call to fail.  The caller must split up such requests
4095 into smaller groups of names.");
4096
4097   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4098    [], (* XXX *)
4099    "readlink on multiple files",
4100    "\
4101 This call allows you to do a C<readlink> operation
4102 on multiple files, where all files are in the directory C<path>.
4103 C<names> is the list of files from this directory.
4104
4105 On return you get a list of strings, with a one-to-one
4106 correspondence to the C<names> list.  Each string is the
4107 value of the symbolic link.
4108
4109 If the C<readlink(2)> operation fails on any name, then
4110 the corresponding result string is the empty string C<\"\">.
4111 However the whole operation is completed even if there
4112 were C<readlink(2)> errors, and so you can call this
4113 function with names where you don't know if they are
4114 symbolic links already (albeit slightly less efficient).
4115
4116 This call is intended for programs that want to efficiently
4117 list a directory contents without making many round-trips.
4118 Very long directory listings might cause the protocol
4119 message size to be exceeded, causing
4120 this call to fail.  The caller must split up such requests
4121 into smaller groups of names.");
4122
4123   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4124    [InitISOFS, Always, TestOutputBuffer (
4125       [["pread"; "/known-4"; "1"; "3"]], "\n");
4126     InitISOFS, Always, TestOutputBuffer (
4127       [["pread"; "/empty"; "0"; "100"]], "")],
4128    "read part of a file",
4129    "\
4130 This command lets you read part of a file.  It reads C<count>
4131 bytes of the file, starting at C<offset>, from file C<path>.
4132
4133 This may read fewer bytes than requested.  For further details
4134 see the L<pread(2)> system call.
4135
4136 See also C<guestfs_pwrite>.");
4137
4138   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4139    [InitEmpty, Always, TestRun (
4140       [["part_init"; "/dev/sda"; "gpt"]])],
4141    "create an empty partition table",
4142    "\
4143 This creates an empty partition table on C<device> of one of the
4144 partition types listed below.  Usually C<parttype> should be
4145 either C<msdos> or C<gpt> (for large disks).
4146
4147 Initially there are no partitions.  Following this, you should
4148 call C<guestfs_part_add> for each partition required.
4149
4150 Possible values for C<parttype> are:
4151
4152 =over 4
4153
4154 =item B<efi> | B<gpt>
4155
4156 Intel EFI / GPT partition table.
4157
4158 This is recommended for >= 2 TB partitions that will be accessed
4159 from Linux and Intel-based Mac OS X.  It also has limited backwards
4160 compatibility with the C<mbr> format.
4161
4162 =item B<mbr> | B<msdos>
4163
4164 The standard PC \"Master Boot Record\" (MBR) format used
4165 by MS-DOS and Windows.  This partition type will B<only> work
4166 for device sizes up to 2 TB.  For large disks we recommend
4167 using C<gpt>.
4168
4169 =back
4170
4171 Other partition table types that may work but are not
4172 supported include:
4173
4174 =over 4
4175
4176 =item B<aix>
4177
4178 AIX disk labels.
4179
4180 =item B<amiga> | B<rdb>
4181
4182 Amiga \"Rigid Disk Block\" format.
4183
4184 =item B<bsd>
4185
4186 BSD disk labels.
4187
4188 =item B<dasd>
4189
4190 DASD, used on IBM mainframes.
4191
4192 =item B<dvh>
4193
4194 MIPS/SGI volumes.
4195
4196 =item B<mac>
4197
4198 Old Mac partition format.  Modern Macs use C<gpt>.
4199
4200 =item B<pc98>
4201
4202 NEC PC-98 format, common in Japan apparently.
4203
4204 =item B<sun>
4205
4206 Sun disk labels.
4207
4208 =back");
4209
4210   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4211    [InitEmpty, Always, TestRun (
4212       [["part_init"; "/dev/sda"; "mbr"];
4213        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4214     InitEmpty, Always, TestRun (
4215       [["part_init"; "/dev/sda"; "gpt"];
4216        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4217        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4218     InitEmpty, Always, TestRun (
4219       [["part_init"; "/dev/sda"; "mbr"];
4220        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4221        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4222        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4223        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4224    "add a partition to the device",
4225    "\
4226 This command adds a partition to C<device>.  If there is no partition
4227 table on the device, call C<guestfs_part_init> first.
4228
4229 The C<prlogex> parameter is the type of partition.  Normally you
4230 should pass C<p> or C<primary> here, but MBR partition tables also
4231 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4232 types.
4233
4234 C<startsect> and C<endsect> are the start and end of the partition
4235 in I<sectors>.  C<endsect> may be negative, which means it counts
4236 backwards from the end of the disk (C<-1> is the last sector).
4237
4238 Creating a partition which covers the whole disk is not so easy.
4239 Use C<guestfs_part_disk> to do that.");
4240
4241   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4242    [InitEmpty, Always, TestRun (
4243       [["part_disk"; "/dev/sda"; "mbr"]]);
4244     InitEmpty, Always, TestRun (
4245       [["part_disk"; "/dev/sda"; "gpt"]])],
4246    "partition whole disk with a single primary partition",
4247    "\
4248 This command is simply a combination of C<guestfs_part_init>
4249 followed by C<guestfs_part_add> to create a single primary partition
4250 covering the whole disk.
4251
4252 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4253 but other possible values are described in C<guestfs_part_init>.");
4254
4255   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4256    [InitEmpty, Always, TestRun (
4257       [["part_disk"; "/dev/sda"; "mbr"];
4258        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4259    "make a partition bootable",
4260    "\
4261 This sets the bootable flag on partition numbered C<partnum> on
4262 device C<device>.  Note that partitions are numbered from 1.
4263
4264 The bootable flag is used by some operating systems (notably
4265 Windows) to determine which partition to boot from.  It is by
4266 no means universally recognized.");
4267
4268   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4269    [InitEmpty, Always, TestRun (
4270       [["part_disk"; "/dev/sda"; "gpt"];
4271        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4272    "set partition name",
4273    "\
4274 This sets the partition name on partition numbered C<partnum> on
4275 device C<device>.  Note that partitions are numbered from 1.
4276
4277 The partition name can only be set on certain types of partition
4278 table.  This works on C<gpt> but not on C<mbr> partitions.");
4279
4280   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4281    [], (* XXX Add a regression test for this. *)
4282    "list partitions on a device",
4283    "\
4284 This command parses the partition table on C<device> and
4285 returns the list of partitions found.
4286
4287 The fields in the returned structure are:
4288
4289 =over 4
4290
4291 =item B<part_num>
4292
4293 Partition number, counting from 1.
4294
4295 =item B<part_start>
4296
4297 Start of the partition I<in bytes>.  To get sectors you have to
4298 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4299
4300 =item B<part_end>
4301
4302 End of the partition in bytes.
4303
4304 =item B<part_size>
4305
4306 Size of the partition in bytes.
4307
4308 =back");
4309
4310   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4311    [InitEmpty, Always, TestOutput (
4312       [["part_disk"; "/dev/sda"; "gpt"];
4313        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4314    "get the partition table type",
4315    "\
4316 This command examines the partition table on C<device> and
4317 returns the partition table type (format) being used.
4318
4319 Common return values include: C<msdos> (a DOS/Windows style MBR
4320 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4321 values are possible, although unusual.  See C<guestfs_part_init>
4322 for a full list.");
4323
4324   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4325    [InitBasicFS, Always, TestOutputBuffer (
4326       [["fill"; "0x63"; "10"; "/test"];
4327        ["read_file"; "/test"]], "cccccccccc")],
4328    "fill a file with octets",
4329    "\
4330 This command creates a new file called C<path>.  The initial
4331 content of the file is C<len> octets of C<c>, where C<c>
4332 must be a number in the range C<[0..255]>.
4333
4334 To fill a file with zero bytes (sparsely), it is
4335 much more efficient to use C<guestfs_truncate_size>.
4336 To create a file with a pattern of repeating bytes
4337 use C<guestfs_fill_pattern>.");
4338
4339   ("available", (RErr, [StringList "groups"]), 216, [],
4340    [InitNone, Always, TestRun [["available"; ""]]],
4341    "test availability of some parts of the API",
4342    "\
4343 This command is used to check the availability of some
4344 groups of functionality in the appliance, which not all builds of
4345 the libguestfs appliance will be able to provide.
4346
4347 The libguestfs groups, and the functions that those
4348 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4349 You can also fetch this list at runtime by calling
4350 C<guestfs_available_all_groups>.
4351
4352 The argument C<groups> is a list of group names, eg:
4353 C<[\"inotify\", \"augeas\"]> would check for the availability of
4354 the Linux inotify functions and Augeas (configuration file
4355 editing) functions.
4356
4357 The command returns no error if I<all> requested groups are available.
4358
4359 It fails with an error if one or more of the requested
4360 groups is unavailable in the appliance.
4361
4362 If an unknown group name is included in the
4363 list of groups then an error is always returned.
4364
4365 I<Notes:>
4366
4367 =over 4
4368
4369 =item *
4370
4371 You must call C<guestfs_launch> before calling this function.
4372
4373 The reason is because we don't know what groups are
4374 supported by the appliance/daemon until it is running and can
4375 be queried.
4376
4377 =item *
4378
4379 If a group of functions is available, this does not necessarily
4380 mean that they will work.  You still have to check for errors
4381 when calling individual API functions even if they are
4382 available.
4383
4384 =item *
4385
4386 It is usually the job of distro packagers to build
4387 complete functionality into the libguestfs appliance.
4388 Upstream libguestfs, if built from source with all
4389 requirements satisfied, will support everything.
4390
4391 =item *
4392
4393 This call was added in version C<1.0.80>.  In previous
4394 versions of libguestfs all you could do would be to speculatively
4395 execute a command to find out if the daemon implemented it.
4396 See also C<guestfs_version>.
4397
4398 =back");
4399
4400   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4401    [InitBasicFS, Always, TestOutputBuffer (
4402       [["write"; "/src"; "hello, world"];
4403        ["dd"; "/src"; "/dest"];
4404        ["read_file"; "/dest"]], "hello, world")],
4405    "copy from source to destination using dd",
4406    "\
4407 This command copies from one source device or file C<src>
4408 to another destination device or file C<dest>.  Normally you
4409 would use this to copy to or from a device or partition, for
4410 example to duplicate a filesystem.
4411
4412 If the destination is a device, it must be as large or larger
4413 than the source file or device, otherwise the copy will fail.
4414 This command cannot do partial copies (see C<guestfs_copy_size>).");
4415
4416   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4417    [InitBasicFS, Always, TestOutputInt (
4418       [["write"; "/file"; "hello, world"];
4419        ["filesize"; "/file"]], 12)],
4420    "return the size of the file in bytes",
4421    "\
4422 This command returns the size of C<file> in bytes.
4423
4424 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4425 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4426 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4427
4428   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4429    [InitBasicFSonLVM, Always, TestOutputList (
4430       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4431        ["lvs"]], ["/dev/VG/LV2"])],
4432    "rename an LVM logical volume",
4433    "\
4434 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4435
4436   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4437    [InitBasicFSonLVM, Always, TestOutputList (
4438       [["umount"; "/"];
4439        ["vg_activate"; "false"; "VG"];
4440        ["vgrename"; "VG"; "VG2"];
4441        ["vg_activate"; "true"; "VG2"];
4442        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4443        ["vgs"]], ["VG2"])],
4444    "rename an LVM volume group",
4445    "\
4446 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4447
4448   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4449    [InitISOFS, Always, TestOutputBuffer (
4450       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4451    "list the contents of a single file in an initrd",
4452    "\
4453 This command unpacks the file C<filename> from the initrd file
4454 called C<initrdpath>.  The filename must be given I<without> the
4455 initial C</> character.
4456
4457 For example, in guestfish you could use the following command
4458 to examine the boot script (usually called C</init>)
4459 contained in a Linux initrd or initramfs image:
4460
4461  initrd-cat /boot/initrd-<version>.img init
4462
4463 See also C<guestfs_initrd_list>.");
4464
4465   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4466    [],
4467    "get the UUID of a physical volume",
4468    "\
4469 This command returns the UUID of the LVM PV C<device>.");
4470
4471   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4472    [],
4473    "get the UUID of a volume group",
4474    "\
4475 This command returns the UUID of the LVM VG named C<vgname>.");
4476
4477   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4478    [],
4479    "get the UUID of a logical volume",
4480    "\
4481 This command returns the UUID of the LVM LV C<device>.");
4482
4483   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4484    [],
4485    "get the PV UUIDs containing the volume group",
4486    "\
4487 Given a VG called C<vgname>, this returns the UUIDs of all
4488 the physical volumes that this volume group resides on.
4489
4490 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4491 calls to associate physical volumes and volume groups.
4492
4493 See also C<guestfs_vglvuuids>.");
4494
4495   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4496    [],
4497    "get the LV UUIDs of all LVs in the volume group",
4498    "\
4499 Given a VG called C<vgname>, this returns the UUIDs of all
4500 the logical volumes created in this volume group.
4501
4502 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4503 calls to associate logical volumes and volume groups.
4504
4505 See also C<guestfs_vgpvuuids>.");
4506
4507   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4508    [InitBasicFS, Always, TestOutputBuffer (
4509       [["write"; "/src"; "hello, world"];
4510        ["copy_size"; "/src"; "/dest"; "5"];
4511        ["read_file"; "/dest"]], "hello")],
4512    "copy size bytes from source to destination using dd",
4513    "\
4514 This command copies exactly C<size> bytes from one source device
4515 or file C<src> to another destination device or file C<dest>.
4516
4517 Note this will fail if the source is too short or if the destination
4518 is not large enough.");
4519
4520   ("zero_device", (RErr, [Device "device"]), 228, [DangerWillRobinson],
4521    [InitBasicFSonLVM, Always, TestRun (
4522       [["zero_device"; "/dev/VG/LV"]])],
4523    "write zeroes to an entire device",
4524    "\
4525 This command writes zeroes over the entire C<device>.  Compare
4526 with C<guestfs_zero> which just zeroes the first few blocks of
4527 a device.");
4528
4529   ("txz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 229, [Optional "xz"],
4530    [InitBasicFS, Always, TestOutput (
4531       [["txz_in"; "../images/helloworld.tar.xz"; "/"];
4532        ["cat"; "/hello"]], "hello\n")],
4533    "unpack compressed tarball to directory",
4534    "\
4535 This command uploads and unpacks local file C<tarball> (an
4536 I<xz compressed> tar file) into C<directory>.");
4537
4538   ("txz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 230, [Optional "xz"],
4539    [],
4540    "pack directory into compressed tarball",
4541    "\
4542 This command packs the contents of C<directory> and downloads
4543 it to local file C<tarball> (as an xz compressed tar archive).");
4544
4545   ("ntfsresize", (RErr, [Device "device"]), 231, [Optional "ntfsprogs"],
4546    [],
4547    "resize an NTFS filesystem",
4548    "\
4549 This command resizes an NTFS filesystem, expanding or
4550 shrinking it to the size of the underlying device.
4551 See also L<ntfsresize(8)>.");
4552
4553   ("vgscan", (RErr, []), 232, [],
4554    [InitEmpty, Always, TestRun (
4555       [["vgscan"]])],
4556    "rescan for LVM physical volumes, volume groups and logical volumes",
4557    "\
4558 This rescans all block devices and rebuilds the list of LVM
4559 physical volumes, volume groups and logical volumes.");
4560
4561   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4562    [InitEmpty, Always, TestRun (
4563       [["part_init"; "/dev/sda"; "mbr"];
4564        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4565        ["part_del"; "/dev/sda"; "1"]])],
4566    "delete a partition",
4567    "\
4568 This command deletes the partition numbered C<partnum> on C<device>.
4569
4570 Note that in the case of MBR partitioning, deleting an
4571 extended partition also deletes any logical partitions
4572 it contains.");
4573
4574   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4575    [InitEmpty, Always, TestOutputTrue (
4576       [["part_init"; "/dev/sda"; "mbr"];
4577        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4578        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4579        ["part_get_bootable"; "/dev/sda"; "1"]])],
4580    "return true if a partition is bootable",
4581    "\
4582 This command returns true if the partition C<partnum> on
4583 C<device> has the bootable flag set.
4584
4585 See also C<guestfs_part_set_bootable>.");
4586
4587   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [FishOutput FishOutputHexadecimal],
4588    [InitEmpty, Always, TestOutputInt (
4589       [["part_init"; "/dev/sda"; "mbr"];
4590        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4591        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4592        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4593    "get the MBR type byte (ID byte) from a partition",
4594    "\
4595 Returns the MBR type byte (also known as the ID byte) from
4596 the numbered partition C<partnum>.
4597
4598 Note that only MBR (old DOS-style) partitions have type bytes.
4599 You will get undefined results for other partition table
4600 types (see C<guestfs_part_get_parttype>).");
4601
4602   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4603    [], (* tested by part_get_mbr_id *)
4604    "set the MBR type byte (ID byte) of a partition",
4605    "\
4606 Sets the MBR type byte (also known as the ID byte) of
4607 the numbered partition C<partnum> to C<idbyte>.  Note
4608 that the type bytes quoted in most documentation are
4609 in fact hexadecimal numbers, but usually documented
4610 without any leading \"0x\" which might be confusing.
4611
4612 Note that only MBR (old DOS-style) partitions have type bytes.
4613 You will get undefined results for other partition table
4614 types (see C<guestfs_part_get_parttype>).");
4615
4616   ("checksum_device", (RString "checksum", [String "csumtype"; Device "device"]), 237, [],
4617    [InitISOFS, Always, TestOutput (
4618       [["checksum_device"; "md5"; "/dev/sdd"]],
4619       (Digest.to_hex (Digest.file "images/test.iso")))],
4620    "compute MD5, SHAx or CRC checksum of the contents of a device",
4621    "\
4622 This call computes the MD5, SHAx or CRC checksum of the
4623 contents of the device named C<device>.  For the types of
4624 checksums supported see the C<guestfs_checksum> command.");
4625
4626   ("lvresize_free", (RErr, [Device "lv"; Int "percent"]), 238, [Optional "lvm2"],
4627    [InitNone, Always, TestRun (
4628       [["part_disk"; "/dev/sda"; "mbr"];
4629        ["pvcreate"; "/dev/sda1"];
4630        ["vgcreate"; "VG"; "/dev/sda1"];
4631        ["lvcreate"; "LV"; "VG"; "10"];
4632        ["lvresize_free"; "/dev/VG/LV"; "100"]])],
4633    "expand an LV to fill free space",
4634    "\
4635 This expands an existing logical volume C<lv> so that it fills
4636 C<pc>% of the remaining free space in the volume group.  Commonly
4637 you would call this with pc = 100 which expands the logical volume
4638 as much as possible, using all remaining free space in the volume
4639 group.");
4640
4641   ("aug_clear", (RErr, [String "augpath"]), 239, [Optional "augeas"],
4642    [], (* XXX Augeas code needs tests. *)
4643    "clear Augeas path",
4644    "\
4645 Set the value associated with C<path> to C<NULL>.  This
4646 is the same as the L<augtool(1)> C<clear> command.");
4647
4648   ("get_umask", (RInt "mask", []), 240, [FishOutput FishOutputOctal],
4649    [InitEmpty, Always, TestOutputInt (
4650       [["get_umask"]], 0o22)],
4651    "get the current umask",
4652    "\
4653 Return the current umask.  By default the umask is C<022>
4654 unless it has been set by calling C<guestfs_umask>.");
4655
4656   ("debug_upload", (RErr, [FileIn "filename"; String "tmpname"; Int "mode"]), 241, [],
4657    [],
4658    "upload a file to the appliance (internal use only)",
4659    "\
4660 The C<guestfs_debug_upload> command uploads a file to
4661 the libguestfs appliance.
4662
4663 There is no comprehensive help for this command.  You have
4664 to look at the file C<daemon/debug.c> in the libguestfs source
4665 to find out what it is for.");
4666
4667   ("base64_in", (RErr, [FileIn "base64file"; Pathname "filename"]), 242, [],
4668    [InitBasicFS, Always, TestOutput (
4669       [["base64_in"; "../images/hello.b64"; "/hello"];
4670        ["cat"; "/hello"]], "hello\n")],
4671    "upload base64-encoded data to file",
4672    "\
4673 This command uploads base64-encoded data from C<base64file>
4674 to C<filename>.");
4675
4676   ("base64_out", (RErr, [Pathname "filename"; FileOut "base64file"]), 243, [],
4677    [],
4678    "download file and encode as base64",
4679    "\
4680 This command downloads the contents of C<filename>, writing
4681 it out to local file C<base64file> encoded as base64.");
4682
4683   ("checksums_out", (RErr, [String "csumtype"; Pathname "directory"; FileOut "sumsfile"]), 244, [],
4684    [],
4685    "compute MD5, SHAx or CRC checksum of files in a directory",
4686    "\
4687 This command computes the checksums of all regular files in
4688 C<directory> and then emits a list of those checksums to
4689 the local output file C<sumsfile>.
4690
4691 This can be used for verifying the integrity of a virtual
4692 machine.  However to be properly secure you should pay
4693 attention to the output of the checksum command (it uses
4694 the ones from GNU coreutils).  In particular when the
4695 filename is not printable, coreutils uses a special
4696 backslash syntax.  For more information, see the GNU
4697 coreutils info file.");
4698
4699   ("fill_pattern", (RErr, [String "pattern"; Int "len"; Pathname "path"]), 245, [],
4700    [InitBasicFS, Always, TestOutputBuffer (
4701       [["fill_pattern"; "abcdefghijklmnopqrstuvwxyz"; "28"; "/test"];
4702        ["read_file"; "/test"]], "abcdefghijklmnopqrstuvwxyzab")],
4703    "fill a file with a repeating pattern of bytes",
4704    "\
4705 This function is like C<guestfs_fill> except that it creates
4706 a new file of length C<len> containing the repeating pattern
4707 of bytes in C<pattern>.  The pattern is truncated if necessary
4708 to ensure the length of the file is exactly C<len> bytes.");
4709
4710   ("write", (RErr, [Pathname "path"; BufferIn "content"]), 246, [ProtocolLimitWarning],
4711    [InitBasicFS, Always, TestOutput (
4712       [["write"; "/new"; "new file contents"];
4713        ["cat"; "/new"]], "new file contents");
4714     InitBasicFS, Always, TestOutput (
4715       [["write"; "/new"; "\nnew file contents\n"];
4716        ["cat"; "/new"]], "\nnew file contents\n");
4717     InitBasicFS, Always, TestOutput (
4718       [["write"; "/new"; "\n\n"];
4719        ["cat"; "/new"]], "\n\n");
4720     InitBasicFS, Always, TestOutput (
4721       [["write"; "/new"; ""];
4722        ["cat"; "/new"]], "");
4723     InitBasicFS, Always, TestOutput (
4724       [["write"; "/new"; "\n\n\n"];
4725        ["cat"; "/new"]], "\n\n\n");
4726     InitBasicFS, Always, TestOutput (
4727       [["write"; "/new"; "\n"];
4728        ["cat"; "/new"]], "\n")],
4729    "create a new file",
4730    "\
4731 This call creates a file called C<path>.  The content of the
4732 file is the string C<content> (which can contain any 8 bit data).");
4733
4734   ("pwrite", (RInt "nbytes", [Pathname "path"; BufferIn "content"; Int64 "offset"]), 247, [ProtocolLimitWarning],
4735    [InitBasicFS, Always, TestOutput (
4736       [["write"; "/new"; "new file contents"];
4737        ["pwrite"; "/new"; "data"; "4"];
4738        ["cat"; "/new"]], "new data contents");
4739     InitBasicFS, Always, TestOutput (
4740       [["write"; "/new"; "new file contents"];
4741        ["pwrite"; "/new"; "is extended"; "9"];
4742        ["cat"; "/new"]], "new file is extended");
4743     InitBasicFS, Always, TestOutput (
4744       [["write"; "/new"; "new file contents"];
4745        ["pwrite"; "/new"; ""; "4"];
4746        ["cat"; "/new"]], "new file contents")],
4747    "write to part of a file",
4748    "\
4749 This command writes to part of a file.  It writes the data
4750 buffer C<content> to the file C<path> starting at offset C<offset>.
4751
4752 This command implements the L<pwrite(2)> system call, and like
4753 that system call it may not write the full data requested.  The
4754 return value is the number of bytes that were actually written
4755 to the file.  This could even be 0, although short writes are
4756 unlikely for regular files in ordinary circumstances.
4757
4758 See also C<guestfs_pread>.");
4759
4760   ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
4761    [],
4762    "resize an ext2, ext3 or ext4 filesystem (with size)",
4763    "\
4764 This command is the same as C<guestfs_resize2fs> except that it
4765 allows you to specify the new size (in bytes) explicitly.");
4766
4767   ("pvresize_size", (RErr, [Device "device"; Int64 "size"]), 249, [Optional "lvm2"],
4768    [],
4769    "resize an LVM physical volume (with size)",
4770    "\
4771 This command is the same as C<guestfs_pvresize> except that it
4772 allows you to specify the new size (in bytes) explicitly.");
4773
4774   ("ntfsresize_size", (RErr, [Device "device"; Int64 "size"]), 250, [Optional "ntfsprogs"],
4775    [],
4776    "resize an NTFS filesystem (with size)",
4777    "\
4778 This command is the same as C<guestfs_ntfsresize> except that it
4779 allows you to specify the new size (in bytes) explicitly.");
4780
4781   ("available_all_groups", (RStringList "groups", []), 251, [],
4782    [InitNone, Always, TestRun [["available_all_groups"]]],
4783    "return a list of all optional groups",
4784    "\
4785 This command returns a list of all optional groups that this
4786 daemon knows about.  Note this returns both supported and unsupported
4787 groups.  To find out which ones the daemon can actually support
4788 you have to call C<guestfs_available> on each member of the
4789 returned list.
4790
4791 See also C<guestfs_available> and L<guestfs(3)/AVAILABILITY>.");
4792
4793   ("fallocate64", (RErr, [Pathname "path"; Int64 "len"]), 252, [],
4794    [InitBasicFS, Always, TestOutputStruct (
4795       [["fallocate64"; "/a"; "1000000"];
4796        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
4797    "preallocate a file in the guest filesystem",
4798    "\
4799 This command preallocates a file (containing zero bytes) named
4800 C<path> of size C<len> bytes.  If the file exists already, it
4801 is overwritten.
4802
4803 Note that this call allocates disk blocks for the file.
4804 To create a sparse file use C<guestfs_truncate_size> instead.
4805
4806 The deprecated call C<guestfs_fallocate> does the same,
4807 but owing to an oversight it only allowed 30 bit lengths
4808 to be specified, effectively limiting the maximum size
4809 of files created through that call to 1GB.
4810
4811 Do not confuse this with the guestfish-specific
4812 C<alloc> and C<sparse> commands which create
4813 a file in the host and attach it as a device.");
4814
4815   ("vfs_label", (RString "label", [Device "device"]), 253, [],
4816    [InitBasicFS, Always, TestOutput (
4817        [["set_e2label"; "/dev/sda1"; "LTEST"];
4818         ["vfs_label"; "/dev/sda1"]], "LTEST")],
4819    "get the filesystem label",
4820    "\
4821 This returns the filesystem label of the filesystem on
4822 C<device>.
4823
4824 If the filesystem is unlabeled, this returns the empty string.");
4825
4826   ("vfs_uuid", (RString "uuid", [Device "device"]), 254, [],
4827    (let uuid = uuidgen () in
4828     [InitBasicFS, Always, TestOutput (
4829        [["set_e2uuid"; "/dev/sda1"; uuid];
4830         ["vfs_uuid"; "/dev/sda1"]], uuid)]),
4831    "get the filesystem UUID",
4832    "\
4833 This returns the filesystem UUID of the filesystem on
4834 C<device>.
4835
4836 If the filesystem does not have a UUID, this returns the empty string.");
4837
4838 ]
4839
4840 let all_functions = non_daemon_functions @ daemon_functions
4841
4842 (* In some places we want the functions to be displayed sorted
4843  * alphabetically, so this is useful:
4844  *)
4845 let all_functions_sorted =
4846   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4847                compare n1 n2) all_functions
4848
4849 (* This is used to generate the src/MAX_PROC_NR file which
4850  * contains the maximum procedure number, a surrogate for the
4851  * ABI version number.  See src/Makefile.am for the details.
4852  *)
4853 let max_proc_nr =
4854   let proc_nrs = List.map (
4855     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
4856   ) daemon_functions in
4857   List.fold_left max 0 proc_nrs
4858
4859 (* Field types for structures. *)
4860 type field =
4861   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4862   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4863   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4864   | FUInt32
4865   | FInt32
4866   | FUInt64
4867   | FInt64
4868   | FBytes                      (* Any int measure that counts bytes. *)
4869   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4870   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4871
4872 (* Because we generate extra parsing code for LVM command line tools,
4873  * we have to pull out the LVM columns separately here.
4874  *)
4875 let lvm_pv_cols = [
4876   "pv_name", FString;
4877   "pv_uuid", FUUID;
4878   "pv_fmt", FString;
4879   "pv_size", FBytes;
4880   "dev_size", FBytes;
4881   "pv_free", FBytes;
4882   "pv_used", FBytes;
4883   "pv_attr", FString (* XXX *);
4884   "pv_pe_count", FInt64;
4885   "pv_pe_alloc_count", FInt64;
4886   "pv_tags", FString;
4887   "pe_start", FBytes;
4888   "pv_mda_count", FInt64;
4889   "pv_mda_free", FBytes;
4890   (* Not in Fedora 10:
4891      "pv_mda_size", FBytes;
4892   *)
4893 ]
4894 let lvm_vg_cols = [
4895   "vg_name", FString;
4896   "vg_uuid", FUUID;
4897   "vg_fmt", FString;
4898   "vg_attr", FString (* XXX *);
4899   "vg_size", FBytes;
4900   "vg_free", FBytes;
4901   "vg_sysid", FString;
4902   "vg_extent_size", FBytes;
4903   "vg_extent_count", FInt64;
4904   "vg_free_count", FInt64;
4905   "max_lv", FInt64;
4906   "max_pv", FInt64;
4907   "pv_count", FInt64;
4908   "lv_count", FInt64;
4909   "snap_count", FInt64;
4910   "vg_seqno", FInt64;
4911   "vg_tags", FString;
4912   "vg_mda_count", FInt64;
4913   "vg_mda_free", FBytes;
4914   (* Not in Fedora 10:
4915      "vg_mda_size", FBytes;
4916   *)
4917 ]
4918 let lvm_lv_cols = [
4919   "lv_name", FString;
4920   "lv_uuid", FUUID;
4921   "lv_attr", FString (* XXX *);
4922   "lv_major", FInt64;
4923   "lv_minor", FInt64;
4924   "lv_kernel_major", FInt64;
4925   "lv_kernel_minor", FInt64;
4926   "lv_size", FBytes;
4927   "seg_count", FInt64;
4928   "origin", FString;
4929   "snap_percent", FOptPercent;
4930   "copy_percent", FOptPercent;
4931   "move_pv", FString;
4932   "lv_tags", FString;
4933   "mirror_log", FString;
4934   "modules", FString;
4935 ]
4936
4937 (* Names and fields in all structures (in RStruct and RStructList)
4938  * that we support.
4939  *)
4940 let structs = [
4941   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4942    * not use this struct in any new code.
4943    *)
4944   "int_bool", [
4945     "i", FInt32;                (* for historical compatibility *)
4946     "b", FInt32;                (* for historical compatibility *)
4947   ];
4948
4949   (* LVM PVs, VGs, LVs. *)
4950   "lvm_pv", lvm_pv_cols;
4951   "lvm_vg", lvm_vg_cols;
4952   "lvm_lv", lvm_lv_cols;
4953
4954   (* Column names and types from stat structures.
4955    * NB. Can't use things like 'st_atime' because glibc header files
4956    * define some of these as macros.  Ugh.
4957    *)
4958   "stat", [
4959     "dev", FInt64;
4960     "ino", FInt64;
4961     "mode", FInt64;
4962     "nlink", FInt64;
4963     "uid", FInt64;
4964     "gid", FInt64;
4965     "rdev", FInt64;
4966     "size", FInt64;
4967     "blksize", FInt64;
4968     "blocks", FInt64;
4969     "atime", FInt64;
4970     "mtime", FInt64;
4971     "ctime", FInt64;
4972   ];
4973   "statvfs", [
4974     "bsize", FInt64;
4975     "frsize", FInt64;
4976     "blocks", FInt64;
4977     "bfree", FInt64;
4978     "bavail", FInt64;
4979     "files", FInt64;
4980     "ffree", FInt64;
4981     "favail", FInt64;
4982     "fsid", FInt64;
4983     "flag", FInt64;
4984     "namemax", FInt64;
4985   ];
4986
4987   (* Column names in dirent structure. *)
4988   "dirent", [
4989     "ino", FInt64;
4990     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4991     "ftyp", FChar;
4992     "name", FString;
4993   ];
4994
4995   (* Version numbers. *)
4996   "version", [
4997     "major", FInt64;
4998     "minor", FInt64;
4999     "release", FInt64;
5000     "extra", FString;
5001   ];
5002
5003   (* Extended attribute. *)
5004   "xattr", [
5005     "attrname", FString;
5006     "attrval", FBuffer;
5007   ];
5008
5009   (* Inotify events. *)
5010   "inotify_event", [
5011     "in_wd", FInt64;
5012     "in_mask", FUInt32;
5013     "in_cookie", FUInt32;
5014     "in_name", FString;
5015   ];
5016
5017   (* Partition table entry. *)
5018   "partition", [
5019     "part_num", FInt32;
5020     "part_start", FBytes;
5021     "part_end", FBytes;
5022     "part_size", FBytes;
5023   ];
5024 ] (* end of structs *)
5025
5026 (* Ugh, Java has to be different ..
5027  * These names are also used by the Haskell bindings.
5028  *)
5029 let java_structs = [
5030   "int_bool", "IntBool";
5031   "lvm_pv", "PV";
5032   "lvm_vg", "VG";
5033   "lvm_lv", "LV";
5034   "stat", "Stat";
5035   "statvfs", "StatVFS";
5036   "dirent", "Dirent";
5037   "version", "Version";
5038   "xattr", "XAttr";
5039   "inotify_event", "INotifyEvent";
5040   "partition", "Partition";
5041 ]
5042
5043 (* What structs are actually returned. *)
5044 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
5045
5046 (* Returns a list of RStruct/RStructList structs that are returned
5047  * by any function.  Each element of returned list is a pair:
5048  *
5049  * (structname, RStructOnly)
5050  *    == there exists function which returns RStruct (_, structname)
5051  * (structname, RStructListOnly)
5052  *    == there exists function which returns RStructList (_, structname)
5053  * (structname, RStructAndList)
5054  *    == there are functions returning both RStruct (_, structname)
5055  *                                      and RStructList (_, structname)
5056  *)
5057 let rstructs_used_by functions =
5058   (* ||| is a "logical OR" for rstructs_used_t *)
5059   let (|||) a b =
5060     match a, b with
5061     | RStructAndList, _
5062     | _, RStructAndList -> RStructAndList
5063     | RStructOnly, RStructListOnly
5064     | RStructListOnly, RStructOnly -> RStructAndList
5065     | RStructOnly, RStructOnly -> RStructOnly
5066     | RStructListOnly, RStructListOnly -> RStructListOnly
5067   in
5068
5069   let h = Hashtbl.create 13 in
5070
5071   (* if elem->oldv exists, update entry using ||| operator,
5072    * else just add elem->newv to the hash
5073    *)
5074   let update elem newv =
5075     try  let oldv = Hashtbl.find h elem in
5076          Hashtbl.replace h elem (newv ||| oldv)
5077     with Not_found -> Hashtbl.add h elem newv
5078   in
5079
5080   List.iter (
5081     fun (_, style, _, _, _, _, _) ->
5082       match fst style with
5083       | RStruct (_, structname) -> update structname RStructOnly
5084       | RStructList (_, structname) -> update structname RStructListOnly
5085       | _ -> ()
5086   ) functions;
5087
5088   (* return key->values as a list of (key,value) *)
5089   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
5090
5091 (* Used for testing language bindings. *)
5092 type callt =
5093   | CallString of string
5094   | CallOptString of string option
5095   | CallStringList of string list
5096   | CallInt of int
5097   | CallInt64 of int64
5098   | CallBool of bool
5099   | CallBuffer of string
5100
5101 (* Used for the guestfish -N (prepared disk images) option.
5102  * Note that the longdescs are indented by 2 spaces.
5103  *)
5104 let prepopts = [
5105   ("disk",
5106    "create a blank disk",
5107    [ "size", "100M", "the size of the disk image" ],
5108    "  Create a blank disk, size 100MB (by default).
5109
5110   The default size can be changed by supplying an optional parameter.");
5111
5112   ("part",
5113    "create a partitioned disk",
5114    [ "size", "100M", "the size of the disk image";
5115      "partition", "mbr", "partition table type" ],
5116    "  Create a disk with a single partition.  By default the size of the disk
5117   is 100MB (the available space in the partition will be a tiny bit smaller)
5118   and the partition table will be MBR (old DOS-style).
5119
5120   These defaults can be changed by supplying optional parameters.");
5121
5122   ("fs",
5123    "create a filesystem",
5124    [ "filesystem", "ext2", "the type of filesystem to use";
5125      "size", "100M", "the size of the disk image";
5126      "partition", "mbr", "partition table type" ],
5127    "  Create a disk with a single partition, with the partition containing
5128   an empty filesystem.  This defaults to creating a 100MB disk (the available
5129   space in the filesystem will be a tiny bit smaller) with an MBR (old
5130   DOS-style) partition table and an ext2 filesystem.
5131
5132   These defaults can be changed by supplying optional parameters.");
5133 ]
5134
5135 (* Used to memoize the result of pod2text. *)
5136 let pod2text_memo_filename = "src/.pod2text.data"
5137 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
5138   try
5139     let chan = open_in pod2text_memo_filename in
5140     let v = input_value chan in
5141     close_in chan;
5142     v
5143   with
5144     _ -> Hashtbl.create 13
5145 let pod2text_memo_updated () =
5146   let chan = open_out pod2text_memo_filename in
5147   output_value chan pod2text_memo;
5148   close_out chan
5149
5150 (* Useful functions.
5151  * Note we don't want to use any external OCaml libraries which
5152  * makes this a bit harder than it should be.
5153  *)
5154 module StringMap = Map.Make (String)
5155
5156 let failwithf fs = ksprintf failwith fs
5157
5158 let unique = let i = ref 0 in fun () -> incr i; !i
5159
5160 let replace_char s c1 c2 =
5161   let s2 = String.copy s in
5162   let r = ref false in
5163   for i = 0 to String.length s2 - 1 do
5164     if String.unsafe_get s2 i = c1 then (
5165       String.unsafe_set s2 i c2;
5166       r := true
5167     )
5168   done;
5169   if not !r then s else s2
5170
5171 let isspace c =
5172   c = ' '
5173   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
5174
5175 let triml ?(test = isspace) str =
5176   let i = ref 0 in
5177   let n = ref (String.length str) in
5178   while !n > 0 && test str.[!i]; do
5179     decr n;
5180     incr i
5181   done;
5182   if !i = 0 then str
5183   else String.sub str !i !n
5184
5185 let trimr ?(test = isspace) str =
5186   let n = ref (String.length str) in
5187   while !n > 0 && test str.[!n-1]; do
5188     decr n
5189   done;
5190   if !n = String.length str then str
5191   else String.sub str 0 !n
5192
5193 let trim ?(test = isspace) str =
5194   trimr ~test (triml ~test str)
5195
5196 let rec find s sub =
5197   let len = String.length s in
5198   let sublen = String.length sub in
5199   let rec loop i =
5200     if i <= len-sublen then (
5201       let rec loop2 j =
5202         if j < sublen then (
5203           if s.[i+j] = sub.[j] then loop2 (j+1)
5204           else -1
5205         ) else
5206           i (* found *)
5207       in
5208       let r = loop2 0 in
5209       if r = -1 then loop (i+1) else r
5210     ) else
5211       -1 (* not found *)
5212   in
5213   loop 0
5214
5215 let rec replace_str s s1 s2 =
5216   let len = String.length s in
5217   let sublen = String.length s1 in
5218   let i = find s s1 in
5219   if i = -1 then s
5220   else (
5221     let s' = String.sub s 0 i in
5222     let s'' = String.sub s (i+sublen) (len-i-sublen) in
5223     s' ^ s2 ^ replace_str s'' s1 s2
5224   )
5225
5226 let rec string_split sep str =
5227   let len = String.length str in
5228   let seplen = String.length sep in
5229   let i = find str sep in
5230   if i = -1 then [str]
5231   else (
5232     let s' = String.sub str 0 i in
5233     let s'' = String.sub str (i+seplen) (len-i-seplen) in
5234     s' :: string_split sep s''
5235   )
5236
5237 let files_equal n1 n2 =
5238   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
5239   match Sys.command cmd with
5240   | 0 -> true
5241   | 1 -> false
5242   | i -> failwithf "%s: failed with error code %d" cmd i
5243
5244 let rec filter_map f = function
5245   | [] -> []
5246   | x :: xs ->
5247       match f x with
5248       | Some y -> y :: filter_map f xs
5249       | None -> filter_map f xs
5250
5251 let rec find_map f = function
5252   | [] -> raise Not_found
5253   | x :: xs ->
5254       match f x with
5255       | Some y -> y
5256       | None -> find_map f xs
5257
5258 let iteri f xs =
5259   let rec loop i = function
5260     | [] -> ()
5261     | x :: xs -> f i x; loop (i+1) xs
5262   in
5263   loop 0 xs
5264
5265 let mapi f xs =
5266   let rec loop i = function
5267     | [] -> []
5268     | x :: xs -> let r = f i x in r :: loop (i+1) xs
5269   in
5270   loop 0 xs
5271
5272 let count_chars c str =
5273   let count = ref 0 in
5274   for i = 0 to String.length str - 1 do
5275     if c = String.unsafe_get str i then incr count
5276   done;
5277   !count
5278
5279 let explode str =
5280   let r = ref [] in
5281   for i = 0 to String.length str - 1 do
5282     let c = String.unsafe_get str i in
5283     r := c :: !r;
5284   done;
5285   List.rev !r
5286
5287 let map_chars f str =
5288   List.map f (explode str)
5289
5290 let name_of_argt = function
5291   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
5292   | StringList n | DeviceList n | Bool n | Int n | Int64 n
5293   | FileIn n | FileOut n | BufferIn n -> n
5294
5295 let java_name_of_struct typ =
5296   try List.assoc typ java_structs
5297   with Not_found ->
5298     failwithf
5299       "java_name_of_struct: no java_structs entry corresponding to %s" typ
5300
5301 let cols_of_struct typ =
5302   try List.assoc typ structs
5303   with Not_found ->
5304     failwithf "cols_of_struct: unknown struct %s" typ
5305
5306 let seq_of_test = function
5307   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
5308   | TestOutputListOfDevices (s, _)
5309   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
5310   | TestOutputTrue s | TestOutputFalse s
5311   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
5312   | TestOutputStruct (s, _)
5313   | TestLastFail s -> s
5314
5315 (* Handling for function flags. *)
5316 let protocol_limit_warning =
5317   "Because of the message protocol, there is a transfer limit
5318 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
5319
5320 let danger_will_robinson =
5321   "B<This command is dangerous.  Without careful use you
5322 can easily destroy all your data>."
5323
5324 let deprecation_notice flags =
5325   try
5326     let alt =
5327       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
5328     let txt =
5329       sprintf "This function is deprecated.
5330 In new code, use the C<%s> call instead.
5331
5332 Deprecated functions will not be removed from the API, but the
5333 fact that they are deprecated indicates that there are problems
5334 with correct use of these functions." alt in
5335     Some txt
5336   with
5337     Not_found -> None
5338
5339 (* Create list of optional groups. *)
5340 let optgroups =
5341   let h = Hashtbl.create 13 in
5342   List.iter (
5343     fun (name, _, _, flags, _, _, _) ->
5344       List.iter (
5345         function
5346         | Optional group ->
5347             let names = try Hashtbl.find h group with Not_found -> [] in
5348             Hashtbl.replace h group (name :: names)
5349         | _ -> ()
5350       ) flags
5351   ) daemon_functions;
5352   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
5353   let groups =
5354     List.map (
5355       fun group -> group, List.sort compare (Hashtbl.find h group)
5356     ) groups in
5357   List.sort (fun x y -> compare (fst x) (fst y)) groups
5358
5359 (* Check function names etc. for consistency. *)
5360 let check_functions () =
5361   let contains_uppercase str =
5362     let len = String.length str in
5363     let rec loop i =
5364       if i >= len then false
5365       else (
5366         let c = str.[i] in
5367         if c >= 'A' && c <= 'Z' then true
5368         else loop (i+1)
5369       )
5370     in
5371     loop 0
5372   in
5373
5374   (* Check function names. *)
5375   List.iter (
5376     fun (name, _, _, _, _, _, _) ->
5377       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
5378         failwithf "function name %s does not need 'guestfs' prefix" name;
5379       if name = "" then
5380         failwithf "function name is empty";
5381       if name.[0] < 'a' || name.[0] > 'z' then
5382         failwithf "function name %s must start with lowercase a-z" name;
5383       if String.contains name '-' then
5384         failwithf "function name %s should not contain '-', use '_' instead."
5385           name
5386   ) all_functions;
5387
5388   (* Check function parameter/return names. *)
5389   List.iter (
5390     fun (name, style, _, _, _, _, _) ->
5391       let check_arg_ret_name n =
5392         if contains_uppercase n then
5393           failwithf "%s param/ret %s should not contain uppercase chars"
5394             name n;
5395         if String.contains n '-' || String.contains n '_' then
5396           failwithf "%s param/ret %s should not contain '-' or '_'"
5397             name n;
5398         if n = "value" then
5399           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;
5400         if n = "int" || n = "char" || n = "short" || n = "long" then
5401           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5402         if n = "i" || n = "n" then
5403           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5404         if n = "argv" || n = "args" then
5405           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5406
5407         (* List Haskell, OCaml and C keywords here.
5408          * http://www.haskell.org/haskellwiki/Keywords
5409          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5410          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5411          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5412          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5413          * Omitting _-containing words, since they're handled above.
5414          * Omitting the OCaml reserved word, "val", is ok,
5415          * and saves us from renaming several parameters.
5416          *)
5417         let reserved = [
5418           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5419           "char"; "class"; "const"; "constraint"; "continue"; "data";
5420           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5421           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5422           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5423           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5424           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5425           "interface";
5426           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5427           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5428           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5429           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5430           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5431           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5432           "volatile"; "when"; "where"; "while";
5433           ] in
5434         if List.mem n reserved then
5435           failwithf "%s has param/ret using reserved word %s" name n;
5436       in
5437
5438       (match fst style with
5439        | RErr -> ()
5440        | RInt n | RInt64 n | RBool n
5441        | RConstString n | RConstOptString n | RString n
5442        | RStringList n | RStruct (n, _) | RStructList (n, _)
5443        | RHashtable n | RBufferOut n ->
5444            check_arg_ret_name n
5445       );
5446       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5447   ) all_functions;
5448
5449   (* Check short descriptions. *)
5450   List.iter (
5451     fun (name, _, _, _, _, shortdesc, _) ->
5452       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5453         failwithf "short description of %s should begin with lowercase." name;
5454       let c = shortdesc.[String.length shortdesc-1] in
5455       if c = '\n' || c = '.' then
5456         failwithf "short description of %s should not end with . or \\n." name
5457   ) all_functions;
5458
5459   (* Check long descriptions. *)
5460   List.iter (
5461     fun (name, _, _, _, _, _, longdesc) ->
5462       if longdesc.[String.length longdesc-1] = '\n' then
5463         failwithf "long description of %s should not end with \\n." name
5464   ) all_functions;
5465
5466   (* Check proc_nrs. *)
5467   List.iter (
5468     fun (name, _, proc_nr, _, _, _, _) ->
5469       if proc_nr <= 0 then
5470         failwithf "daemon function %s should have proc_nr > 0" name
5471   ) daemon_functions;
5472
5473   List.iter (
5474     fun (name, _, proc_nr, _, _, _, _) ->
5475       if proc_nr <> -1 then
5476         failwithf "non-daemon function %s should have proc_nr -1" name
5477   ) non_daemon_functions;
5478
5479   let proc_nrs =
5480     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5481       daemon_functions in
5482   let proc_nrs =
5483     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5484   let rec loop = function
5485     | [] -> ()
5486     | [_] -> ()
5487     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5488         loop rest
5489     | (name1,nr1) :: (name2,nr2) :: _ ->
5490         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5491           name1 name2 nr1 nr2
5492   in
5493   loop proc_nrs;
5494
5495   (* Check tests. *)
5496   List.iter (
5497     function
5498       (* Ignore functions that have no tests.  We generate a
5499        * warning when the user does 'make check' instead.
5500        *)
5501     | name, _, _, _, [], _, _ -> ()
5502     | name, _, _, _, tests, _, _ ->
5503         let funcs =
5504           List.map (
5505             fun (_, _, test) ->
5506               match seq_of_test test with
5507               | [] ->
5508                   failwithf "%s has a test containing an empty sequence" name
5509               | cmds -> List.map List.hd cmds
5510           ) tests in
5511         let funcs = List.flatten funcs in
5512
5513         let tested = List.mem name funcs in
5514
5515         if not tested then
5516           failwithf "function %s has tests but does not test itself" name
5517   ) all_functions
5518
5519 (* 'pr' prints to the current output file. *)
5520 let chan = ref Pervasives.stdout
5521 let lines = ref 0
5522 let pr fs =
5523   ksprintf
5524     (fun str ->
5525        let i = count_chars '\n' str in
5526        lines := !lines + i;
5527        output_string !chan str
5528     ) fs
5529
5530 let copyright_years =
5531   let this_year = 1900 + (localtime (time ())).tm_year in
5532   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5533
5534 (* Generate a header block in a number of standard styles. *)
5535 type comment_style =
5536     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5537 type license = GPLv2plus | LGPLv2plus
5538
5539 let generate_header ?(extra_inputs = []) comment license =
5540   let inputs = "src/generator.ml" :: extra_inputs in
5541   let c = match comment with
5542     | CStyle ->         pr "/* "; " *"
5543     | CPlusPlusStyle -> pr "// "; "//"
5544     | HashStyle ->      pr "# ";  "#"
5545     | OCamlStyle ->     pr "(* "; " *"
5546     | HaskellStyle ->   pr "{- "; "  " in
5547   pr "libguestfs generated file\n";
5548   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5549   List.iter (pr "%s   %s\n" c) inputs;
5550   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5551   pr "%s\n" c;
5552   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5553   pr "%s\n" c;
5554   (match license with
5555    | GPLv2plus ->
5556        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5557        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5558        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5559        pr "%s (at your option) any later version.\n" c;
5560        pr "%s\n" c;
5561        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5562        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5563        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5564        pr "%s GNU General Public License for more details.\n" c;
5565        pr "%s\n" c;
5566        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5567        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5568        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5569
5570    | LGPLv2plus ->
5571        pr "%s This library is free software; you can redistribute it and/or\n" c;
5572        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5573        pr "%s License as published by the Free Software Foundation; either\n" c;
5574        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5575        pr "%s\n" c;
5576        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5577        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5578        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5579        pr "%s Lesser General Public License for more details.\n" c;
5580        pr "%s\n" c;
5581        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5582        pr "%s License along with this library; if not, write to the Free Software\n" c;
5583        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5584   );
5585   (match comment with
5586    | CStyle -> pr " */\n"
5587    | CPlusPlusStyle
5588    | HashStyle -> ()
5589    | OCamlStyle -> pr " *)\n"
5590    | HaskellStyle -> pr "-}\n"
5591   );
5592   pr "\n"
5593
5594 (* Start of main code generation functions below this line. *)
5595
5596 (* Generate the pod documentation for the C API. *)
5597 let rec generate_actions_pod () =
5598   List.iter (
5599     fun (shortname, style, _, flags, _, _, longdesc) ->
5600       if not (List.mem NotInDocs flags) then (
5601         let name = "guestfs_" ^ shortname in
5602         pr "=head2 %s\n\n" name;
5603         pr " ";
5604         generate_prototype ~extern:false ~handle:"g" name style;
5605         pr "\n\n";
5606         pr "%s\n\n" longdesc;
5607         (match fst style with
5608          | RErr ->
5609              pr "This function returns 0 on success or -1 on error.\n\n"
5610          | RInt _ ->
5611              pr "On error this function returns -1.\n\n"
5612          | RInt64 _ ->
5613              pr "On error this function returns -1.\n\n"
5614          | RBool _ ->
5615              pr "This function returns a C truth value on success or -1 on error.\n\n"
5616          | RConstString _ ->
5617              pr "This function returns a string, or NULL on error.
5618 The string is owned by the guest handle and must I<not> be freed.\n\n"
5619          | RConstOptString _ ->
5620              pr "This function returns a string which may be NULL.
5621 There is no way to return an error from this function.
5622 The string is owned by the guest handle and must I<not> be freed.\n\n"
5623          | RString _ ->
5624              pr "This function returns a string, or NULL on error.
5625 I<The caller must free the returned string after use>.\n\n"
5626          | RStringList _ ->
5627              pr "This function returns a NULL-terminated array of strings
5628 (like L<environ(3)>), or NULL if there was an error.
5629 I<The caller must free the strings and the array after use>.\n\n"
5630          | RStruct (_, typ) ->
5631              pr "This function returns a C<struct guestfs_%s *>,
5632 or NULL if there was an error.
5633 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5634          | RStructList (_, typ) ->
5635              pr "This function returns a C<struct guestfs_%s_list *>
5636 (see E<lt>guestfs-structs.hE<gt>),
5637 or NULL if there was an error.
5638 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5639          | RHashtable _ ->
5640              pr "This function returns a NULL-terminated array of
5641 strings, or NULL if there was an error.
5642 The array of strings will always have length C<2n+1>, where
5643 C<n> keys and values alternate, followed by the trailing NULL entry.
5644 I<The caller must free the strings and the array after use>.\n\n"
5645          | RBufferOut _ ->
5646              pr "This function returns a buffer, or NULL on error.
5647 The size of the returned buffer is written to C<*size_r>.
5648 I<The caller must free the returned buffer after use>.\n\n"
5649         );
5650         if List.mem ProtocolLimitWarning flags then
5651           pr "%s\n\n" protocol_limit_warning;
5652         if List.mem DangerWillRobinson flags then
5653           pr "%s\n\n" danger_will_robinson;
5654         match deprecation_notice flags with
5655         | None -> ()
5656         | Some txt -> pr "%s\n\n" txt
5657       )
5658   ) all_functions_sorted
5659
5660 and generate_structs_pod () =
5661   (* Structs documentation. *)
5662   List.iter (
5663     fun (typ, cols) ->
5664       pr "=head2 guestfs_%s\n" typ;
5665       pr "\n";
5666       pr " struct guestfs_%s {\n" typ;
5667       List.iter (
5668         function
5669         | name, FChar -> pr "   char %s;\n" name
5670         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5671         | name, FInt32 -> pr "   int32_t %s;\n" name
5672         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5673         | name, FInt64 -> pr "   int64_t %s;\n" name
5674         | name, FString -> pr "   char *%s;\n" name
5675         | name, FBuffer ->
5676             pr "   /* The next two fields describe a byte array. */\n";
5677             pr "   uint32_t %s_len;\n" name;
5678             pr "   char *%s;\n" name
5679         | name, FUUID ->
5680             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5681             pr "   char %s[32];\n" name
5682         | name, FOptPercent ->
5683             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5684             pr "   float %s;\n" name
5685       ) cols;
5686       pr " };\n";
5687       pr " \n";
5688       pr " struct guestfs_%s_list {\n" typ;
5689       pr "   uint32_t len; /* Number of elements in list. */\n";
5690       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5691       pr " };\n";
5692       pr " \n";
5693       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5694       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5695         typ typ;
5696       pr "\n"
5697   ) structs
5698
5699 and generate_availability_pod () =
5700   (* Availability documentation. *)
5701   pr "=over 4\n";
5702   pr "\n";
5703   List.iter (
5704     fun (group, functions) ->
5705       pr "=item B<%s>\n" group;
5706       pr "\n";
5707       pr "The following functions:\n";
5708       List.iter (pr "L</guestfs_%s>\n") functions;
5709       pr "\n"
5710   ) optgroups;
5711   pr "=back\n";
5712   pr "\n"
5713
5714 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5715  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5716  *
5717  * We have to use an underscore instead of a dash because otherwise
5718  * rpcgen generates incorrect code.
5719  *
5720  * This header is NOT exported to clients, but see also generate_structs_h.
5721  *)
5722 and generate_xdr () =
5723   generate_header CStyle LGPLv2plus;
5724
5725   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5726   pr "typedef string guestfs_str<>;\n";
5727   pr "\n";
5728
5729   (* Internal structures. *)
5730   List.iter (
5731     function
5732     | typ, cols ->
5733         pr "struct guestfs_int_%s {\n" typ;
5734         List.iter (function
5735                    | name, FChar -> pr "  char %s;\n" name
5736                    | name, FString -> pr "  string %s<>;\n" name
5737                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5738                    | name, FUUID -> pr "  opaque %s[32];\n" name
5739                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5740                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5741                    | name, FOptPercent -> pr "  float %s;\n" name
5742                   ) cols;
5743         pr "};\n";
5744         pr "\n";
5745         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5746         pr "\n";
5747   ) structs;
5748
5749   List.iter (
5750     fun (shortname, style, _, _, _, _, _) ->
5751       let name = "guestfs_" ^ shortname in
5752
5753       (match snd style with
5754        | [] -> ()
5755        | args ->
5756            pr "struct %s_args {\n" name;
5757            List.iter (
5758              function
5759              | Pathname n | Device n | Dev_or_Path n | String n ->
5760                  pr "  string %s<>;\n" n
5761              | OptString n -> pr "  guestfs_str *%s;\n" n
5762              | StringList n | DeviceList n -> pr "  guestfs_str %s<>;\n" n
5763              | Bool n -> pr "  bool %s;\n" n
5764              | Int n -> pr "  int %s;\n" n
5765              | Int64 n -> pr "  hyper %s;\n" n
5766              | BufferIn n ->
5767                  pr "  opaque %s<>;\n" n
5768              | FileIn _ | FileOut _ -> ()
5769            ) args;
5770            pr "};\n\n"
5771       );
5772       (match fst style with
5773        | RErr -> ()
5774        | RInt n ->
5775            pr "struct %s_ret {\n" name;
5776            pr "  int %s;\n" n;
5777            pr "};\n\n"
5778        | RInt64 n ->
5779            pr "struct %s_ret {\n" name;
5780            pr "  hyper %s;\n" n;
5781            pr "};\n\n"
5782        | RBool n ->
5783            pr "struct %s_ret {\n" name;
5784            pr "  bool %s;\n" n;
5785            pr "};\n\n"
5786        | RConstString _ | RConstOptString _ ->
5787            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5788        | RString n ->
5789            pr "struct %s_ret {\n" name;
5790            pr "  string %s<>;\n" n;
5791            pr "};\n\n"
5792        | RStringList n ->
5793            pr "struct %s_ret {\n" name;
5794            pr "  guestfs_str %s<>;\n" n;
5795            pr "};\n\n"
5796        | RStruct (n, typ) ->
5797            pr "struct %s_ret {\n" name;
5798            pr "  guestfs_int_%s %s;\n" typ n;
5799            pr "};\n\n"
5800        | RStructList (n, typ) ->
5801            pr "struct %s_ret {\n" name;
5802            pr "  guestfs_int_%s_list %s;\n" typ n;
5803            pr "};\n\n"
5804        | RHashtable n ->
5805            pr "struct %s_ret {\n" name;
5806            pr "  guestfs_str %s<>;\n" n;
5807            pr "};\n\n"
5808        | RBufferOut n ->
5809            pr "struct %s_ret {\n" name;
5810            pr "  opaque %s<>;\n" n;
5811            pr "};\n\n"
5812       );
5813   ) daemon_functions;
5814
5815   (* Table of procedure numbers. *)
5816   pr "enum guestfs_procedure {\n";
5817   List.iter (
5818     fun (shortname, _, proc_nr, _, _, _, _) ->
5819       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5820   ) daemon_functions;
5821   pr "  GUESTFS_PROC_NR_PROCS\n";
5822   pr "};\n";
5823   pr "\n";
5824
5825   (* Having to choose a maximum message size is annoying for several
5826    * reasons (it limits what we can do in the API), but it (a) makes
5827    * the protocol a lot simpler, and (b) provides a bound on the size
5828    * of the daemon which operates in limited memory space.
5829    *)
5830   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5831   pr "\n";
5832
5833   (* Message header, etc. *)
5834   pr "\
5835 /* The communication protocol is now documented in the guestfs(3)
5836  * manpage.
5837  */
5838
5839 const GUESTFS_PROGRAM = 0x2000F5F5;
5840 const GUESTFS_PROTOCOL_VERSION = 1;
5841
5842 /* These constants must be larger than any possible message length. */
5843 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5844 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5845
5846 enum guestfs_message_direction {
5847   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5848   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5849 };
5850
5851 enum guestfs_message_status {
5852   GUESTFS_STATUS_OK = 0,
5853   GUESTFS_STATUS_ERROR = 1
5854 };
5855
5856 const GUESTFS_ERROR_LEN = 256;
5857
5858 struct guestfs_message_error {
5859   string error_message<GUESTFS_ERROR_LEN>;
5860 };
5861
5862 struct guestfs_message_header {
5863   unsigned prog;                     /* GUESTFS_PROGRAM */
5864   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5865   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5866   guestfs_message_direction direction;
5867   unsigned serial;                   /* message serial number */
5868   guestfs_message_status status;
5869 };
5870
5871 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5872
5873 struct guestfs_chunk {
5874   int cancel;                        /* if non-zero, transfer is cancelled */
5875   /* data size is 0 bytes if the transfer has finished successfully */
5876   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5877 };
5878 "
5879
5880 (* Generate the guestfs-structs.h file. *)
5881 and generate_structs_h () =
5882   generate_header CStyle LGPLv2plus;
5883
5884   (* This is a public exported header file containing various
5885    * structures.  The structures are carefully written to have
5886    * exactly the same in-memory format as the XDR structures that
5887    * we use on the wire to the daemon.  The reason for creating
5888    * copies of these structures here is just so we don't have to
5889    * export the whole of guestfs_protocol.h (which includes much
5890    * unrelated and XDR-dependent stuff that we don't want to be
5891    * public, or required by clients).
5892    *
5893    * To reiterate, we will pass these structures to and from the
5894    * client with a simple assignment or memcpy, so the format
5895    * must be identical to what rpcgen / the RFC defines.
5896    *)
5897
5898   (* Public structures. *)
5899   List.iter (
5900     fun (typ, cols) ->
5901       pr "struct guestfs_%s {\n" typ;
5902       List.iter (
5903         function
5904         | name, FChar -> pr "  char %s;\n" name
5905         | name, FString -> pr "  char *%s;\n" name
5906         | name, FBuffer ->
5907             pr "  uint32_t %s_len;\n" name;
5908             pr "  char *%s;\n" name
5909         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5910         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5911         | name, FInt32 -> pr "  int32_t %s;\n" name
5912         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5913         | name, FInt64 -> pr "  int64_t %s;\n" name
5914         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5915       ) cols;
5916       pr "};\n";
5917       pr "\n";
5918       pr "struct guestfs_%s_list {\n" typ;
5919       pr "  uint32_t len;\n";
5920       pr "  struct guestfs_%s *val;\n" typ;
5921       pr "};\n";
5922       pr "\n";
5923       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5924       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5925       pr "\n"
5926   ) structs
5927
5928 (* Generate the guestfs-actions.h file. *)
5929 and generate_actions_h () =
5930   generate_header CStyle LGPLv2plus;
5931   List.iter (
5932     fun (shortname, style, _, _, _, _, _) ->
5933       let name = "guestfs_" ^ shortname in
5934       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5935         name style
5936   ) all_functions
5937
5938 (* Generate the guestfs-internal-actions.h file. *)
5939 and generate_internal_actions_h () =
5940   generate_header CStyle LGPLv2plus;
5941   List.iter (
5942     fun (shortname, style, _, _, _, _, _) ->
5943       let name = "guestfs__" ^ shortname in
5944       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5945         name style
5946   ) non_daemon_functions
5947
5948 (* Generate the client-side dispatch stubs. *)
5949 and generate_client_actions () =
5950   generate_header CStyle LGPLv2plus;
5951
5952   pr "\
5953 #include <stdio.h>
5954 #include <stdlib.h>
5955 #include <stdint.h>
5956 #include <string.h>
5957 #include <inttypes.h>
5958
5959 #include \"guestfs.h\"
5960 #include \"guestfs-internal.h\"
5961 #include \"guestfs-internal-actions.h\"
5962 #include \"guestfs_protocol.h\"
5963
5964 /* Check the return message from a call for validity. */
5965 static int
5966 check_reply_header (guestfs_h *g,
5967                     const struct guestfs_message_header *hdr,
5968                     unsigned int proc_nr, unsigned int serial)
5969 {
5970   if (hdr->prog != GUESTFS_PROGRAM) {
5971     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5972     return -1;
5973   }
5974   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5975     error (g, \"wrong protocol version (%%d/%%d)\",
5976            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5977     return -1;
5978   }
5979   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5980     error (g, \"unexpected message direction (%%d/%%d)\",
5981            hdr->direction, GUESTFS_DIRECTION_REPLY);
5982     return -1;
5983   }
5984   if (hdr->proc != proc_nr) {
5985     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5986     return -1;
5987   }
5988   if (hdr->serial != serial) {
5989     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5990     return -1;
5991   }
5992
5993   return 0;
5994 }
5995
5996 /* Check we are in the right state to run a high-level action. */
5997 static int
5998 check_state (guestfs_h *g, const char *caller)
5999 {
6000   if (!guestfs__is_ready (g)) {
6001     if (guestfs__is_config (g) || guestfs__is_launching (g))
6002       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
6003         caller);
6004     else
6005       error (g, \"%%s called from the wrong state, %%d != READY\",
6006         caller, guestfs__get_state (g));
6007     return -1;
6008   }
6009   return 0;
6010 }
6011
6012 ";
6013
6014   let error_code_of = function
6015     | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
6016     | RConstString _ | RConstOptString _
6017     | RString _ | RStringList _
6018     | RStruct _ | RStructList _
6019     | RHashtable _ | RBufferOut _ -> "NULL"
6020   in
6021
6022   (* Generate code to check String-like parameters are not passed in
6023    * as NULL (returning an error if they are).
6024    *)
6025   let check_null_strings shortname style =
6026     let pr_newline = ref false in
6027     List.iter (
6028       function
6029       (* parameters which should not be NULL *)
6030       | String n
6031       | Device n
6032       | Pathname n
6033       | Dev_or_Path n
6034       | FileIn n
6035       | FileOut n
6036       | BufferIn n
6037       | StringList n
6038       | DeviceList n ->
6039           pr "  if (%s == NULL) {\n" n;
6040           pr "    error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
6041           pr "           \"%s\", \"%s\");\n" shortname n;
6042           pr "    return %s;\n" (error_code_of (fst style));
6043           pr "  }\n";
6044           pr_newline := true
6045
6046       (* can be NULL *)
6047       | OptString _
6048
6049       (* not applicable *)
6050       | Bool _
6051       | Int _
6052       | Int64 _ -> ()
6053     ) (snd style);
6054
6055     if !pr_newline then pr "\n";
6056   in
6057
6058   (* Generate code to generate guestfish call traces. *)
6059   let trace_call shortname style =
6060     pr "  if (guestfs__get_trace (g)) {\n";
6061
6062     let needs_i =
6063       List.exists (function
6064                    | StringList _ | DeviceList _ -> true
6065                    | _ -> false) (snd style) in
6066     if needs_i then (
6067       pr "    size_t i;\n";
6068       pr "\n"
6069     );
6070
6071     pr "    printf (\"%s\");\n" shortname;
6072     List.iter (
6073       function
6074       | String n                        (* strings *)
6075       | Device n
6076       | Pathname n
6077       | Dev_or_Path n
6078       | FileIn n
6079       | FileOut n
6080       | BufferIn n ->
6081           (* guestfish doesn't support string escaping, so neither do we *)
6082           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
6083       | OptString n ->                  (* string option *)
6084           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
6085           pr "    else printf (\" null\");\n"
6086       | StringList n
6087       | DeviceList n ->                 (* string list *)
6088           pr "    putchar (' ');\n";
6089           pr "    putchar ('\"');\n";
6090           pr "    for (i = 0; %s[i]; ++i) {\n" n;
6091           pr "      if (i > 0) putchar (' ');\n";
6092           pr "      fputs (%s[i], stdout);\n" n;
6093           pr "    }\n";
6094           pr "    putchar ('\"');\n";
6095       | Bool n ->                       (* boolean *)
6096           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
6097       | Int n ->                        (* int *)
6098           pr "    printf (\" %%d\", %s);\n" n
6099       | Int64 n ->
6100           pr "    printf (\" %%\" PRIi64, %s);\n" n
6101     ) (snd style);
6102     pr "    putchar ('\\n');\n";
6103     pr "  }\n";
6104     pr "\n";
6105   in
6106
6107   (* For non-daemon functions, generate a wrapper around each function. *)
6108   List.iter (
6109     fun (shortname, style, _, _, _, _, _) ->
6110       let name = "guestfs_" ^ shortname in
6111
6112       generate_prototype ~extern:false ~semicolon:false ~newline:true
6113         ~handle:"g" name style;
6114       pr "{\n";
6115       check_null_strings shortname style;
6116       trace_call shortname style;
6117       pr "  return guestfs__%s " shortname;
6118       generate_c_call_args ~handle:"g" style;
6119       pr ";\n";
6120       pr "}\n";
6121       pr "\n"
6122   ) non_daemon_functions;
6123
6124   (* Client-side stubs for each function. *)
6125   List.iter (
6126     fun (shortname, style, _, _, _, _, _) ->
6127       let name = "guestfs_" ^ shortname in
6128       let error_code = error_code_of (fst style) in
6129
6130       (* Generate the action stub. *)
6131       generate_prototype ~extern:false ~semicolon:false ~newline:true
6132         ~handle:"g" name style;
6133
6134       pr "{\n";
6135
6136       (match snd style with
6137        | [] -> ()
6138        | _ -> pr "  struct %s_args args;\n" name
6139       );
6140
6141       pr "  guestfs_message_header hdr;\n";
6142       pr "  guestfs_message_error err;\n";
6143       let has_ret =
6144         match fst style with
6145         | RErr -> false
6146         | RConstString _ | RConstOptString _ ->
6147             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6148         | RInt _ | RInt64 _
6149         | RBool _ | RString _ | RStringList _
6150         | RStruct _ | RStructList _
6151         | RHashtable _ | RBufferOut _ ->
6152             pr "  struct %s_ret ret;\n" name;
6153             true in
6154
6155       pr "  int serial;\n";
6156       pr "  int r;\n";
6157       pr "\n";
6158       check_null_strings shortname style;
6159       trace_call shortname style;
6160       pr "  if (check_state (g, \"%s\") == -1) return %s;\n"
6161         shortname error_code;
6162       pr "  guestfs___set_busy (g);\n";
6163       pr "\n";
6164
6165       (* Send the main header and arguments. *)
6166       (match snd style with
6167        | [] ->
6168            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
6169              (String.uppercase shortname)
6170        | args ->
6171            List.iter (
6172              function
6173              | Pathname n | Device n | Dev_or_Path n | String n ->
6174                  pr "  args.%s = (char *) %s;\n" n n
6175              | OptString n ->
6176                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
6177              | StringList n | DeviceList n ->
6178                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
6179                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
6180              | Bool n ->
6181                  pr "  args.%s = %s;\n" n n
6182              | Int n ->
6183                  pr "  args.%s = %s;\n" n n
6184              | Int64 n ->
6185                  pr "  args.%s = %s;\n" n n
6186              | FileIn _ | FileOut _ -> ()
6187              | BufferIn n ->
6188                  pr "  /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
6189                  pr "  if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
6190                  pr "    error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
6191                    shortname;
6192                  pr "    guestfs___end_busy (g);\n";
6193                  pr "    return %s;\n" error_code;
6194                  pr "  }\n";
6195                  pr "  args.%s.%s_val = (char *) %s;\n" n n n;
6196                  pr "  args.%s.%s_len = %s_size;\n" n n n
6197            ) args;
6198            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
6199              (String.uppercase shortname);
6200            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
6201              name;
6202       );
6203       pr "  if (serial == -1) {\n";
6204       pr "    guestfs___end_busy (g);\n";
6205       pr "    return %s;\n" error_code;
6206       pr "  }\n";
6207       pr "\n";
6208
6209       (* Send any additional files (FileIn) requested. *)
6210       let need_read_reply_label = ref false in
6211       List.iter (
6212         function
6213         | FileIn n ->
6214             pr "  r = guestfs___send_file (g, %s);\n" n;
6215             pr "  if (r == -1) {\n";
6216             pr "    guestfs___end_busy (g);\n";
6217             pr "    return %s;\n" error_code;
6218             pr "  }\n";
6219             pr "  if (r == -2) /* daemon cancelled */\n";
6220             pr "    goto read_reply;\n";
6221             need_read_reply_label := true;
6222             pr "\n";
6223         | _ -> ()
6224       ) (snd style);
6225
6226       (* Wait for the reply from the remote end. *)
6227       if !need_read_reply_label then pr " read_reply:\n";
6228       pr "  memset (&hdr, 0, sizeof hdr);\n";
6229       pr "  memset (&err, 0, sizeof err);\n";
6230       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
6231       pr "\n";
6232       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
6233       if not has_ret then
6234         pr "NULL, NULL"
6235       else
6236         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
6237       pr ");\n";
6238
6239       pr "  if (r == -1) {\n";
6240       pr "    guestfs___end_busy (g);\n";
6241       pr "    return %s;\n" error_code;
6242       pr "  }\n";
6243       pr "\n";
6244
6245       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
6246         (String.uppercase shortname);
6247       pr "    guestfs___end_busy (g);\n";
6248       pr "    return %s;\n" error_code;
6249       pr "  }\n";
6250       pr "\n";
6251
6252       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
6253       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
6254       pr "    free (err.error_message);\n";
6255       pr "    guestfs___end_busy (g);\n";
6256       pr "    return %s;\n" error_code;
6257       pr "  }\n";
6258       pr "\n";
6259
6260       (* Expecting to receive further files (FileOut)? *)
6261       List.iter (
6262         function
6263         | FileOut n ->
6264             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
6265             pr "    guestfs___end_busy (g);\n";
6266             pr "    return %s;\n" error_code;
6267             pr "  }\n";
6268             pr "\n";
6269         | _ -> ()
6270       ) (snd style);
6271
6272       pr "  guestfs___end_busy (g);\n";
6273
6274       (match fst style with
6275        | RErr -> pr "  return 0;\n"
6276        | RInt n | RInt64 n | RBool n ->
6277            pr "  return ret.%s;\n" n
6278        | RConstString _ | RConstOptString _ ->
6279            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6280        | RString n ->
6281            pr "  return ret.%s; /* caller will free */\n" n
6282        | RStringList n | RHashtable n ->
6283            pr "  /* caller will free this, but we need to add a NULL entry */\n";
6284            pr "  ret.%s.%s_val =\n" n n;
6285            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
6286            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
6287              n n;
6288            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
6289            pr "  return ret.%s.%s_val;\n" n n
6290        | RStruct (n, _) ->
6291            pr "  /* caller will free this */\n";
6292            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
6293        | RStructList (n, _) ->
6294            pr "  /* caller will free this */\n";
6295            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
6296        | RBufferOut n ->
6297            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
6298            pr "   * _val might be NULL here.  To make the API saner for\n";
6299            pr "   * callers, we turn this case into a unique pointer (using\n";
6300            pr "   * malloc(1)).\n";
6301            pr "   */\n";
6302            pr "  if (ret.%s.%s_len > 0) {\n" n n;
6303            pr "    *size_r = ret.%s.%s_len;\n" n n;
6304            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
6305            pr "  } else {\n";
6306            pr "    free (ret.%s.%s_val);\n" n n;
6307            pr "    char *p = safe_malloc (g, 1);\n";
6308            pr "    *size_r = ret.%s.%s_len;\n" n n;
6309            pr "    return p;\n";
6310            pr "  }\n";
6311       );
6312
6313       pr "}\n\n"
6314   ) daemon_functions;
6315
6316   (* Functions to free structures. *)
6317   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
6318   pr " * structure format is identical to the XDR format.  See note in\n";
6319   pr " * generator.ml.\n";
6320   pr " */\n";
6321   pr "\n";
6322
6323   List.iter (
6324     fun (typ, _) ->
6325       pr "void\n";
6326       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
6327       pr "{\n";
6328       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
6329       pr "  free (x);\n";
6330       pr "}\n";
6331       pr "\n";
6332
6333       pr "void\n";
6334       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
6335       pr "{\n";
6336       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
6337       pr "  free (x);\n";
6338       pr "}\n";
6339       pr "\n";
6340
6341   ) structs;
6342
6343 (* Generate daemon/actions.h. *)
6344 and generate_daemon_actions_h () =
6345   generate_header CStyle GPLv2plus;
6346
6347   pr "#include \"../src/guestfs_protocol.h\"\n";
6348   pr "\n";
6349
6350   List.iter (
6351     fun (name, style, _, _, _, _, _) ->
6352       generate_prototype
6353         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
6354         name style;
6355   ) daemon_functions
6356
6357 (* Generate the linker script which controls the visibility of
6358  * symbols in the public ABI and ensures no other symbols get
6359  * exported accidentally.
6360  *)
6361 and generate_linker_script () =
6362   generate_header HashStyle GPLv2plus;
6363
6364   let globals = [
6365     "guestfs_create";
6366     "guestfs_close";
6367     "guestfs_get_error_handler";
6368     "guestfs_get_out_of_memory_handler";
6369     "guestfs_last_error";
6370     "guestfs_set_close_callback";
6371     "guestfs_set_error_handler";
6372     "guestfs_set_launch_done_callback";
6373     "guestfs_set_log_message_callback";
6374     "guestfs_set_out_of_memory_handler";
6375     "guestfs_set_subprocess_quit_callback";
6376
6377     (* Unofficial parts of the API: the bindings code use these
6378      * functions, so it is useful to export them.
6379      *)
6380     "guestfs_safe_calloc";
6381     "guestfs_safe_malloc";
6382     "guestfs_safe_strdup";
6383     "guestfs_safe_memdup";
6384   ] in
6385   let functions =
6386     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
6387       all_functions in
6388   let structs =
6389     List.concat (
6390       List.map (fun (typ, _) ->
6391                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
6392         structs
6393     ) in
6394   let globals = List.sort compare (globals @ functions @ structs) in
6395
6396   pr "{\n";
6397   pr "    global:\n";
6398   List.iter (pr "        %s;\n") globals;
6399   pr "\n";
6400
6401   pr "    local:\n";
6402   pr "        *;\n";
6403   pr "};\n"
6404
6405 (* Generate the server-side stubs. *)
6406 and generate_daemon_actions () =
6407   generate_header CStyle GPLv2plus;
6408
6409   pr "#include <config.h>\n";
6410   pr "\n";
6411   pr "#include <stdio.h>\n";
6412   pr "#include <stdlib.h>\n";
6413   pr "#include <string.h>\n";
6414   pr "#include <inttypes.h>\n";
6415   pr "#include <rpc/types.h>\n";
6416   pr "#include <rpc/xdr.h>\n";
6417   pr "\n";
6418   pr "#include \"daemon.h\"\n";
6419   pr "#include \"c-ctype.h\"\n";
6420   pr "#include \"../src/guestfs_protocol.h\"\n";
6421   pr "#include \"actions.h\"\n";
6422   pr "\n";
6423
6424   List.iter (
6425     fun (name, style, _, _, _, _, _) ->
6426       (* Generate server-side stubs. *)
6427       pr "static void %s_stub (XDR *xdr_in)\n" name;
6428       pr "{\n";
6429       let error_code =
6430         match fst style with
6431         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6432         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6433         | RBool _ -> pr "  int r;\n"; "-1"
6434         | RConstString _ | RConstOptString _ ->
6435             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6436         | RString _ -> pr "  char *r;\n"; "NULL"
6437         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6438         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6439         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6440         | RBufferOut _ ->
6441             pr "  size_t size = 1;\n";
6442             pr "  char *r;\n";
6443             "NULL" in
6444
6445       (match snd style with
6446        | [] -> ()
6447        | args ->
6448            pr "  struct guestfs_%s_args args;\n" name;
6449            List.iter (
6450              function
6451              | Device n | Dev_or_Path n
6452              | Pathname n
6453              | String n -> ()
6454              | OptString n -> pr "  char *%s;\n" n
6455              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6456              | Bool n -> pr "  int %s;\n" n
6457              | Int n -> pr "  int %s;\n" n
6458              | Int64 n -> pr "  int64_t %s;\n" n
6459              | FileIn _ | FileOut _ -> ()
6460              | BufferIn n ->
6461                  pr "  const char *%s;\n" n;
6462                  pr "  size_t %s_size;\n" n
6463            ) args
6464       );
6465       pr "\n";
6466
6467       let is_filein =
6468         List.exists (function FileIn _ -> true | _ -> false) (snd style) in
6469
6470       (match snd style with
6471        | [] -> ()
6472        | args ->
6473            pr "  memset (&args, 0, sizeof args);\n";
6474            pr "\n";
6475            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6476            if is_filein then
6477              pr "    if (cancel_receive () != -2)\n";
6478            pr "      reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6479            pr "    goto done;\n";
6480            pr "  }\n";
6481            let pr_args n =
6482              pr "  char *%s = args.%s;\n" n n
6483            in
6484            let pr_list_handling_code n =
6485              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6486              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6487              pr "  if (%s == NULL) {\n" n;
6488              if is_filein then
6489                pr "    if (cancel_receive () != -2)\n";
6490              pr "      reply_with_perror (\"realloc\");\n";
6491              pr "    goto done;\n";
6492              pr "  }\n";
6493              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6494              pr "  args.%s.%s_val = %s;\n" n n n;
6495            in
6496            List.iter (
6497              function
6498              | Pathname n ->
6499                  pr_args n;
6500                  pr "  ABS_PATH (%s, %s, goto done);\n"
6501                    n (if is_filein then "cancel_receive ()" else "0");
6502              | Device n ->
6503                  pr_args n;
6504                  pr "  RESOLVE_DEVICE (%s, %s, goto done);\n"
6505                    n (if is_filein then "cancel_receive ()" else "0");
6506              | Dev_or_Path n ->
6507                  pr_args n;
6508                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, %s, goto done);\n"
6509                    n (if is_filein then "cancel_receive ()" else "0");
6510              | String n -> pr_args n
6511              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6512              | StringList n ->
6513                  pr_list_handling_code n;
6514              | DeviceList n ->
6515                  pr_list_handling_code n;
6516                  pr "  /* Ensure that each is a device,\n";
6517                  pr "   * and perform device name translation.\n";
6518                  pr "   */\n";
6519                  pr "  {\n";
6520                  pr "    size_t i;\n";
6521                  pr "    for (i = 0; %s[i] != NULL; ++i)\n" n;
6522                  pr "      RESOLVE_DEVICE (%s[i], %s, goto done);\n" n
6523                    (if is_filein then "cancel_receive ()" else "0");
6524                  pr "  }\n";
6525              | Bool n -> pr "  %s = args.%s;\n" n n
6526              | Int n -> pr "  %s = args.%s;\n" n n
6527              | Int64 n -> pr "  %s = args.%s;\n" n n
6528              | FileIn _ | FileOut _ -> ()
6529              | BufferIn n ->
6530                  pr "  %s = args.%s.%s_val;\n" n n n;
6531                  pr "  %s_size = args.%s.%s_len;\n" n n n
6532            ) args;
6533            pr "\n"
6534       );
6535
6536       (* this is used at least for do_equal *)
6537       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6538         (* Emit NEED_ROOT just once, even when there are two or
6539            more Pathname args *)
6540         pr "  NEED_ROOT (%s, goto done);\n"
6541           (if is_filein then "cancel_receive ()" else "0");
6542       );
6543
6544       (* Don't want to call the impl with any FileIn or FileOut
6545        * parameters, since these go "outside" the RPC protocol.
6546        *)
6547       let args' =
6548         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6549           (snd style) in
6550       pr "  r = do_%s " name;
6551       generate_c_call_args (fst style, args');
6552       pr ";\n";
6553
6554       (match fst style with
6555        | RErr | RInt _ | RInt64 _ | RBool _
6556        | RConstString _ | RConstOptString _
6557        | RString _ | RStringList _ | RHashtable _
6558        | RStruct (_, _) | RStructList (_, _) ->
6559            pr "  if (r == %s)\n" error_code;
6560            pr "    /* do_%s has already called reply_with_error */\n" name;
6561            pr "    goto done;\n";
6562            pr "\n"
6563        | RBufferOut _ ->
6564            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6565            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6566            pr "   */\n";
6567            pr "  if (size == 1 && r == %s)\n" error_code;
6568            pr "    /* do_%s has already called reply_with_error */\n" name;
6569            pr "    goto done;\n";
6570            pr "\n"
6571       );
6572
6573       (* If there are any FileOut parameters, then the impl must
6574        * send its own reply.
6575        *)
6576       let no_reply =
6577         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6578       if no_reply then
6579         pr "  /* do_%s has already sent a reply */\n" name
6580       else (
6581         match fst style with
6582         | RErr -> pr "  reply (NULL, NULL);\n"
6583         | RInt n | RInt64 n | RBool n ->
6584             pr "  struct guestfs_%s_ret ret;\n" name;
6585             pr "  ret.%s = r;\n" n;
6586             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6587               name
6588         | RConstString _ | RConstOptString _ ->
6589             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6590         | RString n ->
6591             pr "  struct guestfs_%s_ret ret;\n" name;
6592             pr "  ret.%s = r;\n" n;
6593             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6594               name;
6595             pr "  free (r);\n"
6596         | RStringList n | RHashtable n ->
6597             pr "  struct guestfs_%s_ret ret;\n" name;
6598             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6599             pr "  ret.%s.%s_val = r;\n" n n;
6600             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6601               name;
6602             pr "  free_strings (r);\n"
6603         | RStruct (n, _) ->
6604             pr "  struct guestfs_%s_ret ret;\n" name;
6605             pr "  ret.%s = *r;\n" n;
6606             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6607               name;
6608             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6609               name
6610         | RStructList (n, _) ->
6611             pr "  struct guestfs_%s_ret ret;\n" name;
6612             pr "  ret.%s = *r;\n" n;
6613             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6614               name;
6615             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6616               name
6617         | RBufferOut n ->
6618             pr "  struct guestfs_%s_ret ret;\n" name;
6619             pr "  ret.%s.%s_val = r;\n" n n;
6620             pr "  ret.%s.%s_len = size;\n" n n;
6621             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6622               name;
6623             pr "  free (r);\n"
6624       );
6625
6626       (* Free the args. *)
6627       pr "done:\n";
6628       (match snd style with
6629        | [] -> ()
6630        | _ ->
6631            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6632              name
6633       );
6634       pr "  return;\n";
6635       pr "}\n\n";
6636   ) daemon_functions;
6637
6638   (* Dispatch function. *)
6639   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6640   pr "{\n";
6641   pr "  switch (proc_nr) {\n";
6642
6643   List.iter (
6644     fun (name, style, _, _, _, _, _) ->
6645       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6646       pr "      %s_stub (xdr_in);\n" name;
6647       pr "      break;\n"
6648   ) daemon_functions;
6649
6650   pr "    default:\n";
6651   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";
6652   pr "  }\n";
6653   pr "}\n";
6654   pr "\n";
6655
6656   (* LVM columns and tokenization functions. *)
6657   (* XXX This generates crap code.  We should rethink how we
6658    * do this parsing.
6659    *)
6660   List.iter (
6661     function
6662     | typ, cols ->
6663         pr "static const char *lvm_%s_cols = \"%s\";\n"
6664           typ (String.concat "," (List.map fst cols));
6665         pr "\n";
6666
6667         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6668         pr "{\n";
6669         pr "  char *tok, *p, *next;\n";
6670         pr "  size_t i, j;\n";
6671         pr "\n";
6672         (*
6673           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6674           pr "\n";
6675         *)
6676         pr "  if (!str) {\n";
6677         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6678         pr "    return -1;\n";
6679         pr "  }\n";
6680         pr "  if (!*str || c_isspace (*str)) {\n";
6681         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6682         pr "    return -1;\n";
6683         pr "  }\n";
6684         pr "  tok = str;\n";
6685         List.iter (
6686           fun (name, coltype) ->
6687             pr "  if (!tok) {\n";
6688             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6689             pr "    return -1;\n";
6690             pr "  }\n";
6691             pr "  p = strchrnul (tok, ',');\n";
6692             pr "  if (*p) next = p+1; else next = NULL;\n";
6693             pr "  *p = '\\0';\n";
6694             (match coltype with
6695              | FString ->
6696                  pr "  r->%s = strdup (tok);\n" name;
6697                  pr "  if (r->%s == NULL) {\n" name;
6698                  pr "    perror (\"strdup\");\n";
6699                  pr "    return -1;\n";
6700                  pr "  }\n"
6701              | FUUID ->
6702                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6703                  pr "    if (tok[j] == '\\0') {\n";
6704                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6705                  pr "      return -1;\n";
6706                  pr "    } else if (tok[j] != '-')\n";
6707                  pr "      r->%s[i++] = tok[j];\n" name;
6708                  pr "  }\n";
6709              | FBytes ->
6710                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6711                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6712                  pr "    return -1;\n";
6713                  pr "  }\n";
6714              | FInt64 ->
6715                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6716                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6717                  pr "    return -1;\n";
6718                  pr "  }\n";
6719              | FOptPercent ->
6720                  pr "  if (tok[0] == '\\0')\n";
6721                  pr "    r->%s = -1;\n" name;
6722                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6723                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6724                  pr "    return -1;\n";
6725                  pr "  }\n";
6726              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6727                  assert false (* can never be an LVM column *)
6728             );
6729             pr "  tok = next;\n";
6730         ) cols;
6731
6732         pr "  if (tok != NULL) {\n";
6733         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6734         pr "    return -1;\n";
6735         pr "  }\n";
6736         pr "  return 0;\n";
6737         pr "}\n";
6738         pr "\n";
6739
6740         pr "guestfs_int_lvm_%s_list *\n" typ;
6741         pr "parse_command_line_%ss (void)\n" typ;
6742         pr "{\n";
6743         pr "  char *out, *err;\n";
6744         pr "  char *p, *pend;\n";
6745         pr "  int r, i;\n";
6746         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6747         pr "  void *newp;\n";
6748         pr "\n";
6749         pr "  ret = malloc (sizeof *ret);\n";
6750         pr "  if (!ret) {\n";
6751         pr "    reply_with_perror (\"malloc\");\n";
6752         pr "    return NULL;\n";
6753         pr "  }\n";
6754         pr "\n";
6755         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6756         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6757         pr "\n";
6758         pr "  r = command (&out, &err,\n";
6759         pr "           \"lvm\", \"%ss\",\n" typ;
6760         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6761         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6762         pr "  if (r == -1) {\n";
6763         pr "    reply_with_error (\"%%s\", err);\n";
6764         pr "    free (out);\n";
6765         pr "    free (err);\n";
6766         pr "    free (ret);\n";
6767         pr "    return NULL;\n";
6768         pr "  }\n";
6769         pr "\n";
6770         pr "  free (err);\n";
6771         pr "\n";
6772         pr "  /* Tokenize each line of the output. */\n";
6773         pr "  p = out;\n";
6774         pr "  i = 0;\n";
6775         pr "  while (p) {\n";
6776         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6777         pr "    if (pend) {\n";
6778         pr "      *pend = '\\0';\n";
6779         pr "      pend++;\n";
6780         pr "    }\n";
6781         pr "\n";
6782         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6783         pr "      p++;\n";
6784         pr "\n";
6785         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6786         pr "      p = pend;\n";
6787         pr "      continue;\n";
6788         pr "    }\n";
6789         pr "\n";
6790         pr "    /* Allocate some space to store this next entry. */\n";
6791         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6792         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6793         pr "    if (newp == NULL) {\n";
6794         pr "      reply_with_perror (\"realloc\");\n";
6795         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6796         pr "      free (ret);\n";
6797         pr "      free (out);\n";
6798         pr "      return NULL;\n";
6799         pr "    }\n";
6800         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6801         pr "\n";
6802         pr "    /* Tokenize the next entry. */\n";
6803         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6804         pr "    if (r == -1) {\n";
6805         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6806         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6807         pr "      free (ret);\n";
6808         pr "      free (out);\n";
6809         pr "      return NULL;\n";
6810         pr "    }\n";
6811         pr "\n";
6812         pr "    ++i;\n";
6813         pr "    p = pend;\n";
6814         pr "  }\n";
6815         pr "\n";
6816         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6817         pr "\n";
6818         pr "  free (out);\n";
6819         pr "  return ret;\n";
6820         pr "}\n"
6821
6822   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6823
6824 (* Generate a list of function names, for debugging in the daemon.. *)
6825 and generate_daemon_names () =
6826   generate_header CStyle GPLv2plus;
6827
6828   pr "#include <config.h>\n";
6829   pr "\n";
6830   pr "#include \"daemon.h\"\n";
6831   pr "\n";
6832
6833   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6834   pr "const char *function_names[] = {\n";
6835   List.iter (
6836     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6837   ) daemon_functions;
6838   pr "};\n";
6839
6840 (* Generate the optional groups for the daemon to implement
6841  * guestfs_available.
6842  *)
6843 and generate_daemon_optgroups_c () =
6844   generate_header CStyle GPLv2plus;
6845
6846   pr "#include <config.h>\n";
6847   pr "\n";
6848   pr "#include \"daemon.h\"\n";
6849   pr "#include \"optgroups.h\"\n";
6850   pr "\n";
6851
6852   pr "struct optgroup optgroups[] = {\n";
6853   List.iter (
6854     fun (group, _) ->
6855       pr "  { \"%s\", optgroup_%s_available },\n" group group
6856   ) optgroups;
6857   pr "  { NULL, NULL }\n";
6858   pr "};\n"
6859
6860 and generate_daemon_optgroups_h () =
6861   generate_header CStyle GPLv2plus;
6862
6863   List.iter (
6864     fun (group, _) ->
6865       pr "extern int optgroup_%s_available (void);\n" group
6866   ) optgroups
6867
6868 (* Generate the tests. *)
6869 and generate_tests () =
6870   generate_header CStyle GPLv2plus;
6871
6872   pr "\
6873 #include <stdio.h>
6874 #include <stdlib.h>
6875 #include <string.h>
6876 #include <unistd.h>
6877 #include <sys/types.h>
6878 #include <fcntl.h>
6879
6880 #include \"guestfs.h\"
6881 #include \"guestfs-internal.h\"
6882
6883 static guestfs_h *g;
6884 static int suppress_error = 0;
6885
6886 static void print_error (guestfs_h *g, void *data, const char *msg)
6887 {
6888   if (!suppress_error)
6889     fprintf (stderr, \"%%s\\n\", msg);
6890 }
6891
6892 /* FIXME: nearly identical code appears in fish.c */
6893 static void print_strings (char *const *argv)
6894 {
6895   size_t argc;
6896
6897   for (argc = 0; argv[argc] != NULL; ++argc)
6898     printf (\"\\t%%s\\n\", argv[argc]);
6899 }
6900
6901 /*
6902 static void print_table (char const *const *argv)
6903 {
6904   size_t i;
6905
6906   for (i = 0; argv[i] != NULL; i += 2)
6907     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6908 }
6909 */
6910
6911 static int
6912 is_available (const char *group)
6913 {
6914   const char *groups[] = { group, NULL };
6915   int r;
6916
6917   suppress_error = 1;
6918   r = guestfs_available (g, (char **) groups);
6919   suppress_error = 0;
6920
6921   return r == 0;
6922 }
6923
6924 static void
6925 incr (guestfs_h *g, void *iv)
6926 {
6927   int *i = (int *) iv;
6928   (*i)++;
6929 }
6930
6931 ";
6932
6933   (* Generate a list of commands which are not tested anywhere. *)
6934   pr "static void no_test_warnings (void)\n";
6935   pr "{\n";
6936
6937   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6938   List.iter (
6939     fun (_, _, _, _, tests, _, _) ->
6940       let tests = filter_map (
6941         function
6942         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
6943         | (_, Disabled, _) -> None
6944       ) tests in
6945       let seq = List.concat (List.map seq_of_test tests) in
6946       let cmds_tested = List.map List.hd seq in
6947       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6948   ) all_functions;
6949
6950   List.iter (
6951     fun (name, _, _, _, _, _, _) ->
6952       if not (Hashtbl.mem hash name) then
6953         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6954   ) all_functions;
6955
6956   pr "}\n";
6957   pr "\n";
6958
6959   (* Generate the actual tests.  Note that we generate the tests
6960    * in reverse order, deliberately, so that (in general) the
6961    * newest tests run first.  This makes it quicker and easier to
6962    * debug them.
6963    *)
6964   let test_names =
6965     List.map (
6966       fun (name, _, _, flags, tests, _, _) ->
6967         mapi (generate_one_test name flags) tests
6968     ) (List.rev all_functions) in
6969   let test_names = List.concat test_names in
6970   let nr_tests = List.length test_names in
6971
6972   pr "\
6973 int main (int argc, char *argv[])
6974 {
6975   char c = 0;
6976   unsigned long int n_failed = 0;
6977   const char *filename;
6978   int fd;
6979   int nr_tests, test_num = 0;
6980
6981   setbuf (stdout, NULL);
6982
6983   no_test_warnings ();
6984
6985   g = guestfs_create ();
6986   if (g == NULL) {
6987     printf (\"guestfs_create FAILED\\n\");
6988     exit (EXIT_FAILURE);
6989   }
6990
6991   guestfs_set_error_handler (g, print_error, NULL);
6992
6993   guestfs_set_path (g, \"../appliance\");
6994
6995   filename = \"test1.img\";
6996   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6997   if (fd == -1) {
6998     perror (filename);
6999     exit (EXIT_FAILURE);
7000   }
7001   if (lseek (fd, %d, SEEK_SET) == -1) {
7002     perror (\"lseek\");
7003     close (fd);
7004     unlink (filename);
7005     exit (EXIT_FAILURE);
7006   }
7007   if (write (fd, &c, 1) == -1) {
7008     perror (\"write\");
7009     close (fd);
7010     unlink (filename);
7011     exit (EXIT_FAILURE);
7012   }
7013   if (close (fd) == -1) {
7014     perror (filename);
7015     unlink (filename);
7016     exit (EXIT_FAILURE);
7017   }
7018   if (guestfs_add_drive (g, filename) == -1) {
7019     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
7020     exit (EXIT_FAILURE);
7021   }
7022
7023   filename = \"test2.img\";
7024   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
7025   if (fd == -1) {
7026     perror (filename);
7027     exit (EXIT_FAILURE);
7028   }
7029   if (lseek (fd, %d, SEEK_SET) == -1) {
7030     perror (\"lseek\");
7031     close (fd);
7032     unlink (filename);
7033     exit (EXIT_FAILURE);
7034   }
7035   if (write (fd, &c, 1) == -1) {
7036     perror (\"write\");
7037     close (fd);
7038     unlink (filename);
7039     exit (EXIT_FAILURE);
7040   }
7041   if (close (fd) == -1) {
7042     perror (filename);
7043     unlink (filename);
7044     exit (EXIT_FAILURE);
7045   }
7046   if (guestfs_add_drive (g, filename) == -1) {
7047     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
7048     exit (EXIT_FAILURE);
7049   }
7050
7051   filename = \"test3.img\";
7052   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
7053   if (fd == -1) {
7054     perror (filename);
7055     exit (EXIT_FAILURE);
7056   }
7057   if (lseek (fd, %d, SEEK_SET) == -1) {
7058     perror (\"lseek\");
7059     close (fd);
7060     unlink (filename);
7061     exit (EXIT_FAILURE);
7062   }
7063   if (write (fd, &c, 1) == -1) {
7064     perror (\"write\");
7065     close (fd);
7066     unlink (filename);
7067     exit (EXIT_FAILURE);
7068   }
7069   if (close (fd) == -1) {
7070     perror (filename);
7071     unlink (filename);
7072     exit (EXIT_FAILURE);
7073   }
7074   if (guestfs_add_drive (g, filename) == -1) {
7075     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
7076     exit (EXIT_FAILURE);
7077   }
7078
7079   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
7080     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
7081     exit (EXIT_FAILURE);
7082   }
7083
7084   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
7085   alarm (600);
7086
7087   if (guestfs_launch (g) == -1) {
7088     printf (\"guestfs_launch FAILED\\n\");
7089     exit (EXIT_FAILURE);
7090   }
7091
7092   /* Cancel previous alarm. */
7093   alarm (0);
7094
7095   nr_tests = %d;
7096
7097 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
7098
7099   iteri (
7100     fun i test_name ->
7101       pr "  test_num++;\n";
7102       pr "  if (guestfs_get_verbose (g))\n";
7103       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
7104       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
7105       pr "  if (%s () == -1) {\n" test_name;
7106       pr "    printf (\"%s FAILED\\n\");\n" test_name;
7107       pr "    n_failed++;\n";
7108       pr "  }\n";
7109   ) test_names;
7110   pr "\n";
7111
7112   pr "  /* Check close callback is called. */
7113   int close_sentinel = 1;
7114   guestfs_set_close_callback (g, incr, &close_sentinel);
7115
7116   guestfs_close (g);
7117
7118   if (close_sentinel != 2) {
7119     fprintf (stderr, \"close callback was not called\\n\");
7120     exit (EXIT_FAILURE);
7121   }
7122
7123   unlink (\"test1.img\");
7124   unlink (\"test2.img\");
7125   unlink (\"test3.img\");
7126
7127 ";
7128
7129   pr "  if (n_failed > 0) {\n";
7130   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
7131   pr "    exit (EXIT_FAILURE);\n";
7132   pr "  }\n";
7133   pr "\n";
7134
7135   pr "  exit (EXIT_SUCCESS);\n";
7136   pr "}\n"
7137
7138 and generate_one_test name flags i (init, prereq, test) =
7139   let test_name = sprintf "test_%s_%d" name i in
7140
7141   pr "\
7142 static int %s_skip (void)
7143 {
7144   const char *str;
7145
7146   str = getenv (\"TEST_ONLY\");
7147   if (str)
7148     return strstr (str, \"%s\") == NULL;
7149   str = getenv (\"SKIP_%s\");
7150   if (str && STREQ (str, \"1\")) return 1;
7151   str = getenv (\"SKIP_TEST_%s\");
7152   if (str && STREQ (str, \"1\")) return 1;
7153   return 0;
7154 }
7155
7156 " test_name name (String.uppercase test_name) (String.uppercase name);
7157
7158   (match prereq with
7159    | Disabled | Always | IfAvailable _ -> ()
7160    | If code | Unless code ->
7161        pr "static int %s_prereq (void)\n" test_name;
7162        pr "{\n";
7163        pr "  %s\n" code;
7164        pr "}\n";
7165        pr "\n";
7166   );
7167
7168   pr "\
7169 static int %s (void)
7170 {
7171   if (%s_skip ()) {
7172     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
7173     return 0;
7174   }
7175
7176 " test_name test_name test_name;
7177
7178   (* Optional functions should only be tested if the relevant
7179    * support is available in the daemon.
7180    *)
7181   List.iter (
7182     function
7183     | Optional group ->
7184         pr "  if (!is_available (\"%s\")) {\n" group;
7185         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
7186         pr "    return 0;\n";
7187         pr "  }\n";
7188     | _ -> ()
7189   ) flags;
7190
7191   (match prereq with
7192    | Disabled ->
7193        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
7194    | If _ ->
7195        pr "  if (! %s_prereq ()) {\n" test_name;
7196        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
7197        pr "    return 0;\n";
7198        pr "  }\n";
7199        pr "\n";
7200        generate_one_test_body name i test_name init test;
7201    | Unless _ ->
7202        pr "  if (%s_prereq ()) {\n" test_name;
7203        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
7204        pr "    return 0;\n";
7205        pr "  }\n";
7206        pr "\n";
7207        generate_one_test_body name i test_name init test;
7208    | IfAvailable group ->
7209        pr "  if (!is_available (\"%s\")) {\n" group;
7210        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
7211        pr "    return 0;\n";
7212        pr "  }\n";
7213        pr "\n";
7214        generate_one_test_body name i test_name init test;
7215    | Always ->
7216        generate_one_test_body name i test_name init test
7217   );
7218
7219   pr "  return 0;\n";
7220   pr "}\n";
7221   pr "\n";
7222   test_name
7223
7224 and generate_one_test_body name i test_name init test =
7225   (match init with
7226    | InitNone (* XXX at some point, InitNone and InitEmpty became
7227                * folded together as the same thing.  Really we should
7228                * make InitNone do nothing at all, but the tests may
7229                * need to be checked to make sure this is OK.
7230                *)
7231    | InitEmpty ->
7232        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
7233        List.iter (generate_test_command_call test_name)
7234          [["blockdev_setrw"; "/dev/sda"];
7235           ["umount_all"];
7236           ["lvm_remove_all"]]
7237    | InitPartition ->
7238        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
7239        List.iter (generate_test_command_call test_name)
7240          [["blockdev_setrw"; "/dev/sda"];
7241           ["umount_all"];
7242           ["lvm_remove_all"];
7243           ["part_disk"; "/dev/sda"; "mbr"]]
7244    | InitBasicFS ->
7245        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
7246        List.iter (generate_test_command_call test_name)
7247          [["blockdev_setrw"; "/dev/sda"];
7248           ["umount_all"];
7249           ["lvm_remove_all"];
7250           ["part_disk"; "/dev/sda"; "mbr"];
7251           ["mkfs"; "ext2"; "/dev/sda1"];
7252           ["mount_options"; ""; "/dev/sda1"; "/"]]
7253    | InitBasicFSonLVM ->
7254        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
7255          test_name;
7256        List.iter (generate_test_command_call test_name)
7257          [["blockdev_setrw"; "/dev/sda"];
7258           ["umount_all"];
7259           ["lvm_remove_all"];
7260           ["part_disk"; "/dev/sda"; "mbr"];
7261           ["pvcreate"; "/dev/sda1"];
7262           ["vgcreate"; "VG"; "/dev/sda1"];
7263           ["lvcreate"; "LV"; "VG"; "8"];
7264           ["mkfs"; "ext2"; "/dev/VG/LV"];
7265           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
7266    | InitISOFS ->
7267        pr "  /* InitISOFS for %s */\n" test_name;
7268        List.iter (generate_test_command_call test_name)
7269          [["blockdev_setrw"; "/dev/sda"];
7270           ["umount_all"];
7271           ["lvm_remove_all"];
7272           ["mount_ro"; "/dev/sdd"; "/"]]
7273   );
7274
7275   let get_seq_last = function
7276     | [] ->
7277         failwithf "%s: you cannot use [] (empty list) when expecting a command"
7278           test_name
7279     | seq ->
7280         let seq = List.rev seq in
7281         List.rev (List.tl seq), List.hd seq
7282   in
7283
7284   match test with
7285   | TestRun seq ->
7286       pr "  /* TestRun for %s (%d) */\n" name i;
7287       List.iter (generate_test_command_call test_name) seq
7288   | TestOutput (seq, expected) ->
7289       pr "  /* TestOutput for %s (%d) */\n" name i;
7290       pr "  const char *expected = \"%s\";\n" (c_quote expected);
7291       let seq, last = get_seq_last seq in
7292       let test () =
7293         pr "    if (STRNEQ (r, expected)) {\n";
7294         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
7295         pr "      return -1;\n";
7296         pr "    }\n"
7297       in
7298       List.iter (generate_test_command_call test_name) seq;
7299       generate_test_command_call ~test test_name last
7300   | TestOutputList (seq, expected) ->
7301       pr "  /* TestOutputList for %s (%d) */\n" name i;
7302       let seq, last = get_seq_last seq in
7303       let test () =
7304         iteri (
7305           fun i str ->
7306             pr "    if (!r[%d]) {\n" i;
7307             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
7308             pr "      print_strings (r);\n";
7309             pr "      return -1;\n";
7310             pr "    }\n";
7311             pr "    {\n";
7312             pr "      const char *expected = \"%s\";\n" (c_quote str);
7313             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
7314             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
7315             pr "        return -1;\n";
7316             pr "      }\n";
7317             pr "    }\n"
7318         ) expected;
7319         pr "    if (r[%d] != NULL) {\n" (List.length expected);
7320         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
7321           test_name;
7322         pr "      print_strings (r);\n";
7323         pr "      return -1;\n";
7324         pr "    }\n"
7325       in
7326       List.iter (generate_test_command_call test_name) seq;
7327       generate_test_command_call ~test test_name last
7328   | TestOutputListOfDevices (seq, expected) ->
7329       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
7330       let seq, last = get_seq_last seq in
7331       let test () =
7332         iteri (
7333           fun i str ->
7334             pr "    if (!r[%d]) {\n" i;
7335             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
7336             pr "      print_strings (r);\n";
7337             pr "      return -1;\n";
7338             pr "    }\n";
7339             pr "    {\n";
7340             pr "      const char *expected = \"%s\";\n" (c_quote str);
7341             pr "      r[%d][5] = 's';\n" i;
7342             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
7343             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
7344             pr "        return -1;\n";
7345             pr "      }\n";
7346             pr "    }\n"
7347         ) expected;
7348         pr "    if (r[%d] != NULL) {\n" (List.length expected);
7349         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
7350           test_name;
7351         pr "      print_strings (r);\n";
7352         pr "      return -1;\n";
7353         pr "    }\n"
7354       in
7355       List.iter (generate_test_command_call test_name) seq;
7356       generate_test_command_call ~test test_name last
7357   | TestOutputInt (seq, expected) ->
7358       pr "  /* TestOutputInt for %s (%d) */\n" name i;
7359       let seq, last = get_seq_last seq in
7360       let test () =
7361         pr "    if (r != %d) {\n" expected;
7362         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
7363           test_name expected;
7364         pr "               (int) r);\n";
7365         pr "      return -1;\n";
7366         pr "    }\n"
7367       in
7368       List.iter (generate_test_command_call test_name) seq;
7369       generate_test_command_call ~test test_name last
7370   | TestOutputIntOp (seq, op, expected) ->
7371       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
7372       let seq, last = get_seq_last seq in
7373       let test () =
7374         pr "    if (! (r %s %d)) {\n" op expected;
7375         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
7376           test_name op expected;
7377         pr "               (int) r);\n";
7378         pr "      return -1;\n";
7379         pr "    }\n"
7380       in
7381       List.iter (generate_test_command_call test_name) seq;
7382       generate_test_command_call ~test test_name last
7383   | TestOutputTrue seq ->
7384       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
7385       let seq, last = get_seq_last seq in
7386       let test () =
7387         pr "    if (!r) {\n";
7388         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
7389           test_name;
7390         pr "      return -1;\n";
7391         pr "    }\n"
7392       in
7393       List.iter (generate_test_command_call test_name) seq;
7394       generate_test_command_call ~test test_name last
7395   | TestOutputFalse seq ->
7396       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
7397       let seq, last = get_seq_last seq in
7398       let test () =
7399         pr "    if (r) {\n";
7400         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
7401           test_name;
7402         pr "      return -1;\n";
7403         pr "    }\n"
7404       in
7405       List.iter (generate_test_command_call test_name) seq;
7406       generate_test_command_call ~test test_name last
7407   | TestOutputLength (seq, expected) ->
7408       pr "  /* TestOutputLength for %s (%d) */\n" name i;
7409       let seq, last = get_seq_last seq in
7410       let test () =
7411         pr "    int j;\n";
7412         pr "    for (j = 0; j < %d; ++j)\n" expected;
7413         pr "      if (r[j] == NULL) {\n";
7414         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
7415           test_name;
7416         pr "        print_strings (r);\n";
7417         pr "        return -1;\n";
7418         pr "      }\n";
7419         pr "    if (r[j] != NULL) {\n";
7420         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
7421           test_name;
7422         pr "      print_strings (r);\n";
7423         pr "      return -1;\n";
7424         pr "    }\n"
7425       in
7426       List.iter (generate_test_command_call test_name) seq;
7427       generate_test_command_call ~test test_name last
7428   | TestOutputBuffer (seq, expected) ->
7429       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
7430       pr "  const char *expected = \"%s\";\n" (c_quote expected);
7431       let seq, last = get_seq_last seq in
7432       let len = String.length expected in
7433       let test () =
7434         pr "    if (size != %d) {\n" len;
7435         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
7436         pr "      return -1;\n";
7437         pr "    }\n";
7438         pr "    if (STRNEQLEN (r, expected, size)) {\n";
7439         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
7440         pr "      return -1;\n";
7441         pr "    }\n"
7442       in
7443       List.iter (generate_test_command_call test_name) seq;
7444       generate_test_command_call ~test test_name last
7445   | TestOutputStruct (seq, checks) ->
7446       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
7447       let seq, last = get_seq_last seq in
7448       let test () =
7449         List.iter (
7450           function
7451           | CompareWithInt (field, expected) ->
7452               pr "    if (r->%s != %d) {\n" field expected;
7453               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
7454                 test_name field expected;
7455               pr "               (int) r->%s);\n" field;
7456               pr "      return -1;\n";
7457               pr "    }\n"
7458           | CompareWithIntOp (field, op, expected) ->
7459               pr "    if (!(r->%s %s %d)) {\n" field op expected;
7460               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
7461                 test_name field op expected;
7462               pr "               (int) r->%s);\n" field;
7463               pr "      return -1;\n";
7464               pr "    }\n"
7465           | CompareWithString (field, expected) ->
7466               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7467               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7468                 test_name field expected;
7469               pr "               r->%s);\n" field;
7470               pr "      return -1;\n";
7471               pr "    }\n"
7472           | CompareFieldsIntEq (field1, field2) ->
7473               pr "    if (r->%s != r->%s) {\n" field1 field2;
7474               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7475                 test_name field1 field2;
7476               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7477               pr "      return -1;\n";
7478               pr "    }\n"
7479           | CompareFieldsStrEq (field1, field2) ->
7480               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7481               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7482                 test_name field1 field2;
7483               pr "               r->%s, r->%s);\n" field1 field2;
7484               pr "      return -1;\n";
7485               pr "    }\n"
7486         ) checks
7487       in
7488       List.iter (generate_test_command_call test_name) seq;
7489       generate_test_command_call ~test test_name last
7490   | TestLastFail seq ->
7491       pr "  /* TestLastFail for %s (%d) */\n" name i;
7492       let seq, last = get_seq_last seq in
7493       List.iter (generate_test_command_call test_name) seq;
7494       generate_test_command_call test_name ~expect_error:true last
7495
7496 (* Generate the code to run a command, leaving the result in 'r'.
7497  * If you expect to get an error then you should set expect_error:true.
7498  *)
7499 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7500   match cmd with
7501   | [] -> assert false
7502   | name :: args ->
7503       (* Look up the command to find out what args/ret it has. *)
7504       let style =
7505         try
7506           let _, style, _, _, _, _, _ =
7507             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7508           style
7509         with Not_found ->
7510           failwithf "%s: in test, command %s was not found" test_name name in
7511
7512       if List.length (snd style) <> List.length args then
7513         failwithf "%s: in test, wrong number of args given to %s"
7514           test_name name;
7515
7516       pr "  {\n";
7517
7518       List.iter (
7519         function
7520         | OptString n, "NULL" -> ()
7521         | Pathname n, arg
7522         | Device n, arg
7523         | Dev_or_Path n, arg
7524         | String n, arg
7525         | OptString n, arg ->
7526             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7527         | BufferIn n, arg ->
7528             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7529             pr "    size_t %s_size = %d;\n" n (String.length arg)
7530         | Int _, _
7531         | Int64 _, _
7532         | Bool _, _
7533         | FileIn _, _ | FileOut _, _ -> ()
7534         | StringList n, "" | DeviceList n, "" ->
7535             pr "    const char *const %s[1] = { NULL };\n" n
7536         | StringList n, arg | DeviceList n, arg ->
7537             let strs = string_split " " arg in
7538             iteri (
7539               fun i str ->
7540                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7541             ) strs;
7542             pr "    const char *const %s[] = {\n" n;
7543             iteri (
7544               fun i _ -> pr "      %s_%d,\n" n i
7545             ) strs;
7546             pr "      NULL\n";
7547             pr "    };\n";
7548       ) (List.combine (snd style) args);
7549
7550       let error_code =
7551         match fst style with
7552         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7553         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7554         | RConstString _ | RConstOptString _ ->
7555             pr "    const char *r;\n"; "NULL"
7556         | RString _ -> pr "    char *r;\n"; "NULL"
7557         | RStringList _ | RHashtable _ ->
7558             pr "    char **r;\n";
7559             pr "    size_t i;\n";
7560             "NULL"
7561         | RStruct (_, typ) ->
7562             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7563         | RStructList (_, typ) ->
7564             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7565         | RBufferOut _ ->
7566             pr "    char *r;\n";
7567             pr "    size_t size;\n";
7568             "NULL" in
7569
7570       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7571       pr "    r = guestfs_%s (g" name;
7572
7573       (* Generate the parameters. *)
7574       List.iter (
7575         function
7576         | OptString _, "NULL" -> pr ", NULL"
7577         | Pathname n, _
7578         | Device n, _ | Dev_or_Path n, _
7579         | String n, _
7580         | OptString n, _ ->
7581             pr ", %s" n
7582         | BufferIn n, _ ->
7583             pr ", %s, %s_size" n n
7584         | FileIn _, arg | FileOut _, arg ->
7585             pr ", \"%s\"" (c_quote arg)
7586         | StringList n, _ | DeviceList n, _ ->
7587             pr ", (char **) %s" n
7588         | Int _, arg ->
7589             let i =
7590               try int_of_string arg
7591               with Failure "int_of_string" ->
7592                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7593             pr ", %d" i
7594         | Int64 _, arg ->
7595             let i =
7596               try Int64.of_string arg
7597               with Failure "int_of_string" ->
7598                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7599             pr ", %Ld" i
7600         | Bool _, arg ->
7601             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7602       ) (List.combine (snd style) args);
7603
7604       (match fst style with
7605        | RBufferOut _ -> pr ", &size"
7606        | _ -> ()
7607       );
7608
7609       pr ");\n";
7610
7611       if not expect_error then
7612         pr "    if (r == %s)\n" error_code
7613       else
7614         pr "    if (r != %s)\n" error_code;
7615       pr "      return -1;\n";
7616
7617       (* Insert the test code. *)
7618       (match test with
7619        | None -> ()
7620        | Some f -> f ()
7621       );
7622
7623       (match fst style with
7624        | RErr | RInt _ | RInt64 _ | RBool _
7625        | RConstString _ | RConstOptString _ -> ()
7626        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7627        | RStringList _ | RHashtable _ ->
7628            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7629            pr "      free (r[i]);\n";
7630            pr "    free (r);\n"
7631        | RStruct (_, typ) ->
7632            pr "    guestfs_free_%s (r);\n" typ
7633        | RStructList (_, typ) ->
7634            pr "    guestfs_free_%s_list (r);\n" typ
7635       );
7636
7637       pr "  }\n"
7638
7639 and c_quote str =
7640   let str = replace_str str "\r" "\\r" in
7641   let str = replace_str str "\n" "\\n" in
7642   let str = replace_str str "\t" "\\t" in
7643   let str = replace_str str "\000" "\\0" in
7644   str
7645
7646 (* Generate a lot of different functions for guestfish. *)
7647 and generate_fish_cmds () =
7648   generate_header CStyle GPLv2plus;
7649
7650   let all_functions =
7651     List.filter (
7652       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7653     ) all_functions in
7654   let all_functions_sorted =
7655     List.filter (
7656       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7657     ) all_functions_sorted in
7658
7659   pr "#include <config.h>\n";
7660   pr "\n";
7661   pr "#include <stdio.h>\n";
7662   pr "#include <stdlib.h>\n";
7663   pr "#include <string.h>\n";
7664   pr "#include <inttypes.h>\n";
7665   pr "\n";
7666   pr "#include <guestfs.h>\n";
7667   pr "#include \"c-ctype.h\"\n";
7668   pr "#include \"full-write.h\"\n";
7669   pr "#include \"xstrtol.h\"\n";
7670   pr "#include \"fish.h\"\n";
7671   pr "\n";
7672   pr "/* Valid suffixes allowed for numbers.  See Gnulib xstrtol function. */\n";
7673   pr "static const char *xstrtol_suffixes = \"0kKMGTPEZY\";\n";
7674   pr "\n";
7675
7676   (* list_commands function, which implements guestfish -h *)
7677   pr "void list_commands (void)\n";
7678   pr "{\n";
7679   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7680   pr "  list_builtin_commands ();\n";
7681   List.iter (
7682     fun (name, _, _, flags, _, shortdesc, _) ->
7683       let name = replace_char name '_' '-' in
7684       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7685         name shortdesc
7686   ) all_functions_sorted;
7687   pr "  printf (\"    %%s\\n\",";
7688   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7689   pr "}\n";
7690   pr "\n";
7691
7692   (* display_command function, which implements guestfish -h cmd *)
7693   pr "int display_command (const char *cmd)\n";
7694   pr "{\n";
7695   List.iter (
7696     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7697       let name2 = replace_char name '_' '-' in
7698       let alias =
7699         try find_map (function FishAlias n -> Some n | _ -> None) flags
7700         with Not_found -> name in
7701       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7702       let synopsis =
7703         match snd style with
7704         | [] -> name2
7705         | args ->
7706             sprintf "%s %s"
7707               name2 (String.concat " " (List.map name_of_argt args)) in
7708
7709       let warnings =
7710         if List.mem ProtocolLimitWarning flags then
7711           ("\n\n" ^ protocol_limit_warning)
7712         else "" in
7713
7714       (* For DangerWillRobinson commands, we should probably have
7715        * guestfish prompt before allowing you to use them (especially
7716        * in interactive mode). XXX
7717        *)
7718       let warnings =
7719         warnings ^
7720           if List.mem DangerWillRobinson flags then
7721             ("\n\n" ^ danger_will_robinson)
7722           else "" in
7723
7724       let warnings =
7725         warnings ^
7726           match deprecation_notice flags with
7727           | None -> ""
7728           | Some txt -> "\n\n" ^ txt in
7729
7730       let describe_alias =
7731         if name <> alias then
7732           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7733         else "" in
7734
7735       pr "  if (";
7736       pr "STRCASEEQ (cmd, \"%s\")" name;
7737       if name <> name2 then
7738         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7739       if name <> alias then
7740         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7741       pr ") {\n";
7742       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7743         name2 shortdesc
7744         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7745          "=head1 DESCRIPTION\n\n" ^
7746          longdesc ^ warnings ^ describe_alias);
7747       pr "    return 0;\n";
7748       pr "  }\n";
7749       pr "  else\n"
7750   ) all_functions;
7751   pr "    return display_builtin_command (cmd);\n";
7752   pr "}\n";
7753   pr "\n";
7754
7755   let emit_print_list_function typ =
7756     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7757       typ typ typ;
7758     pr "{\n";
7759     pr "  unsigned int i;\n";
7760     pr "\n";
7761     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7762     pr "    printf (\"[%%d] = {\\n\", i);\n";
7763     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7764     pr "    printf (\"}\\n\");\n";
7765     pr "  }\n";
7766     pr "}\n";
7767     pr "\n";
7768   in
7769
7770   (* print_* functions *)
7771   List.iter (
7772     fun (typ, cols) ->
7773       let needs_i =
7774         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7775
7776       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7777       pr "{\n";
7778       if needs_i then (
7779         pr "  unsigned int i;\n";
7780         pr "\n"
7781       );
7782       List.iter (
7783         function
7784         | name, FString ->
7785             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7786         | name, FUUID ->
7787             pr "  printf (\"%%s%s: \", indent);\n" name;
7788             pr "  for (i = 0; i < 32; ++i)\n";
7789             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7790             pr "  printf (\"\\n\");\n"
7791         | name, FBuffer ->
7792             pr "  printf (\"%%s%s: \", indent);\n" name;
7793             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7794             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7795             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7796             pr "    else\n";
7797             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7798             pr "  printf (\"\\n\");\n"
7799         | name, (FUInt64|FBytes) ->
7800             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7801               name typ name
7802         | name, FInt64 ->
7803             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7804               name typ name
7805         | name, FUInt32 ->
7806             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7807               name typ name
7808         | name, FInt32 ->
7809             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7810               name typ name
7811         | name, FChar ->
7812             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7813               name typ name
7814         | name, FOptPercent ->
7815             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7816               typ name name typ name;
7817             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7818       ) cols;
7819       pr "}\n";
7820       pr "\n";
7821   ) structs;
7822
7823   (* Emit a print_TYPE_list function definition only if that function is used. *)
7824   List.iter (
7825     function
7826     | typ, (RStructListOnly | RStructAndList) ->
7827         (* generate the function for typ *)
7828         emit_print_list_function typ
7829     | typ, _ -> () (* empty *)
7830   ) (rstructs_used_by all_functions);
7831
7832   (* Emit a print_TYPE function definition only if that function is used. *)
7833   List.iter (
7834     function
7835     | typ, (RStructOnly | RStructAndList) ->
7836         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7837         pr "{\n";
7838         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7839         pr "}\n";
7840         pr "\n";
7841     | typ, _ -> () (* empty *)
7842   ) (rstructs_used_by all_functions);
7843
7844   (* run_<action> actions *)
7845   List.iter (
7846     fun (name, style, _, flags, _, _, _) ->
7847       pr "static int run_%s (const char *cmd, size_t argc, char *argv[])\n" name;
7848       pr "{\n";
7849       (match fst style with
7850        | RErr
7851        | RInt _
7852        | RBool _ -> pr "  int r;\n"
7853        | RInt64 _ -> pr "  int64_t r;\n"
7854        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7855        | RString _ -> pr "  char *r;\n"
7856        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7857        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7858        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7859        | RBufferOut _ ->
7860            pr "  char *r;\n";
7861            pr "  size_t size;\n";
7862       );
7863       List.iter (
7864         function
7865         | Device n
7866         | String n
7867         | OptString n -> pr "  const char *%s;\n" n
7868         | Pathname n
7869         | Dev_or_Path n
7870         | FileIn n
7871         | FileOut n -> pr "  char *%s;\n" n
7872         | BufferIn n ->
7873             pr "  const char *%s;\n" n;
7874             pr "  size_t %s_size;\n" n
7875         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7876         | Bool n -> pr "  int %s;\n" n
7877         | Int n -> pr "  int %s;\n" n
7878         | Int64 n -> pr "  int64_t %s;\n" n
7879       ) (snd style);
7880
7881       (* Check and convert parameters. *)
7882       let argc_expected = List.length (snd style) in
7883       pr "  if (argc != %d) {\n" argc_expected;
7884       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7885         argc_expected;
7886       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7887       pr "    return -1;\n";
7888       pr "  }\n";
7889
7890       let parse_integer fn fntyp rtyp range name i =
7891         pr "  {\n";
7892         pr "    strtol_error xerr;\n";
7893         pr "    %s r;\n" fntyp;
7894         pr "\n";
7895         pr "    xerr = %s (argv[%d], NULL, 0, &r, xstrtol_suffixes);\n" fn i;
7896         pr "    if (xerr != LONGINT_OK) {\n";
7897         pr "      fprintf (stderr,\n";
7898         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7899         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7900         pr "      return -1;\n";
7901         pr "    }\n";
7902         (match range with
7903          | None -> ()
7904          | Some (min, max, comment) ->
7905              pr "    /* %s */\n" comment;
7906              pr "    if (r < %s || r > %s) {\n" min max;
7907              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7908                name;
7909              pr "      return -1;\n";
7910              pr "    }\n";
7911              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7912         );
7913         pr "    %s = r;\n" name;
7914         pr "  }\n";
7915       in
7916
7917       iteri (
7918         fun i ->
7919           function
7920           | Device name
7921           | String name ->
7922               pr "  %s = argv[%d];\n" name i
7923           | Pathname name
7924           | Dev_or_Path name ->
7925               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7926               pr "  if (%s == NULL) return -1;\n" name
7927           | OptString name ->
7928               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7929                 name i i
7930           | BufferIn name ->
7931               pr "  %s = argv[%d];\n" name i;
7932               pr "  %s_size = strlen (argv[%d]);\n" name i
7933           | FileIn name ->
7934               pr "  %s = file_in (argv[%d]);\n" name i;
7935               pr "  if (%s == NULL) return -1;\n" name
7936           | FileOut name ->
7937               pr "  %s = file_out (argv[%d]);\n" name i;
7938               pr "  if (%s == NULL) return -1;\n" name
7939           | StringList name | DeviceList name ->
7940               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7941               pr "  if (%s == NULL) return -1;\n" name;
7942           | Bool name ->
7943               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7944           | Int name ->
7945               let range =
7946                 let min = "(-(2LL<<30))"
7947                 and max = "((2LL<<30)-1)"
7948                 and comment =
7949                   "The Int type in the generator is a signed 31 bit int." in
7950                 Some (min, max, comment) in
7951               parse_integer "xstrtoll" "long long" "int" range name i
7952           | Int64 name ->
7953               parse_integer "xstrtoll" "long long" "int64_t" None name i
7954       ) (snd style);
7955
7956       (* Call C API function. *)
7957       pr "  r = guestfs_%s " name;
7958       generate_c_call_args ~handle:"g" style;
7959       pr ";\n";
7960
7961       List.iter (
7962         function
7963         | Device _ | String _
7964         | OptString _ | Bool _
7965         | Int _ | Int64 _
7966         | BufferIn _ -> ()
7967         | Pathname name | Dev_or_Path name | FileOut name ->
7968             pr "  free (%s);\n" name
7969         | FileIn name ->
7970             pr "  free_file_in (%s);\n" name
7971         | StringList name | DeviceList name ->
7972             pr "  free_strings (%s);\n" name
7973       ) (snd style);
7974
7975       (* Any output flags? *)
7976       let fish_output =
7977         let flags = filter_map (
7978           function FishOutput flag -> Some flag | _ -> None
7979         ) flags in
7980         match flags with
7981         | [] -> None
7982         | [f] -> Some f
7983         | _ ->
7984             failwithf "%s: more than one FishOutput flag is not allowed" name in
7985
7986       (* Check return value for errors and display command results. *)
7987       (match fst style with
7988        | RErr -> pr "  return r;\n"
7989        | RInt _ ->
7990            pr "  if (r == -1) return -1;\n";
7991            (match fish_output with
7992             | None ->
7993                 pr "  printf (\"%%d\\n\", r);\n";
7994             | Some FishOutputOctal ->
7995                 pr "  printf (\"%%s%%o\\n\", r != 0 ? \"0\" : \"\", r);\n";
7996             | Some FishOutputHexadecimal ->
7997                 pr "  printf (\"%%s%%x\\n\", r != 0 ? \"0x\" : \"\", r);\n");
7998            pr "  return 0;\n"
7999        | RInt64 _ ->
8000            pr "  if (r == -1) return -1;\n";
8001            (match fish_output with
8002             | None ->
8003                 pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
8004             | Some FishOutputOctal ->
8005                 pr "  printf (\"%%s%%\" PRIo64 \"\\n\", r != 0 ? \"0\" : \"\", r);\n";
8006             | Some FishOutputHexadecimal ->
8007                 pr "  printf (\"%%s%%\" PRIx64 \"\\n\", r != 0 ? \"0x\" : \"\", r);\n");
8008            pr "  return 0;\n"
8009        | RBool _ ->
8010            pr "  if (r == -1) return -1;\n";
8011            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
8012            pr "  return 0;\n"
8013        | RConstString _ ->
8014            pr "  if (r == NULL) return -1;\n";
8015            pr "  printf (\"%%s\\n\", r);\n";
8016            pr "  return 0;\n"
8017        | RConstOptString _ ->
8018            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
8019            pr "  return 0;\n"
8020        | RString _ ->
8021            pr "  if (r == NULL) return -1;\n";
8022            pr "  printf (\"%%s\\n\", r);\n";
8023            pr "  free (r);\n";
8024            pr "  return 0;\n"
8025        | RStringList _ ->
8026            pr "  if (r == NULL) return -1;\n";
8027            pr "  print_strings (r);\n";
8028            pr "  free_strings (r);\n";
8029            pr "  return 0;\n"
8030        | RStruct (_, typ) ->
8031            pr "  if (r == NULL) return -1;\n";
8032            pr "  print_%s (r);\n" typ;
8033            pr "  guestfs_free_%s (r);\n" typ;
8034            pr "  return 0;\n"
8035        | RStructList (_, typ) ->
8036            pr "  if (r == NULL) return -1;\n";
8037            pr "  print_%s_list (r);\n" typ;
8038            pr "  guestfs_free_%s_list (r);\n" typ;
8039            pr "  return 0;\n"
8040        | RHashtable _ ->
8041            pr "  if (r == NULL) return -1;\n";
8042            pr "  print_table (r);\n";
8043            pr "  free_strings (r);\n";
8044            pr "  return 0;\n"
8045        | RBufferOut _ ->
8046            pr "  if (r == NULL) return -1;\n";
8047            pr "  if (full_write (1, r, size) != size) {\n";
8048            pr "    perror (\"write\");\n";
8049            pr "    free (r);\n";
8050            pr "    return -1;\n";
8051            pr "  }\n";
8052            pr "  free (r);\n";
8053            pr "  return 0;\n"
8054       );
8055       pr "}\n";
8056       pr "\n"
8057   ) all_functions;
8058
8059   (* run_action function *)
8060   pr "int run_action (const char *cmd, size_t argc, char *argv[])\n";
8061   pr "{\n";
8062   List.iter (
8063     fun (name, _, _, flags, _, _, _) ->
8064       let name2 = replace_char name '_' '-' in
8065       let alias =
8066         try find_map (function FishAlias n -> Some n | _ -> None) flags
8067         with Not_found -> name in
8068       pr "  if (";
8069       pr "STRCASEEQ (cmd, \"%s\")" name;
8070       if name <> name2 then
8071         pr " || STRCASEEQ (cmd, \"%s\")" name2;
8072       if name <> alias then
8073         pr " || STRCASEEQ (cmd, \"%s\")" alias;
8074       pr ")\n";
8075       pr "    return run_%s (cmd, argc, argv);\n" name;
8076       pr "  else\n";
8077   ) all_functions;
8078   pr "    {\n";
8079   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
8080   pr "      if (command_num == 1)\n";
8081   pr "        extended_help_message ();\n";
8082   pr "      return -1;\n";
8083   pr "    }\n";
8084   pr "  return 0;\n";
8085   pr "}\n";
8086   pr "\n"
8087
8088 (* Readline completion for guestfish. *)
8089 and generate_fish_completion () =
8090   generate_header CStyle GPLv2plus;
8091
8092   let all_functions =
8093     List.filter (
8094       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
8095     ) all_functions in
8096
8097   pr "\
8098 #include <config.h>
8099
8100 #include <stdio.h>
8101 #include <stdlib.h>
8102 #include <string.h>
8103
8104 #ifdef HAVE_LIBREADLINE
8105 #include <readline/readline.h>
8106 #endif
8107
8108 #include \"fish.h\"
8109
8110 #ifdef HAVE_LIBREADLINE
8111
8112 static const char *const commands[] = {
8113   BUILTIN_COMMANDS_FOR_COMPLETION,
8114 ";
8115
8116   (* Get the commands, including the aliases.  They don't need to be
8117    * sorted - the generator() function just does a dumb linear search.
8118    *)
8119   let commands =
8120     List.map (
8121       fun (name, _, _, flags, _, _, _) ->
8122         let name2 = replace_char name '_' '-' in
8123         let alias =
8124           try find_map (function FishAlias n -> Some n | _ -> None) flags
8125           with Not_found -> name in
8126
8127         if name <> alias then [name2; alias] else [name2]
8128     ) all_functions in
8129   let commands = List.flatten commands in
8130
8131   List.iter (pr "  \"%s\",\n") commands;
8132
8133   pr "  NULL
8134 };
8135
8136 static char *
8137 generator (const char *text, int state)
8138 {
8139   static size_t index, len;
8140   const char *name;
8141
8142   if (!state) {
8143     index = 0;
8144     len = strlen (text);
8145   }
8146
8147   rl_attempted_completion_over = 1;
8148
8149   while ((name = commands[index]) != NULL) {
8150     index++;
8151     if (STRCASEEQLEN (name, text, len))
8152       return strdup (name);
8153   }
8154
8155   return NULL;
8156 }
8157
8158 #endif /* HAVE_LIBREADLINE */
8159
8160 #ifdef HAVE_RL_COMPLETION_MATCHES
8161 #define RL_COMPLETION_MATCHES rl_completion_matches
8162 #else
8163 #ifdef HAVE_COMPLETION_MATCHES
8164 #define RL_COMPLETION_MATCHES completion_matches
8165 #endif
8166 #endif /* else just fail if we don't have either symbol */
8167
8168 char **
8169 do_completion (const char *text, int start, int end)
8170 {
8171   char **matches = NULL;
8172
8173 #ifdef HAVE_LIBREADLINE
8174   rl_completion_append_character = ' ';
8175
8176   if (start == 0)
8177     matches = RL_COMPLETION_MATCHES (text, generator);
8178   else if (complete_dest_paths)
8179     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
8180 #endif
8181
8182   return matches;
8183 }
8184 ";
8185
8186 (* Generate the POD documentation for guestfish. *)
8187 and generate_fish_actions_pod () =
8188   let all_functions_sorted =
8189     List.filter (
8190       fun (_, _, _, flags, _, _, _) ->
8191         not (List.mem NotInFish flags || List.mem NotInDocs flags)
8192     ) all_functions_sorted in
8193
8194   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
8195
8196   List.iter (
8197     fun (name, style, _, flags, _, _, longdesc) ->
8198       let longdesc =
8199         Str.global_substitute rex (
8200           fun s ->
8201             let sub =
8202               try Str.matched_group 1 s
8203               with Not_found ->
8204                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
8205             "L</" ^ replace_char sub '_' '-' ^ ">"
8206         ) longdesc in
8207       let name = replace_char name '_' '-' in
8208       let alias =
8209         try find_map (function FishAlias n -> Some n | _ -> None) flags
8210         with Not_found -> name in
8211
8212       pr "=head2 %s" name;
8213       if name <> alias then
8214         pr " | %s" alias;
8215       pr "\n";
8216       pr "\n";
8217       pr " %s" name;
8218       List.iter (
8219         function
8220         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
8221         | OptString n -> pr " %s" n
8222         | StringList n | DeviceList n -> pr " '%s ...'" n
8223         | Bool _ -> pr " true|false"
8224         | Int n -> pr " %s" n
8225         | Int64 n -> pr " %s" n
8226         | FileIn n | FileOut n -> pr " (%s|-)" n
8227         | BufferIn n -> pr " %s" n
8228       ) (snd style);
8229       pr "\n";
8230       pr "\n";
8231       pr "%s\n\n" longdesc;
8232
8233       if List.exists (function FileIn _ | FileOut _ -> true
8234                       | _ -> false) (snd style) then
8235         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
8236
8237       if List.mem ProtocolLimitWarning flags then
8238         pr "%s\n\n" protocol_limit_warning;
8239
8240       if List.mem DangerWillRobinson flags then
8241         pr "%s\n\n" danger_will_robinson;
8242
8243       match deprecation_notice flags with
8244       | None -> ()
8245       | Some txt -> pr "%s\n\n" txt
8246   ) all_functions_sorted
8247
8248 and generate_fish_prep_options_h () =
8249   generate_header CStyle GPLv2plus;
8250
8251   pr "#ifndef PREPOPTS_H\n";
8252   pr "\n";
8253
8254   pr "\
8255 struct prep {
8256   const char *name;             /* eg. \"fs\" */
8257
8258   size_t nr_params;             /* optional parameters */
8259   struct prep_param *params;
8260
8261   const char *shortdesc;        /* short description */
8262   const char *longdesc;         /* long description */
8263
8264                                 /* functions to implement it */
8265   void (*prelaunch) (const char *filename, prep_data *);
8266   void (*postlaunch) (const char *filename, prep_data *, const char *device);
8267 };
8268
8269 struct prep_param {
8270   const char *pname;            /* parameter name */
8271   const char *pdefault;         /* parameter default */
8272   const char *pdesc;            /* parameter description */
8273 };
8274
8275 extern const struct prep preps[];
8276 #define NR_PREPS %d
8277
8278 " (List.length prepopts);
8279
8280   List.iter (
8281     fun (name, shortdesc, args, longdesc) ->
8282       pr "\
8283 extern void prep_prelaunch_%s (const char *filename, prep_data *data);
8284 extern void prep_postlaunch_%s (const char *filename, prep_data *data, const char *device);
8285
8286 " name name;
8287   ) prepopts;
8288
8289   pr "\n";
8290   pr "#endif /* PREPOPTS_H */\n"
8291
8292 and generate_fish_prep_options_c () =
8293   generate_header CStyle GPLv2plus;
8294
8295   pr "\
8296 #include \"fish.h\"
8297 #include \"prepopts.h\"
8298
8299 ";
8300
8301   List.iter (
8302     fun (name, shortdesc, args, longdesc) ->
8303       pr "static struct prep_param %s_args[] = {\n" name;
8304       List.iter (
8305         fun (n, default, desc) ->
8306           pr "  { \"%s\", \"%s\", \"%s\" },\n" n default desc
8307       ) args;
8308       pr "};\n";
8309       pr "\n";
8310   ) prepopts;
8311
8312   pr "const struct prep preps[] = {\n";
8313   List.iter (
8314     fun (name, shortdesc, args, longdesc) ->
8315       pr "  { \"%s\", %d, %s_args,
8316     \"%s\",
8317     \"%s\",
8318     prep_prelaunch_%s, prep_postlaunch_%s },
8319 "
8320         name (List.length args) name
8321         (c_quote shortdesc) (c_quote longdesc)
8322         name name;
8323   ) prepopts;
8324   pr "};\n"
8325
8326 (* Generate a C function prototype. *)
8327 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
8328     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
8329     ?(prefix = "")
8330     ?handle name style =
8331   if extern then pr "extern ";
8332   if static then pr "static ";
8333   (match fst style with
8334    | RErr -> pr "int "
8335    | RInt _ -> pr "int "
8336    | RInt64 _ -> pr "int64_t "
8337    | RBool _ -> pr "int "
8338    | RConstString _ | RConstOptString _ -> pr "const char *"
8339    | RString _ | RBufferOut _ -> pr "char *"
8340    | RStringList _ | RHashtable _ -> pr "char **"
8341    | RStruct (_, typ) ->
8342        if not in_daemon then pr "struct guestfs_%s *" typ
8343        else pr "guestfs_int_%s *" typ
8344    | RStructList (_, typ) ->
8345        if not in_daemon then pr "struct guestfs_%s_list *" typ
8346        else pr "guestfs_int_%s_list *" typ
8347   );
8348   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
8349   pr "%s%s (" prefix name;
8350   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
8351     pr "void"
8352   else (
8353     let comma = ref false in
8354     (match handle with
8355      | None -> ()
8356      | Some handle -> pr "guestfs_h *%s" handle; comma := true
8357     );
8358     let next () =
8359       if !comma then (
8360         if single_line then pr ", " else pr ",\n\t\t"
8361       );
8362       comma := true
8363     in
8364     List.iter (
8365       function
8366       | Pathname n
8367       | Device n | Dev_or_Path n
8368       | String n
8369       | OptString n ->
8370           next ();
8371           pr "const char *%s" n
8372       | StringList n | DeviceList n ->
8373           next ();
8374           pr "char *const *%s" n
8375       | Bool n -> next (); pr "int %s" n
8376       | Int n -> next (); pr "int %s" n
8377       | Int64 n -> next (); pr "int64_t %s" n
8378       | FileIn n
8379       | FileOut n ->
8380           if not in_daemon then (next (); pr "const char *%s" n)
8381       | BufferIn n ->
8382           next ();
8383           pr "const char *%s" n;
8384           next ();
8385           pr "size_t %s_size" n
8386     ) (snd style);
8387     if is_RBufferOut then (next (); pr "size_t *size_r");
8388   );
8389   pr ")";
8390   if semicolon then pr ";";
8391   if newline then pr "\n"
8392
8393 (* Generate C call arguments, eg "(handle, foo, bar)" *)
8394 and generate_c_call_args ?handle ?(decl = false) style =
8395   pr "(";
8396   let comma = ref false in
8397   let next () =
8398     if !comma then pr ", ";
8399     comma := true
8400   in
8401   (match handle with
8402    | None -> ()
8403    | Some handle -> pr "%s" handle; comma := true
8404   );
8405   List.iter (
8406     function
8407     | BufferIn n ->
8408         next ();
8409         pr "%s, %s_size" n n
8410     | arg ->
8411         next ();
8412         pr "%s" (name_of_argt arg)
8413   ) (snd style);
8414   (* For RBufferOut calls, add implicit &size parameter. *)
8415   if not decl then (
8416     match fst style with
8417     | RBufferOut _ ->
8418         next ();
8419         pr "&size"
8420     | _ -> ()
8421   );
8422   pr ")"
8423
8424 (* Generate the OCaml bindings interface. *)
8425 and generate_ocaml_mli () =
8426   generate_header OCamlStyle LGPLv2plus;
8427
8428   pr "\
8429 (** For API documentation you should refer to the C API
8430     in the guestfs(3) manual page.  The OCaml API uses almost
8431     exactly the same calls. *)
8432
8433 type t
8434 (** A [guestfs_h] handle. *)
8435
8436 exception Error of string
8437 (** This exception is raised when there is an error. *)
8438
8439 exception Handle_closed of string
8440 (** This exception is raised if you use a {!Guestfs.t} handle
8441     after calling {!close} on it.  The string is the name of
8442     the function. *)
8443
8444 val create : unit -> t
8445 (** Create a {!Guestfs.t} handle. *)
8446
8447 val close : t -> unit
8448 (** Close the {!Guestfs.t} handle and free up all resources used
8449     by it immediately.
8450
8451     Handles are closed by the garbage collector when they become
8452     unreferenced, but callers can call this in order to provide
8453     predictable cleanup. *)
8454
8455 ";
8456   generate_ocaml_structure_decls ();
8457
8458   (* The actions. *)
8459   List.iter (
8460     fun (name, style, _, _, _, shortdesc, _) ->
8461       generate_ocaml_prototype name style;
8462       pr "(** %s *)\n" shortdesc;
8463       pr "\n"
8464   ) all_functions_sorted
8465
8466 (* Generate the OCaml bindings implementation. *)
8467 and generate_ocaml_ml () =
8468   generate_header OCamlStyle LGPLv2plus;
8469
8470   pr "\
8471 type t
8472
8473 exception Error of string
8474 exception Handle_closed of string
8475
8476 external create : unit -> t = \"ocaml_guestfs_create\"
8477 external close : t -> unit = \"ocaml_guestfs_close\"
8478
8479 (* Give the exceptions names, so they can be raised from the C code. *)
8480 let () =
8481   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
8482   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
8483
8484 ";
8485
8486   generate_ocaml_structure_decls ();
8487
8488   (* The actions. *)
8489   List.iter (
8490     fun (name, style, _, _, _, shortdesc, _) ->
8491       generate_ocaml_prototype ~is_external:true name style;
8492   ) all_functions_sorted
8493
8494 (* Generate the OCaml bindings C implementation. *)
8495 and generate_ocaml_c () =
8496   generate_header CStyle LGPLv2plus;
8497
8498   pr "\
8499 #include <stdio.h>
8500 #include <stdlib.h>
8501 #include <string.h>
8502
8503 #include <caml/config.h>
8504 #include <caml/alloc.h>
8505 #include <caml/callback.h>
8506 #include <caml/fail.h>
8507 #include <caml/memory.h>
8508 #include <caml/mlvalues.h>
8509 #include <caml/signals.h>
8510
8511 #include \"guestfs.h\"
8512
8513 #include \"guestfs_c.h\"
8514
8515 /* Copy a hashtable of string pairs into an assoc-list.  We return
8516  * the list in reverse order, but hashtables aren't supposed to be
8517  * ordered anyway.
8518  */
8519 static CAMLprim value
8520 copy_table (char * const * argv)
8521 {
8522   CAMLparam0 ();
8523   CAMLlocal5 (rv, pairv, kv, vv, cons);
8524   size_t i;
8525
8526   rv = Val_int (0);
8527   for (i = 0; argv[i] != NULL; i += 2) {
8528     kv = caml_copy_string (argv[i]);
8529     vv = caml_copy_string (argv[i+1]);
8530     pairv = caml_alloc (2, 0);
8531     Store_field (pairv, 0, kv);
8532     Store_field (pairv, 1, vv);
8533     cons = caml_alloc (2, 0);
8534     Store_field (cons, 1, rv);
8535     rv = cons;
8536     Store_field (cons, 0, pairv);
8537   }
8538
8539   CAMLreturn (rv);
8540 }
8541
8542 ";
8543
8544   (* Struct copy functions. *)
8545
8546   let emit_ocaml_copy_list_function typ =
8547     pr "static CAMLprim value\n";
8548     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
8549     pr "{\n";
8550     pr "  CAMLparam0 ();\n";
8551     pr "  CAMLlocal2 (rv, v);\n";
8552     pr "  unsigned int i;\n";
8553     pr "\n";
8554     pr "  if (%ss->len == 0)\n" typ;
8555     pr "    CAMLreturn (Atom (0));\n";
8556     pr "  else {\n";
8557     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
8558     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
8559     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
8560     pr "      caml_modify (&Field (rv, i), v);\n";
8561     pr "    }\n";
8562     pr "    CAMLreturn (rv);\n";
8563     pr "  }\n";
8564     pr "}\n";
8565     pr "\n";
8566   in
8567
8568   List.iter (
8569     fun (typ, cols) ->
8570       let has_optpercent_col =
8571         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
8572
8573       pr "static CAMLprim value\n";
8574       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
8575       pr "{\n";
8576       pr "  CAMLparam0 ();\n";
8577       if has_optpercent_col then
8578         pr "  CAMLlocal3 (rv, v, v2);\n"
8579       else
8580         pr "  CAMLlocal2 (rv, v);\n";
8581       pr "\n";
8582       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
8583       iteri (
8584         fun i col ->
8585           (match col with
8586            | name, FString ->
8587                pr "  v = caml_copy_string (%s->%s);\n" typ name
8588            | name, FBuffer ->
8589                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8590                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8591                  typ name typ name
8592            | name, FUUID ->
8593                pr "  v = caml_alloc_string (32);\n";
8594                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8595            | name, (FBytes|FInt64|FUInt64) ->
8596                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8597            | name, (FInt32|FUInt32) ->
8598                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8599            | name, FOptPercent ->
8600                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8601                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8602                pr "    v = caml_alloc (1, 0);\n";
8603                pr "    Store_field (v, 0, v2);\n";
8604                pr "  } else /* None */\n";
8605                pr "    v = Val_int (0);\n";
8606            | name, FChar ->
8607                pr "  v = Val_int (%s->%s);\n" typ name
8608           );
8609           pr "  Store_field (rv, %d, v);\n" i
8610       ) cols;
8611       pr "  CAMLreturn (rv);\n";
8612       pr "}\n";
8613       pr "\n";
8614   ) structs;
8615
8616   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8617   List.iter (
8618     function
8619     | typ, (RStructListOnly | RStructAndList) ->
8620         (* generate the function for typ *)
8621         emit_ocaml_copy_list_function typ
8622     | typ, _ -> () (* empty *)
8623   ) (rstructs_used_by all_functions);
8624
8625   (* The wrappers. *)
8626   List.iter (
8627     fun (name, style, _, _, _, _, _) ->
8628       pr "/* Automatically generated wrapper for function\n";
8629       pr " * ";
8630       generate_ocaml_prototype name style;
8631       pr " */\n";
8632       pr "\n";
8633
8634       let params =
8635         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8636
8637       let needs_extra_vs =
8638         match fst style with RConstOptString _ -> true | _ -> false in
8639
8640       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8641       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8642       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8643       pr "\n";
8644
8645       pr "CAMLprim value\n";
8646       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8647       List.iter (pr ", value %s") (List.tl params);
8648       pr ")\n";
8649       pr "{\n";
8650
8651       (match params with
8652        | [p1; p2; p3; p4; p5] ->
8653            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8654        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8655            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8656            pr "  CAMLxparam%d (%s);\n"
8657              (List.length rest) (String.concat ", " rest)
8658        | ps ->
8659            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8660       );
8661       if not needs_extra_vs then
8662         pr "  CAMLlocal1 (rv);\n"
8663       else
8664         pr "  CAMLlocal3 (rv, v, v2);\n";
8665       pr "\n";
8666
8667       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8668       pr "  if (g == NULL)\n";
8669       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8670       pr "\n";
8671
8672       List.iter (
8673         function
8674         | Pathname n
8675         | Device n | Dev_or_Path n
8676         | String n
8677         | FileIn n
8678         | FileOut n ->
8679             (* Copy strings in case the GC moves them: RHBZ#604691 *)
8680             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
8681         | OptString n ->
8682             pr "  char *%s =\n" n;
8683             pr "    %sv != Val_int (0) ?\n" n;
8684             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
8685         | BufferIn n ->
8686             pr "  size_t %s_size = caml_string_length (%sv);\n" n n;
8687             pr "  char *%s = guestfs_safe_memdup (g, String_val (%sv), %s_size);\n" n n n
8688         | StringList n | DeviceList n ->
8689             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8690         | Bool n ->
8691             pr "  int %s = Bool_val (%sv);\n" n n
8692         | Int n ->
8693             pr "  int %s = Int_val (%sv);\n" n n
8694         | Int64 n ->
8695             pr "  int64_t %s = Int64_val (%sv);\n" n n
8696       ) (snd style);
8697       let error_code =
8698         match fst style with
8699         | RErr -> pr "  int r;\n"; "-1"
8700         | RInt _ -> pr "  int r;\n"; "-1"
8701         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8702         | RBool _ -> pr "  int r;\n"; "-1"
8703         | RConstString _ | RConstOptString _ ->
8704             pr "  const char *r;\n"; "NULL"
8705         | RString _ -> pr "  char *r;\n"; "NULL"
8706         | RStringList _ ->
8707             pr "  size_t i;\n";
8708             pr "  char **r;\n";
8709             "NULL"
8710         | RStruct (_, typ) ->
8711             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8712         | RStructList (_, typ) ->
8713             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8714         | RHashtable _ ->
8715             pr "  size_t i;\n";
8716             pr "  char **r;\n";
8717             "NULL"
8718         | RBufferOut _ ->
8719             pr "  char *r;\n";
8720             pr "  size_t size;\n";
8721             "NULL" in
8722       pr "\n";
8723
8724       pr "  caml_enter_blocking_section ();\n";
8725       pr "  r = guestfs_%s " name;
8726       generate_c_call_args ~handle:"g" style;
8727       pr ";\n";
8728       pr "  caml_leave_blocking_section ();\n";
8729
8730       (* Free strings if we copied them above. *)
8731       List.iter (
8732         function
8733         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
8734         | FileIn n | FileOut n | BufferIn n ->
8735             pr "  free (%s);\n" n
8736         | StringList n | DeviceList n ->
8737             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8738         | Bool _ | Int _ | Int64 _ -> ()
8739       ) (snd style);
8740
8741       pr "  if (r == %s)\n" error_code;
8742       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8743       pr "\n";
8744
8745       (match fst style with
8746        | RErr -> pr "  rv = Val_unit;\n"
8747        | RInt _ -> pr "  rv = Val_int (r);\n"
8748        | RInt64 _ ->
8749            pr "  rv = caml_copy_int64 (r);\n"
8750        | RBool _ -> pr "  rv = Val_bool (r);\n"
8751        | RConstString _ ->
8752            pr "  rv = caml_copy_string (r);\n"
8753        | RConstOptString _ ->
8754            pr "  if (r) { /* Some string */\n";
8755            pr "    v = caml_alloc (1, 0);\n";
8756            pr "    v2 = caml_copy_string (r);\n";
8757            pr "    Store_field (v, 0, v2);\n";
8758            pr "  } else /* None */\n";
8759            pr "    v = Val_int (0);\n";
8760        | RString _ ->
8761            pr "  rv = caml_copy_string (r);\n";
8762            pr "  free (r);\n"
8763        | RStringList _ ->
8764            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8765            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8766            pr "  free (r);\n"
8767        | RStruct (_, typ) ->
8768            pr "  rv = copy_%s (r);\n" typ;
8769            pr "  guestfs_free_%s (r);\n" typ;
8770        | RStructList (_, typ) ->
8771            pr "  rv = copy_%s_list (r);\n" typ;
8772            pr "  guestfs_free_%s_list (r);\n" typ;
8773        | RHashtable _ ->
8774            pr "  rv = copy_table (r);\n";
8775            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8776            pr "  free (r);\n";
8777        | RBufferOut _ ->
8778            pr "  rv = caml_alloc_string (size);\n";
8779            pr "  memcpy (String_val (rv), r, size);\n";
8780       );
8781
8782       pr "  CAMLreturn (rv);\n";
8783       pr "}\n";
8784       pr "\n";
8785
8786       if List.length params > 5 then (
8787         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8788         pr "CAMLprim value ";
8789         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8790         pr "CAMLprim value\n";
8791         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8792         pr "{\n";
8793         pr "  return ocaml_guestfs_%s (argv[0]" name;
8794         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8795         pr ");\n";
8796         pr "}\n";
8797         pr "\n"
8798       )
8799   ) all_functions_sorted
8800
8801 and generate_ocaml_structure_decls () =
8802   List.iter (
8803     fun (typ, cols) ->
8804       pr "type %s = {\n" typ;
8805       List.iter (
8806         function
8807         | name, FString -> pr "  %s : string;\n" name
8808         | name, FBuffer -> pr "  %s : string;\n" name
8809         | name, FUUID -> pr "  %s : string;\n" name
8810         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8811         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8812         | name, FChar -> pr "  %s : char;\n" name
8813         | name, FOptPercent -> pr "  %s : float option;\n" name
8814       ) cols;
8815       pr "}\n";
8816       pr "\n"
8817   ) structs
8818
8819 and generate_ocaml_prototype ?(is_external = false) name style =
8820   if is_external then pr "external " else pr "val ";
8821   pr "%s : t -> " name;
8822   List.iter (
8823     function
8824     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _
8825     | BufferIn _ -> pr "string -> "
8826     | OptString _ -> pr "string option -> "
8827     | StringList _ | DeviceList _ -> pr "string array -> "
8828     | Bool _ -> pr "bool -> "
8829     | Int _ -> pr "int -> "
8830     | Int64 _ -> pr "int64 -> "
8831   ) (snd style);
8832   (match fst style with
8833    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8834    | RInt _ -> pr "int"
8835    | RInt64 _ -> pr "int64"
8836    | RBool _ -> pr "bool"
8837    | RConstString _ -> pr "string"
8838    | RConstOptString _ -> pr "string option"
8839    | RString _ | RBufferOut _ -> pr "string"
8840    | RStringList _ -> pr "string array"
8841    | RStruct (_, typ) -> pr "%s" typ
8842    | RStructList (_, typ) -> pr "%s array" typ
8843    | RHashtable _ -> pr "(string * string) list"
8844   );
8845   if is_external then (
8846     pr " = ";
8847     if List.length (snd style) + 1 > 5 then
8848       pr "\"ocaml_guestfs_%s_byte\" " name;
8849     pr "\"ocaml_guestfs_%s\"" name
8850   );
8851   pr "\n"
8852
8853 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8854 and generate_perl_xs () =
8855   generate_header CStyle LGPLv2plus;
8856
8857   pr "\
8858 #include \"EXTERN.h\"
8859 #include \"perl.h\"
8860 #include \"XSUB.h\"
8861
8862 #include <guestfs.h>
8863
8864 #ifndef PRId64
8865 #define PRId64 \"lld\"
8866 #endif
8867
8868 static SV *
8869 my_newSVll(long long val) {
8870 #ifdef USE_64_BIT_ALL
8871   return newSViv(val);
8872 #else
8873   char buf[100];
8874   int len;
8875   len = snprintf(buf, 100, \"%%\" PRId64, val);
8876   return newSVpv(buf, len);
8877 #endif
8878 }
8879
8880 #ifndef PRIu64
8881 #define PRIu64 \"llu\"
8882 #endif
8883
8884 static SV *
8885 my_newSVull(unsigned long long val) {
8886 #ifdef USE_64_BIT_ALL
8887   return newSVuv(val);
8888 #else
8889   char buf[100];
8890   int len;
8891   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8892   return newSVpv(buf, len);
8893 #endif
8894 }
8895
8896 /* http://www.perlmonks.org/?node_id=680842 */
8897 static char **
8898 XS_unpack_charPtrPtr (SV *arg) {
8899   char **ret;
8900   AV *av;
8901   I32 i;
8902
8903   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8904     croak (\"array reference expected\");
8905
8906   av = (AV *)SvRV (arg);
8907   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8908   if (!ret)
8909     croak (\"malloc failed\");
8910
8911   for (i = 0; i <= av_len (av); i++) {
8912     SV **elem = av_fetch (av, i, 0);
8913
8914     if (!elem || !*elem)
8915       croak (\"missing element in list\");
8916
8917     ret[i] = SvPV_nolen (*elem);
8918   }
8919
8920   ret[i] = NULL;
8921
8922   return ret;
8923 }
8924
8925 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8926
8927 PROTOTYPES: ENABLE
8928
8929 guestfs_h *
8930 _create ()
8931    CODE:
8932       RETVAL = guestfs_create ();
8933       if (!RETVAL)
8934         croak (\"could not create guestfs handle\");
8935       guestfs_set_error_handler (RETVAL, NULL, NULL);
8936  OUTPUT:
8937       RETVAL
8938
8939 void
8940 DESTROY (sv)
8941       SV *sv;
8942  PPCODE:
8943       /* For the 'g' argument above we do the conversion explicitly and
8944        * don't rely on the typemap, because if the handle has been
8945        * explicitly closed we don't want the typemap conversion to
8946        * display an error.
8947        */
8948       HV *hv = (HV *) SvRV (sv);
8949       SV **svp = hv_fetch (hv, \"_g\", 2, 0);
8950       if (svp != NULL) {
8951         guestfs_h *g = (guestfs_h *) SvIV (*svp);
8952         assert (g != NULL);
8953         guestfs_close (g);
8954       }
8955
8956 void
8957 close (g)
8958       guestfs_h *g;
8959  PPCODE:
8960       guestfs_close (g);
8961       /* Avoid double-free in DESTROY method. */
8962       HV *hv = (HV *) SvRV (ST(0));
8963       (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
8964
8965 ";
8966
8967   List.iter (
8968     fun (name, style, _, _, _, _, _) ->
8969       (match fst style with
8970        | RErr -> pr "void\n"
8971        | RInt _ -> pr "SV *\n"
8972        | RInt64 _ -> pr "SV *\n"
8973        | RBool _ -> pr "SV *\n"
8974        | RConstString _ -> pr "SV *\n"
8975        | RConstOptString _ -> pr "SV *\n"
8976        | RString _ -> pr "SV *\n"
8977        | RBufferOut _ -> pr "SV *\n"
8978        | RStringList _
8979        | RStruct _ | RStructList _
8980        | RHashtable _ ->
8981            pr "void\n" (* all lists returned implictly on the stack *)
8982       );
8983       (* Call and arguments. *)
8984       pr "%s (g" name;
8985       List.iter (
8986         fun arg -> pr ", %s" (name_of_argt arg)
8987       ) (snd style);
8988       pr ")\n";
8989       pr "      guestfs_h *g;\n";
8990       iteri (
8991         fun i ->
8992           function
8993           | Pathname n | Device n | Dev_or_Path n | String n
8994           | FileIn n | FileOut n ->
8995               pr "      char *%s;\n" n
8996           | BufferIn n ->
8997               pr "      char *%s;\n" n;
8998               pr "      size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
8999           | OptString n ->
9000               (* http://www.perlmonks.org/?node_id=554277
9001                * Note that the implicit handle argument means we have
9002                * to add 1 to the ST(x) operator.
9003                *)
9004               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
9005           | StringList n | DeviceList n -> pr "      char **%s;\n" n
9006           | Bool n -> pr "      int %s;\n" n
9007           | Int n -> pr "      int %s;\n" n
9008           | Int64 n -> pr "      int64_t %s;\n" n
9009       ) (snd style);
9010
9011       let do_cleanups () =
9012         List.iter (
9013           function
9014           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
9015           | Bool _ | Int _ | Int64 _
9016           | FileIn _ | FileOut _
9017           | BufferIn _ -> ()
9018           | StringList n | DeviceList n -> pr "      free (%s);\n" n
9019         ) (snd style)
9020       in
9021
9022       (* Code. *)
9023       (match fst style with
9024        | RErr ->
9025            pr "PREINIT:\n";
9026            pr "      int r;\n";
9027            pr " PPCODE:\n";
9028            pr "      r = guestfs_%s " name;
9029            generate_c_call_args ~handle:"g" style;
9030            pr ";\n";
9031            do_cleanups ();
9032            pr "      if (r == -1)\n";
9033            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9034        | RInt n
9035        | RBool n ->
9036            pr "PREINIT:\n";
9037            pr "      int %s;\n" n;
9038            pr "   CODE:\n";
9039            pr "      %s = guestfs_%s " n name;
9040            generate_c_call_args ~handle:"g" style;
9041            pr ";\n";
9042            do_cleanups ();
9043            pr "      if (%s == -1)\n" n;
9044            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9045            pr "      RETVAL = newSViv (%s);\n" n;
9046            pr " OUTPUT:\n";
9047            pr "      RETVAL\n"
9048        | RInt64 n ->
9049            pr "PREINIT:\n";
9050            pr "      int64_t %s;\n" n;
9051            pr "   CODE:\n";
9052            pr "      %s = guestfs_%s " n name;
9053            generate_c_call_args ~handle:"g" style;
9054            pr ";\n";
9055            do_cleanups ();
9056            pr "      if (%s == -1)\n" n;
9057            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9058            pr "      RETVAL = my_newSVll (%s);\n" n;
9059            pr " OUTPUT:\n";
9060            pr "      RETVAL\n"
9061        | RConstString n ->
9062            pr "PREINIT:\n";
9063            pr "      const char *%s;\n" n;
9064            pr "   CODE:\n";
9065            pr "      %s = guestfs_%s " n name;
9066            generate_c_call_args ~handle:"g" style;
9067            pr ";\n";
9068            do_cleanups ();
9069            pr "      if (%s == NULL)\n" n;
9070            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9071            pr "      RETVAL = newSVpv (%s, 0);\n" n;
9072            pr " OUTPUT:\n";
9073            pr "      RETVAL\n"
9074        | RConstOptString n ->
9075            pr "PREINIT:\n";
9076            pr "      const char *%s;\n" n;
9077            pr "   CODE:\n";
9078            pr "      %s = guestfs_%s " n name;
9079            generate_c_call_args ~handle:"g" style;
9080            pr ";\n";
9081            do_cleanups ();
9082            pr "      if (%s == NULL)\n" n;
9083            pr "        RETVAL = &PL_sv_undef;\n";
9084            pr "      else\n";
9085            pr "        RETVAL = newSVpv (%s, 0);\n" n;
9086            pr " OUTPUT:\n";
9087            pr "      RETVAL\n"
9088        | RString n ->
9089            pr "PREINIT:\n";
9090            pr "      char *%s;\n" n;
9091            pr "   CODE:\n";
9092            pr "      %s = guestfs_%s " n name;
9093            generate_c_call_args ~handle:"g" style;
9094            pr ";\n";
9095            do_cleanups ();
9096            pr "      if (%s == NULL)\n" n;
9097            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9098            pr "      RETVAL = newSVpv (%s, 0);\n" n;
9099            pr "      free (%s);\n" n;
9100            pr " OUTPUT:\n";
9101            pr "      RETVAL\n"
9102        | RStringList n | RHashtable n ->
9103            pr "PREINIT:\n";
9104            pr "      char **%s;\n" n;
9105            pr "      size_t i, n;\n";
9106            pr " PPCODE:\n";
9107            pr "      %s = guestfs_%s " n name;
9108            generate_c_call_args ~handle:"g" style;
9109            pr ";\n";
9110            do_cleanups ();
9111            pr "      if (%s == NULL)\n" n;
9112            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9113            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
9114            pr "      EXTEND (SP, n);\n";
9115            pr "      for (i = 0; i < n; ++i) {\n";
9116            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
9117            pr "        free (%s[i]);\n" n;
9118            pr "      }\n";
9119            pr "      free (%s);\n" n;
9120        | RStruct (n, typ) ->
9121            let cols = cols_of_struct typ in
9122            generate_perl_struct_code typ cols name style n do_cleanups
9123        | RStructList (n, typ) ->
9124            let cols = cols_of_struct typ in
9125            generate_perl_struct_list_code typ cols name style n do_cleanups
9126        | RBufferOut n ->
9127            pr "PREINIT:\n";
9128            pr "      char *%s;\n" n;
9129            pr "      size_t size;\n";
9130            pr "   CODE:\n";
9131            pr "      %s = guestfs_%s " n name;
9132            generate_c_call_args ~handle:"g" style;
9133            pr ";\n";
9134            do_cleanups ();
9135            pr "      if (%s == NULL)\n" n;
9136            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9137            pr "      RETVAL = newSVpvn (%s, size);\n" n;
9138            pr "      free (%s);\n" n;
9139            pr " OUTPUT:\n";
9140            pr "      RETVAL\n"
9141       );
9142
9143       pr "\n"
9144   ) all_functions
9145
9146 and generate_perl_struct_list_code typ cols name style n do_cleanups =
9147   pr "PREINIT:\n";
9148   pr "      struct guestfs_%s_list *%s;\n" typ n;
9149   pr "      size_t i;\n";
9150   pr "      HV *hv;\n";
9151   pr " PPCODE:\n";
9152   pr "      %s = guestfs_%s " n name;
9153   generate_c_call_args ~handle:"g" style;
9154   pr ";\n";
9155   do_cleanups ();
9156   pr "      if (%s == NULL)\n" n;
9157   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9158   pr "      EXTEND (SP, %s->len);\n" n;
9159   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
9160   pr "        hv = newHV ();\n";
9161   List.iter (
9162     function
9163     | name, FString ->
9164         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
9165           name (String.length name) n name
9166     | name, FUUID ->
9167         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
9168           name (String.length name) n name
9169     | name, FBuffer ->
9170         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
9171           name (String.length name) n name n name
9172     | name, (FBytes|FUInt64) ->
9173         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
9174           name (String.length name) n name
9175     | name, FInt64 ->
9176         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
9177           name (String.length name) n name
9178     | name, (FInt32|FUInt32) ->
9179         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
9180           name (String.length name) n name
9181     | name, FChar ->
9182         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
9183           name (String.length name) n name
9184     | name, FOptPercent ->
9185         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
9186           name (String.length name) n name
9187   ) cols;
9188   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
9189   pr "      }\n";
9190   pr "      guestfs_free_%s_list (%s);\n" typ n
9191
9192 and generate_perl_struct_code typ cols name style n do_cleanups =
9193   pr "PREINIT:\n";
9194   pr "      struct guestfs_%s *%s;\n" typ n;
9195   pr " PPCODE:\n";
9196   pr "      %s = guestfs_%s " n name;
9197   generate_c_call_args ~handle:"g" style;
9198   pr ";\n";
9199   do_cleanups ();
9200   pr "      if (%s == NULL)\n" n;
9201   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9202   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
9203   List.iter (
9204     fun ((name, _) as col) ->
9205       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
9206
9207       match col with
9208       | name, FString ->
9209           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
9210             n name
9211       | name, FBuffer ->
9212           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
9213             n name n name
9214       | name, FUUID ->
9215           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
9216             n name
9217       | name, (FBytes|FUInt64) ->
9218           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
9219             n name
9220       | name, FInt64 ->
9221           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
9222             n name
9223       | name, (FInt32|FUInt32) ->
9224           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
9225             n name
9226       | name, FChar ->
9227           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
9228             n name
9229       | name, FOptPercent ->
9230           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
9231             n name
9232   ) cols;
9233   pr "      free (%s);\n" n
9234
9235 (* Generate Sys/Guestfs.pm. *)
9236 and generate_perl_pm () =
9237   generate_header HashStyle LGPLv2plus;
9238
9239   pr "\
9240 =pod
9241
9242 =head1 NAME
9243
9244 Sys::Guestfs - Perl bindings for libguestfs
9245
9246 =head1 SYNOPSIS
9247
9248  use Sys::Guestfs;
9249
9250  my $h = Sys::Guestfs->new ();
9251  $h->add_drive ('guest.img');
9252  $h->launch ();
9253  $h->mount ('/dev/sda1', '/');
9254  $h->touch ('/hello');
9255  $h->sync ();
9256
9257 =head1 DESCRIPTION
9258
9259 The C<Sys::Guestfs> module provides a Perl XS binding to the
9260 libguestfs API for examining and modifying virtual machine
9261 disk images.
9262
9263 Amongst the things this is good for: making batch configuration
9264 changes to guests, getting disk used/free statistics (see also:
9265 virt-df), migrating between virtualization systems (see also:
9266 virt-p2v), performing partial backups, performing partial guest
9267 clones, cloning guests and changing registry/UUID/hostname info, and
9268 much else besides.
9269
9270 Libguestfs uses Linux kernel and qemu code, and can access any type of
9271 guest filesystem that Linux and qemu can, including but not limited
9272 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9273 schemes, qcow, qcow2, vmdk.
9274
9275 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9276 LVs, what filesystem is in each LV, etc.).  It can also run commands
9277 in the context of the guest.  Also you can access filesystems over
9278 FUSE.
9279
9280 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
9281 functions for using libguestfs from Perl, including integration
9282 with libvirt.
9283
9284 =head1 ERRORS
9285
9286 All errors turn into calls to C<croak> (see L<Carp(3)>).
9287
9288 =head1 METHODS
9289
9290 =over 4
9291
9292 =cut
9293
9294 package Sys::Guestfs;
9295
9296 use strict;
9297 use warnings;
9298
9299 # This version number changes whenever a new function
9300 # is added to the libguestfs API.  It is not directly
9301 # related to the libguestfs version number.
9302 use vars qw($VERSION);
9303 $VERSION = '0.%d';
9304
9305 require XSLoader;
9306 XSLoader::load ('Sys::Guestfs');
9307
9308 =item $h = Sys::Guestfs->new ();
9309
9310 Create a new guestfs handle.
9311
9312 =cut
9313
9314 sub new {
9315   my $proto = shift;
9316   my $class = ref ($proto) || $proto;
9317
9318   my $g = Sys::Guestfs::_create ();
9319   my $self = { _g => $g };
9320   bless $self, $class;
9321   return $self;
9322 }
9323
9324 =item $h->close ();
9325
9326 Explicitly close the guestfs handle.
9327
9328 B<Note:> You should not usually call this function.  The handle will
9329 be closed implicitly when its reference count goes to zero (eg.
9330 when it goes out of scope or the program ends).  This call is
9331 only required in some exceptional cases, such as where the program
9332 may contain cached references to the handle 'somewhere' and you
9333 really have to have the close happen right away.  After calling
9334 C<close> the program must not call any method (including C<close>)
9335 on the handle (but the implicit call to C<DESTROY> that happens
9336 when the final reference is cleaned up is OK).
9337
9338 =cut
9339
9340 " max_proc_nr;
9341
9342   (* Actions.  We only need to print documentation for these as
9343    * they are pulled in from the XS code automatically.
9344    *)
9345   List.iter (
9346     fun (name, style, _, flags, _, _, longdesc) ->
9347       if not (List.mem NotInDocs flags) then (
9348         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
9349         pr "=item ";
9350         generate_perl_prototype name style;
9351         pr "\n\n";
9352         pr "%s\n\n" longdesc;
9353         if List.mem ProtocolLimitWarning flags then
9354           pr "%s\n\n" protocol_limit_warning;
9355         if List.mem DangerWillRobinson flags then
9356           pr "%s\n\n" danger_will_robinson;
9357         match deprecation_notice flags with
9358         | None -> ()
9359         | Some txt -> pr "%s\n\n" txt
9360       )
9361   ) all_functions_sorted;
9362
9363   (* End of file. *)
9364   pr "\
9365 =cut
9366
9367 1;
9368
9369 =back
9370
9371 =head1 AVAILABILITY
9372
9373 From time to time we add new libguestfs APIs.  Also some libguestfs
9374 APIs won't be available in all builds of libguestfs (the Fedora
9375 build is full-featured, but other builds may disable features).
9376 How do you test whether the APIs that your Perl program needs are
9377 available in the version of C<Sys::Guestfs> that you are using?
9378
9379 To test if a particular function is available in the C<Sys::Guestfs>
9380 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
9381 (see L<perlobj(1)>).  For example:
9382
9383  use Sys::Guestfs;
9384  if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
9385    print \"\\$h->set_verbose is available\\n\";
9386  }
9387
9388 To test if particular features are supported by the current
9389 build, use the L</available> method like the example below.  Note
9390 that the appliance must be launched first.
9391
9392  $h->available ( [\"augeas\"] );
9393
9394 Since the L</available> method croaks if the feature is not supported,
9395 you might also want to wrap this in an eval and return a boolean.
9396 In fact this has already been done for you: use
9397 L<Sys::Guestfs::Lib(3)/feature_available>.
9398
9399 For further discussion on this topic, refer to
9400 L<guestfs(3)/AVAILABILITY>.
9401
9402 =head1 STORING DATA IN THE HANDLE
9403
9404 The handle returned from L</new> is a hash reference.  The hash
9405 normally contains a single element:
9406
9407  {
9408    _g => [private data used by libguestfs]
9409  }
9410
9411 Callers can add other elements to this hash to store data for their own
9412 purposes.  The data lasts for the lifetime of the handle.
9413
9414 Any fields whose names begin with an underscore are reserved
9415 for private use by libguestfs.  We may add more in future.
9416
9417 It is recommended that callers prefix the name of their field(s)
9418 with some unique string, to avoid conflicts with other users.
9419
9420 =head1 COPYRIGHT
9421
9422 Copyright (C) %s Red Hat Inc.
9423
9424 =head1 LICENSE
9425
9426 Please see the file COPYING.LIB for the full license.
9427
9428 =head1 SEE ALSO
9429
9430 L<guestfs(3)>,
9431 L<guestfish(1)>,
9432 L<http://libguestfs.org>,
9433 L<Sys::Guestfs::Lib(3)>.
9434
9435 =cut
9436 " copyright_years
9437
9438 and generate_perl_prototype name style =
9439   (match fst style with
9440    | RErr -> ()
9441    | RBool n
9442    | RInt n
9443    | RInt64 n
9444    | RConstString n
9445    | RConstOptString n
9446    | RString n
9447    | RBufferOut n -> pr "$%s = " n
9448    | RStruct (n,_)
9449    | RHashtable n -> pr "%%%s = " n
9450    | RStringList n
9451    | RStructList (n,_) -> pr "@%s = " n
9452   );
9453   pr "$h->%s (" name;
9454   let comma = ref false in
9455   List.iter (
9456     fun arg ->
9457       if !comma then pr ", ";
9458       comma := true;
9459       match arg with
9460       | Pathname n | Device n | Dev_or_Path n | String n
9461       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
9462       | BufferIn n ->
9463           pr "$%s" n
9464       | StringList n | DeviceList n ->
9465           pr "\\@%s" n
9466   ) (snd style);
9467   pr ");"
9468
9469 (* Generate Python C module. *)
9470 and generate_python_c () =
9471   generate_header CStyle LGPLv2plus;
9472
9473   pr "\
9474 #define PY_SSIZE_T_CLEAN 1
9475 #include <Python.h>
9476
9477 #if PY_VERSION_HEX < 0x02050000
9478 typedef int Py_ssize_t;
9479 #define PY_SSIZE_T_MAX INT_MAX
9480 #define PY_SSIZE_T_MIN INT_MIN
9481 #endif
9482
9483 #include <stdio.h>
9484 #include <stdlib.h>
9485 #include <assert.h>
9486
9487 #include \"guestfs.h\"
9488
9489 typedef struct {
9490   PyObject_HEAD
9491   guestfs_h *g;
9492 } Pyguestfs_Object;
9493
9494 static guestfs_h *
9495 get_handle (PyObject *obj)
9496 {
9497   assert (obj);
9498   assert (obj != Py_None);
9499   return ((Pyguestfs_Object *) obj)->g;
9500 }
9501
9502 static PyObject *
9503 put_handle (guestfs_h *g)
9504 {
9505   assert (g);
9506   return
9507     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
9508 }
9509
9510 /* This list should be freed (but not the strings) after use. */
9511 static char **
9512 get_string_list (PyObject *obj)
9513 {
9514   size_t i, len;
9515   char **r;
9516
9517   assert (obj);
9518
9519   if (!PyList_Check (obj)) {
9520     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
9521     return NULL;
9522   }
9523
9524   Py_ssize_t slen = PyList_Size (obj);
9525   if (slen == -1) {
9526     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
9527     return NULL;
9528   }
9529   len = (size_t) slen;
9530   r = malloc (sizeof (char *) * (len+1));
9531   if (r == NULL) {
9532     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
9533     return NULL;
9534   }
9535
9536   for (i = 0; i < len; ++i)
9537     r[i] = PyString_AsString (PyList_GetItem (obj, i));
9538   r[len] = NULL;
9539
9540   return r;
9541 }
9542
9543 static PyObject *
9544 put_string_list (char * const * const argv)
9545 {
9546   PyObject *list;
9547   int argc, i;
9548
9549   for (argc = 0; argv[argc] != NULL; ++argc)
9550     ;
9551
9552   list = PyList_New (argc);
9553   for (i = 0; i < argc; ++i)
9554     PyList_SetItem (list, i, PyString_FromString (argv[i]));
9555
9556   return list;
9557 }
9558
9559 static PyObject *
9560 put_table (char * const * const argv)
9561 {
9562   PyObject *list, *item;
9563   int argc, i;
9564
9565   for (argc = 0; argv[argc] != NULL; ++argc)
9566     ;
9567
9568   list = PyList_New (argc >> 1);
9569   for (i = 0; i < argc; i += 2) {
9570     item = PyTuple_New (2);
9571     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
9572     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
9573     PyList_SetItem (list, i >> 1, item);
9574   }
9575
9576   return list;
9577 }
9578
9579 static void
9580 free_strings (char **argv)
9581 {
9582   int argc;
9583
9584   for (argc = 0; argv[argc] != NULL; ++argc)
9585     free (argv[argc]);
9586   free (argv);
9587 }
9588
9589 static PyObject *
9590 py_guestfs_create (PyObject *self, PyObject *args)
9591 {
9592   guestfs_h *g;
9593
9594   g = guestfs_create ();
9595   if (g == NULL) {
9596     PyErr_SetString (PyExc_RuntimeError,
9597                      \"guestfs.create: failed to allocate handle\");
9598     return NULL;
9599   }
9600   guestfs_set_error_handler (g, NULL, NULL);
9601   return put_handle (g);
9602 }
9603
9604 static PyObject *
9605 py_guestfs_close (PyObject *self, PyObject *args)
9606 {
9607   PyObject *py_g;
9608   guestfs_h *g;
9609
9610   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
9611     return NULL;
9612   g = get_handle (py_g);
9613
9614   guestfs_close (g);
9615
9616   Py_INCREF (Py_None);
9617   return Py_None;
9618 }
9619
9620 ";
9621
9622   let emit_put_list_function typ =
9623     pr "static PyObject *\n";
9624     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
9625     pr "{\n";
9626     pr "  PyObject *list;\n";
9627     pr "  size_t i;\n";
9628     pr "\n";
9629     pr "  list = PyList_New (%ss->len);\n" typ;
9630     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
9631     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
9632     pr "  return list;\n";
9633     pr "};\n";
9634     pr "\n"
9635   in
9636
9637   (* Structures, turned into Python dictionaries. *)
9638   List.iter (
9639     fun (typ, cols) ->
9640       pr "static PyObject *\n";
9641       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
9642       pr "{\n";
9643       pr "  PyObject *dict;\n";
9644       pr "\n";
9645       pr "  dict = PyDict_New ();\n";
9646       List.iter (
9647         function
9648         | name, FString ->
9649             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9650             pr "                        PyString_FromString (%s->%s));\n"
9651               typ name
9652         | name, FBuffer ->
9653             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9654             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
9655               typ name typ name
9656         | name, FUUID ->
9657             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9658             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
9659               typ name
9660         | name, (FBytes|FUInt64) ->
9661             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9662             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
9663               typ name
9664         | name, FInt64 ->
9665             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9666             pr "                        PyLong_FromLongLong (%s->%s));\n"
9667               typ name
9668         | name, FUInt32 ->
9669             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9670             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
9671               typ name
9672         | name, FInt32 ->
9673             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9674             pr "                        PyLong_FromLong (%s->%s));\n"
9675               typ name
9676         | name, FOptPercent ->
9677             pr "  if (%s->%s >= 0)\n" typ name;
9678             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
9679             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
9680               typ name;
9681             pr "  else {\n";
9682             pr "    Py_INCREF (Py_None);\n";
9683             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
9684             pr "  }\n"
9685         | name, FChar ->
9686             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9687             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
9688       ) cols;
9689       pr "  return dict;\n";
9690       pr "};\n";
9691       pr "\n";
9692
9693   ) structs;
9694
9695   (* Emit a put_TYPE_list function definition only if that function is used. *)
9696   List.iter (
9697     function
9698     | typ, (RStructListOnly | RStructAndList) ->
9699         (* generate the function for typ *)
9700         emit_put_list_function typ
9701     | typ, _ -> () (* empty *)
9702   ) (rstructs_used_by all_functions);
9703
9704   (* Python wrapper functions. *)
9705   List.iter (
9706     fun (name, style, _, _, _, _, _) ->
9707       pr "static PyObject *\n";
9708       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9709       pr "{\n";
9710
9711       pr "  PyObject *py_g;\n";
9712       pr "  guestfs_h *g;\n";
9713       pr "  PyObject *py_r;\n";
9714
9715       let error_code =
9716         match fst style with
9717         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9718         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9719         | RConstString _ | RConstOptString _ ->
9720             pr "  const char *r;\n"; "NULL"
9721         | RString _ -> pr "  char *r;\n"; "NULL"
9722         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9723         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9724         | RStructList (_, typ) ->
9725             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9726         | RBufferOut _ ->
9727             pr "  char *r;\n";
9728             pr "  size_t size;\n";
9729             "NULL" in
9730
9731       List.iter (
9732         function
9733         | Pathname n | Device n | Dev_or_Path n | String n
9734         | FileIn n | FileOut n ->
9735             pr "  const char *%s;\n" n
9736         | OptString n -> pr "  const char *%s;\n" n
9737         | BufferIn n ->
9738             pr "  const char *%s;\n" n;
9739             pr "  Py_ssize_t %s_size;\n" n
9740         | StringList n | DeviceList n ->
9741             pr "  PyObject *py_%s;\n" n;
9742             pr "  char **%s;\n" n
9743         | Bool n -> pr "  int %s;\n" n
9744         | Int n -> pr "  int %s;\n" n
9745         | Int64 n -> pr "  long long %s;\n" n
9746       ) (snd style);
9747
9748       pr "\n";
9749
9750       (* Convert the parameters. *)
9751       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9752       List.iter (
9753         function
9754         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9755         | OptString _ -> pr "z"
9756         | StringList _ | DeviceList _ -> pr "O"
9757         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9758         | Int _ -> pr "i"
9759         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9760                              * emulate C's int/long/long long in Python?
9761                              *)
9762         | BufferIn _ -> pr "s#"
9763       ) (snd style);
9764       pr ":guestfs_%s\",\n" name;
9765       pr "                         &py_g";
9766       List.iter (
9767         function
9768         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9769         | OptString n -> pr ", &%s" n
9770         | StringList n | DeviceList n -> pr ", &py_%s" n
9771         | Bool n -> pr ", &%s" n
9772         | Int n -> pr ", &%s" n
9773         | Int64 n -> pr ", &%s" n
9774         | BufferIn n -> pr ", &%s, &%s_size" n n
9775       ) (snd style);
9776
9777       pr "))\n";
9778       pr "    return NULL;\n";
9779
9780       pr "  g = get_handle (py_g);\n";
9781       List.iter (
9782         function
9783         | Pathname _ | Device _ | Dev_or_Path _ | String _
9784         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
9785         | BufferIn _ -> ()
9786         | StringList n | DeviceList n ->
9787             pr "  %s = get_string_list (py_%s);\n" n n;
9788             pr "  if (!%s) return NULL;\n" n
9789       ) (snd style);
9790
9791       pr "\n";
9792
9793       pr "  r = guestfs_%s " name;
9794       generate_c_call_args ~handle:"g" style;
9795       pr ";\n";
9796
9797       List.iter (
9798         function
9799         | Pathname _ | Device _ | Dev_or_Path _ | String _
9800         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
9801         | BufferIn _ -> ()
9802         | StringList n | DeviceList n ->
9803             pr "  free (%s);\n" n
9804       ) (snd style);
9805
9806       pr "  if (r == %s) {\n" error_code;
9807       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9808       pr "    return NULL;\n";
9809       pr "  }\n";
9810       pr "\n";
9811
9812       (match fst style with
9813        | RErr ->
9814            pr "  Py_INCREF (Py_None);\n";
9815            pr "  py_r = Py_None;\n"
9816        | RInt _
9817        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9818        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9819        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9820        | RConstOptString _ ->
9821            pr "  if (r)\n";
9822            pr "    py_r = PyString_FromString (r);\n";
9823            pr "  else {\n";
9824            pr "    Py_INCREF (Py_None);\n";
9825            pr "    py_r = Py_None;\n";
9826            pr "  }\n"
9827        | RString _ ->
9828            pr "  py_r = PyString_FromString (r);\n";
9829            pr "  free (r);\n"
9830        | RStringList _ ->
9831            pr "  py_r = put_string_list (r);\n";
9832            pr "  free_strings (r);\n"
9833        | RStruct (_, typ) ->
9834            pr "  py_r = put_%s (r);\n" typ;
9835            pr "  guestfs_free_%s (r);\n" typ
9836        | RStructList (_, typ) ->
9837            pr "  py_r = put_%s_list (r);\n" typ;
9838            pr "  guestfs_free_%s_list (r);\n" typ
9839        | RHashtable n ->
9840            pr "  py_r = put_table (r);\n";
9841            pr "  free_strings (r);\n"
9842        | RBufferOut _ ->
9843            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9844            pr "  free (r);\n"
9845       );
9846
9847       pr "  return py_r;\n";
9848       pr "}\n";
9849       pr "\n"
9850   ) all_functions;
9851
9852   (* Table of functions. *)
9853   pr "static PyMethodDef methods[] = {\n";
9854   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9855   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9856   List.iter (
9857     fun (name, _, _, _, _, _, _) ->
9858       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9859         name name
9860   ) all_functions;
9861   pr "  { NULL, NULL, 0, NULL }\n";
9862   pr "};\n";
9863   pr "\n";
9864
9865   (* Init function. *)
9866   pr "\
9867 void
9868 initlibguestfsmod (void)
9869 {
9870   static int initialized = 0;
9871
9872   if (initialized) return;
9873   Py_InitModule ((char *) \"libguestfsmod\", methods);
9874   initialized = 1;
9875 }
9876 "
9877
9878 (* Generate Python module. *)
9879 and generate_python_py () =
9880   generate_header HashStyle LGPLv2plus;
9881
9882   pr "\
9883 u\"\"\"Python bindings for libguestfs
9884
9885 import guestfs
9886 g = guestfs.GuestFS ()
9887 g.add_drive (\"guest.img\")
9888 g.launch ()
9889 parts = g.list_partitions ()
9890
9891 The guestfs module provides a Python binding to the libguestfs API
9892 for examining and modifying virtual machine disk images.
9893
9894 Amongst the things this is good for: making batch configuration
9895 changes to guests, getting disk used/free statistics (see also:
9896 virt-df), migrating between virtualization systems (see also:
9897 virt-p2v), performing partial backups, performing partial guest
9898 clones, cloning guests and changing registry/UUID/hostname info, and
9899 much else besides.
9900
9901 Libguestfs uses Linux kernel and qemu code, and can access any type of
9902 guest filesystem that Linux and qemu can, including but not limited
9903 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9904 schemes, qcow, qcow2, vmdk.
9905
9906 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9907 LVs, what filesystem is in each LV, etc.).  It can also run commands
9908 in the context of the guest.  Also you can access filesystems over
9909 FUSE.
9910
9911 Errors which happen while using the API are turned into Python
9912 RuntimeError exceptions.
9913
9914 To create a guestfs handle you usually have to perform the following
9915 sequence of calls:
9916
9917 # Create the handle, call add_drive at least once, and possibly
9918 # several times if the guest has multiple block devices:
9919 g = guestfs.GuestFS ()
9920 g.add_drive (\"guest.img\")
9921
9922 # Launch the qemu subprocess and wait for it to become ready:
9923 g.launch ()
9924
9925 # Now you can issue commands, for example:
9926 logvols = g.lvs ()
9927
9928 \"\"\"
9929
9930 import libguestfsmod
9931
9932 class GuestFS:
9933     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9934
9935     def __init__ (self):
9936         \"\"\"Create a new libguestfs handle.\"\"\"
9937         self._o = libguestfsmod.create ()
9938
9939     def __del__ (self):
9940         libguestfsmod.close (self._o)
9941
9942 ";
9943
9944   List.iter (
9945     fun (name, style, _, flags, _, _, longdesc) ->
9946       pr "    def %s " name;
9947       generate_py_call_args ~handle:"self" (snd style);
9948       pr ":\n";
9949
9950       if not (List.mem NotInDocs flags) then (
9951         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9952         let doc =
9953           match fst style with
9954           | RErr | RInt _ | RInt64 _ | RBool _
9955           | RConstOptString _ | RConstString _
9956           | RString _ | RBufferOut _ -> doc
9957           | RStringList _ ->
9958               doc ^ "\n\nThis function returns a list of strings."
9959           | RStruct (_, typ) ->
9960               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9961           | RStructList (_, typ) ->
9962               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9963           | RHashtable _ ->
9964               doc ^ "\n\nThis function returns a dictionary." in
9965         let doc =
9966           if List.mem ProtocolLimitWarning flags then
9967             doc ^ "\n\n" ^ protocol_limit_warning
9968           else doc in
9969         let doc =
9970           if List.mem DangerWillRobinson flags then
9971             doc ^ "\n\n" ^ danger_will_robinson
9972           else doc in
9973         let doc =
9974           match deprecation_notice flags with
9975           | None -> doc
9976           | Some txt -> doc ^ "\n\n" ^ txt in
9977         let doc = pod2text ~width:60 name doc in
9978         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9979         let doc = String.concat "\n        " doc in
9980         pr "        u\"\"\"%s\"\"\"\n" doc;
9981       );
9982       pr "        return libguestfsmod.%s " name;
9983       generate_py_call_args ~handle:"self._o" (snd style);
9984       pr "\n";
9985       pr "\n";
9986   ) all_functions
9987
9988 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9989 and generate_py_call_args ~handle args =
9990   pr "(%s" handle;
9991   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9992   pr ")"
9993
9994 (* Useful if you need the longdesc POD text as plain text.  Returns a
9995  * list of lines.
9996  *
9997  * Because this is very slow (the slowest part of autogeneration),
9998  * we memoize the results.
9999  *)
10000 and pod2text ~width name longdesc =
10001   let key = width, name, longdesc in
10002   try Hashtbl.find pod2text_memo key
10003   with Not_found ->
10004     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
10005     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
10006     close_out chan;
10007     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
10008     let chan = open_process_in cmd in
10009     let lines = ref [] in
10010     let rec loop i =
10011       let line = input_line chan in
10012       if i = 1 then             (* discard the first line of output *)
10013         loop (i+1)
10014       else (
10015         let line = triml line in
10016         lines := line :: !lines;
10017         loop (i+1)
10018       ) in
10019     let lines = try loop 1 with End_of_file -> List.rev !lines in
10020     unlink filename;
10021     (match close_process_in chan with
10022      | WEXITED 0 -> ()
10023      | WEXITED i ->
10024          failwithf "pod2text: process exited with non-zero status (%d)" i
10025      | WSIGNALED i | WSTOPPED i ->
10026          failwithf "pod2text: process signalled or stopped by signal %d" i
10027     );
10028     Hashtbl.add pod2text_memo key lines;
10029     pod2text_memo_updated ();
10030     lines
10031
10032 (* Generate ruby bindings. *)
10033 and generate_ruby_c () =
10034   generate_header CStyle LGPLv2plus;
10035
10036   pr "\
10037 #include <stdio.h>
10038 #include <stdlib.h>
10039
10040 #include <ruby.h>
10041
10042 #include \"guestfs.h\"
10043
10044 #include \"extconf.h\"
10045
10046 /* For Ruby < 1.9 */
10047 #ifndef RARRAY_LEN
10048 #define RARRAY_LEN(r) (RARRAY((r))->len)
10049 #endif
10050
10051 static VALUE m_guestfs;                 /* guestfs module */
10052 static VALUE c_guestfs;                 /* guestfs_h handle */
10053 static VALUE e_Error;                   /* used for all errors */
10054
10055 static void ruby_guestfs_free (void *p)
10056 {
10057   if (!p) return;
10058   guestfs_close ((guestfs_h *) p);
10059 }
10060
10061 static VALUE ruby_guestfs_create (VALUE m)
10062 {
10063   guestfs_h *g;
10064
10065   g = guestfs_create ();
10066   if (!g)
10067     rb_raise (e_Error, \"failed to create guestfs handle\");
10068
10069   /* Don't print error messages to stderr by default. */
10070   guestfs_set_error_handler (g, NULL, NULL);
10071
10072   /* Wrap it, and make sure the close function is called when the
10073    * handle goes away.
10074    */
10075   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
10076 }
10077
10078 static VALUE ruby_guestfs_close (VALUE gv)
10079 {
10080   guestfs_h *g;
10081   Data_Get_Struct (gv, guestfs_h, g);
10082
10083   ruby_guestfs_free (g);
10084   DATA_PTR (gv) = NULL;
10085
10086   return Qnil;
10087 }
10088
10089 ";
10090
10091   List.iter (
10092     fun (name, style, _, _, _, _, _) ->
10093       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
10094       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
10095       pr ")\n";
10096       pr "{\n";
10097       pr "  guestfs_h *g;\n";
10098       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
10099       pr "  if (!g)\n";
10100       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
10101         name;
10102       pr "\n";
10103
10104       List.iter (
10105         function
10106         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
10107             pr "  Check_Type (%sv, T_STRING);\n" n;
10108             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
10109             pr "  if (!%s)\n" n;
10110             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
10111             pr "              \"%s\", \"%s\");\n" n name
10112         | BufferIn n ->
10113             pr "  Check_Type (%sv, T_STRING);\n" n;
10114             pr "  const char *%s = RSTRING (%sv)->ptr;\n" n n;
10115             pr "  if (!%s)\n" n;
10116             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
10117             pr "              \"%s\", \"%s\");\n" n name;
10118             pr "  size_t %s_size = RSTRING (%sv)->len;\n" n n
10119         | OptString n ->
10120             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
10121         | StringList n | DeviceList n ->
10122             pr "  char **%s;\n" n;
10123             pr "  Check_Type (%sv, T_ARRAY);\n" n;
10124             pr "  {\n";
10125             pr "    size_t i, len;\n";
10126             pr "    len = RARRAY_LEN (%sv);\n" n;
10127             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
10128               n;
10129             pr "    for (i = 0; i < len; ++i) {\n";
10130             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
10131             pr "      %s[i] = StringValueCStr (v);\n" n;
10132             pr "    }\n";
10133             pr "    %s[len] = NULL;\n" n;
10134             pr "  }\n";
10135         | Bool n ->
10136             pr "  int %s = RTEST (%sv);\n" n n
10137         | Int n ->
10138             pr "  int %s = NUM2INT (%sv);\n" n n
10139         | Int64 n ->
10140             pr "  long long %s = NUM2LL (%sv);\n" n n
10141       ) (snd style);
10142       pr "\n";
10143
10144       let error_code =
10145         match fst style with
10146         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
10147         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
10148         | RConstString _ | RConstOptString _ ->
10149             pr "  const char *r;\n"; "NULL"
10150         | RString _ -> pr "  char *r;\n"; "NULL"
10151         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
10152         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
10153         | RStructList (_, typ) ->
10154             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
10155         | RBufferOut _ ->
10156             pr "  char *r;\n";
10157             pr "  size_t size;\n";
10158             "NULL" in
10159       pr "\n";
10160
10161       pr "  r = guestfs_%s " name;
10162       generate_c_call_args ~handle:"g" style;
10163       pr ";\n";
10164
10165       List.iter (
10166         function
10167         | Pathname _ | Device _ | Dev_or_Path _ | String _
10168         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
10169         | BufferIn _ -> ()
10170         | StringList n | DeviceList n ->
10171             pr "  free (%s);\n" n
10172       ) (snd style);
10173
10174       pr "  if (r == %s)\n" error_code;
10175       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
10176       pr "\n";
10177
10178       (match fst style with
10179        | RErr ->
10180            pr "  return Qnil;\n"
10181        | RInt _ | RBool _ ->
10182            pr "  return INT2NUM (r);\n"
10183        | RInt64 _ ->
10184            pr "  return ULL2NUM (r);\n"
10185        | RConstString _ ->
10186            pr "  return rb_str_new2 (r);\n";
10187        | RConstOptString _ ->
10188            pr "  if (r)\n";
10189            pr "    return rb_str_new2 (r);\n";
10190            pr "  else\n";
10191            pr "    return Qnil;\n";
10192        | RString _ ->
10193            pr "  VALUE rv = rb_str_new2 (r);\n";
10194            pr "  free (r);\n";
10195            pr "  return rv;\n";
10196        | RStringList _ ->
10197            pr "  size_t i, len = 0;\n";
10198            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
10199            pr "  VALUE rv = rb_ary_new2 (len);\n";
10200            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
10201            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
10202            pr "    free (r[i]);\n";
10203            pr "  }\n";
10204            pr "  free (r);\n";
10205            pr "  return rv;\n"
10206        | RStruct (_, typ) ->
10207            let cols = cols_of_struct typ in
10208            generate_ruby_struct_code typ cols
10209        | RStructList (_, typ) ->
10210            let cols = cols_of_struct typ in
10211            generate_ruby_struct_list_code typ cols
10212        | RHashtable _ ->
10213            pr "  VALUE rv = rb_hash_new ();\n";
10214            pr "  size_t i;\n";
10215            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
10216            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
10217            pr "    free (r[i]);\n";
10218            pr "    free (r[i+1]);\n";
10219            pr "  }\n";
10220            pr "  free (r);\n";
10221            pr "  return rv;\n"
10222        | RBufferOut _ ->
10223            pr "  VALUE rv = rb_str_new (r, size);\n";
10224            pr "  free (r);\n";
10225            pr "  return rv;\n";
10226       );
10227
10228       pr "}\n";
10229       pr "\n"
10230   ) all_functions;
10231
10232   pr "\
10233 /* Initialize the module. */
10234 void Init__guestfs ()
10235 {
10236   m_guestfs = rb_define_module (\"Guestfs\");
10237   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
10238   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
10239
10240   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
10241   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
10242
10243 ";
10244   (* Define the rest of the methods. *)
10245   List.iter (
10246     fun (name, style, _, _, _, _, _) ->
10247       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
10248       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
10249   ) all_functions;
10250
10251   pr "}\n"
10252
10253 (* Ruby code to return a struct. *)
10254 and generate_ruby_struct_code typ cols =
10255   pr "  VALUE rv = rb_hash_new ();\n";
10256   List.iter (
10257     function
10258     | name, FString ->
10259         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
10260     | name, FBuffer ->
10261         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
10262     | name, FUUID ->
10263         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
10264     | name, (FBytes|FUInt64) ->
10265         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
10266     | name, FInt64 ->
10267         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
10268     | name, FUInt32 ->
10269         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
10270     | name, FInt32 ->
10271         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
10272     | name, FOptPercent ->
10273         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
10274     | name, FChar -> (* XXX wrong? *)
10275         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
10276   ) cols;
10277   pr "  guestfs_free_%s (r);\n" typ;
10278   pr "  return rv;\n"
10279
10280 (* Ruby code to return a struct list. *)
10281 and generate_ruby_struct_list_code typ cols =
10282   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
10283   pr "  size_t i;\n";
10284   pr "  for (i = 0; i < r->len; ++i) {\n";
10285   pr "    VALUE hv = rb_hash_new ();\n";
10286   List.iter (
10287     function
10288     | name, FString ->
10289         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
10290     | name, FBuffer ->
10291         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
10292     | name, FUUID ->
10293         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
10294     | name, (FBytes|FUInt64) ->
10295         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
10296     | name, FInt64 ->
10297         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
10298     | name, FUInt32 ->
10299         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
10300     | name, FInt32 ->
10301         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
10302     | name, FOptPercent ->
10303         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
10304     | name, FChar -> (* XXX wrong? *)
10305         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
10306   ) cols;
10307   pr "    rb_ary_push (rv, hv);\n";
10308   pr "  }\n";
10309   pr "  guestfs_free_%s_list (r);\n" typ;
10310   pr "  return rv;\n"
10311
10312 (* Generate Java bindings GuestFS.java file. *)
10313 and generate_java_java () =
10314   generate_header CStyle LGPLv2plus;
10315
10316   pr "\
10317 package com.redhat.et.libguestfs;
10318
10319 import java.util.HashMap;
10320 import com.redhat.et.libguestfs.LibGuestFSException;
10321 import com.redhat.et.libguestfs.PV;
10322 import com.redhat.et.libguestfs.VG;
10323 import com.redhat.et.libguestfs.LV;
10324 import com.redhat.et.libguestfs.Stat;
10325 import com.redhat.et.libguestfs.StatVFS;
10326 import com.redhat.et.libguestfs.IntBool;
10327 import com.redhat.et.libguestfs.Dirent;
10328
10329 /**
10330  * The GuestFS object is a libguestfs handle.
10331  *
10332  * @author rjones
10333  */
10334 public class GuestFS {
10335   // Load the native code.
10336   static {
10337     System.loadLibrary (\"guestfs_jni\");
10338   }
10339
10340   /**
10341    * The native guestfs_h pointer.
10342    */
10343   long g;
10344
10345   /**
10346    * Create a libguestfs handle.
10347    *
10348    * @throws LibGuestFSException
10349    */
10350   public GuestFS () throws LibGuestFSException
10351   {
10352     g = _create ();
10353   }
10354   private native long _create () throws LibGuestFSException;
10355
10356   /**
10357    * Close a libguestfs handle.
10358    *
10359    * You can also leave handles to be collected by the garbage
10360    * collector, but this method ensures that the resources used
10361    * by the handle are freed up immediately.  If you call any
10362    * other methods after closing the handle, you will get an
10363    * exception.
10364    *
10365    * @throws LibGuestFSException
10366    */
10367   public void close () throws LibGuestFSException
10368   {
10369     if (g != 0)
10370       _close (g);
10371     g = 0;
10372   }
10373   private native void _close (long g) throws LibGuestFSException;
10374
10375   public void finalize () throws LibGuestFSException
10376   {
10377     close ();
10378   }
10379
10380 ";
10381
10382   List.iter (
10383     fun (name, style, _, flags, _, shortdesc, longdesc) ->
10384       if not (List.mem NotInDocs flags); then (
10385         let doc = replace_str longdesc "C<guestfs_" "C<g." in
10386         let doc =
10387           if List.mem ProtocolLimitWarning flags then
10388             doc ^ "\n\n" ^ protocol_limit_warning
10389           else doc in
10390         let doc =
10391           if List.mem DangerWillRobinson flags then
10392             doc ^ "\n\n" ^ danger_will_robinson
10393           else doc in
10394         let doc =
10395           match deprecation_notice flags with
10396           | None -> doc
10397           | Some txt -> doc ^ "\n\n" ^ txt in
10398         let doc = pod2text ~width:60 name doc in
10399         let doc = List.map (            (* RHBZ#501883 *)
10400           function
10401           | "" -> "<p>"
10402           | nonempty -> nonempty
10403         ) doc in
10404         let doc = String.concat "\n   * " doc in
10405
10406         pr "  /**\n";
10407         pr "   * %s\n" shortdesc;
10408         pr "   * <p>\n";
10409         pr "   * %s\n" doc;
10410         pr "   * @throws LibGuestFSException\n";
10411         pr "   */\n";
10412         pr "  ";
10413       );
10414       generate_java_prototype ~public:true ~semicolon:false name style;
10415       pr "\n";
10416       pr "  {\n";
10417       pr "    if (g == 0)\n";
10418       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
10419         name;
10420       pr "    ";
10421       if fst style <> RErr then pr "return ";
10422       pr "_%s " name;
10423       generate_java_call_args ~handle:"g" (snd style);
10424       pr ";\n";
10425       pr "  }\n";
10426       pr "  ";
10427       generate_java_prototype ~privat:true ~native:true name style;
10428       pr "\n";
10429       pr "\n";
10430   ) all_functions;
10431
10432   pr "}\n"
10433
10434 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
10435 and generate_java_call_args ~handle args =
10436   pr "(%s" handle;
10437   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
10438   pr ")"
10439
10440 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
10441     ?(semicolon=true) name style =
10442   if privat then pr "private ";
10443   if public then pr "public ";
10444   if native then pr "native ";
10445
10446   (* return type *)
10447   (match fst style with
10448    | RErr -> pr "void ";
10449    | RInt _ -> pr "int ";
10450    | RInt64 _ -> pr "long ";
10451    | RBool _ -> pr "boolean ";
10452    | RConstString _ | RConstOptString _ | RString _
10453    | RBufferOut _ -> pr "String ";
10454    | RStringList _ -> pr "String[] ";
10455    | RStruct (_, typ) ->
10456        let name = java_name_of_struct typ in
10457        pr "%s " name;
10458    | RStructList (_, typ) ->
10459        let name = java_name_of_struct typ in
10460        pr "%s[] " name;
10461    | RHashtable _ -> pr "HashMap<String,String> ";
10462   );
10463
10464   if native then pr "_%s " name else pr "%s " name;
10465   pr "(";
10466   let needs_comma = ref false in
10467   if native then (
10468     pr "long g";
10469     needs_comma := true
10470   );
10471
10472   (* args *)
10473   List.iter (
10474     fun arg ->
10475       if !needs_comma then pr ", ";
10476       needs_comma := true;
10477
10478       match arg with
10479       | Pathname n
10480       | Device n | Dev_or_Path n
10481       | String n
10482       | OptString n
10483       | FileIn n
10484       | FileOut n ->
10485           pr "String %s" n
10486       | BufferIn n ->
10487           pr "byte[] %s" n
10488       | StringList n | DeviceList n ->
10489           pr "String[] %s" n
10490       | Bool n ->
10491           pr "boolean %s" n
10492       | Int n ->
10493           pr "int %s" n
10494       | Int64 n ->
10495           pr "long %s" n
10496   ) (snd style);
10497
10498   pr ")\n";
10499   pr "    throws LibGuestFSException";
10500   if semicolon then pr ";"
10501
10502 and generate_java_struct jtyp cols () =
10503   generate_header CStyle LGPLv2plus;
10504
10505   pr "\
10506 package com.redhat.et.libguestfs;
10507
10508 /**
10509  * Libguestfs %s structure.
10510  *
10511  * @author rjones
10512  * @see GuestFS
10513  */
10514 public class %s {
10515 " jtyp jtyp;
10516
10517   List.iter (
10518     function
10519     | name, FString
10520     | name, FUUID
10521     | name, FBuffer -> pr "  public String %s;\n" name
10522     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
10523     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
10524     | name, FChar -> pr "  public char %s;\n" name
10525     | name, FOptPercent ->
10526         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
10527         pr "  public float %s;\n" name
10528   ) cols;
10529
10530   pr "}\n"
10531
10532 and generate_java_c () =
10533   generate_header CStyle LGPLv2plus;
10534
10535   pr "\
10536 #include <stdio.h>
10537 #include <stdlib.h>
10538 #include <string.h>
10539
10540 #include \"com_redhat_et_libguestfs_GuestFS.h\"
10541 #include \"guestfs.h\"
10542
10543 /* Note that this function returns.  The exception is not thrown
10544  * until after the wrapper function returns.
10545  */
10546 static void
10547 throw_exception (JNIEnv *env, const char *msg)
10548 {
10549   jclass cl;
10550   cl = (*env)->FindClass (env,
10551                           \"com/redhat/et/libguestfs/LibGuestFSException\");
10552   (*env)->ThrowNew (env, cl, msg);
10553 }
10554
10555 JNIEXPORT jlong JNICALL
10556 Java_com_redhat_et_libguestfs_GuestFS__1create
10557   (JNIEnv *env, jobject obj)
10558 {
10559   guestfs_h *g;
10560
10561   g = guestfs_create ();
10562   if (g == NULL) {
10563     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
10564     return 0;
10565   }
10566   guestfs_set_error_handler (g, NULL, NULL);
10567   return (jlong) (long) g;
10568 }
10569
10570 JNIEXPORT void JNICALL
10571 Java_com_redhat_et_libguestfs_GuestFS__1close
10572   (JNIEnv *env, jobject obj, jlong jg)
10573 {
10574   guestfs_h *g = (guestfs_h *) (long) jg;
10575   guestfs_close (g);
10576 }
10577
10578 ";
10579
10580   List.iter (
10581     fun (name, style, _, _, _, _, _) ->
10582       pr "JNIEXPORT ";
10583       (match fst style with
10584        | RErr -> pr "void ";
10585        | RInt _ -> pr "jint ";
10586        | RInt64 _ -> pr "jlong ";
10587        | RBool _ -> pr "jboolean ";
10588        | RConstString _ | RConstOptString _ | RString _
10589        | RBufferOut _ -> pr "jstring ";
10590        | RStruct _ | RHashtable _ ->
10591            pr "jobject ";
10592        | RStringList _ | RStructList _ ->
10593            pr "jobjectArray ";
10594       );
10595       pr "JNICALL\n";
10596       pr "Java_com_redhat_et_libguestfs_GuestFS_";
10597       pr "%s" (replace_str ("_" ^ name) "_" "_1");
10598       pr "\n";
10599       pr "  (JNIEnv *env, jobject obj, jlong jg";
10600       List.iter (
10601         function
10602         | Pathname n
10603         | Device n | Dev_or_Path n
10604         | String n
10605         | OptString n
10606         | FileIn n
10607         | FileOut n ->
10608             pr ", jstring j%s" n
10609         | BufferIn n ->
10610             pr ", jbyteArray j%s" n
10611         | StringList n | DeviceList n ->
10612             pr ", jobjectArray j%s" n
10613         | Bool n ->
10614             pr ", jboolean j%s" n
10615         | Int n ->
10616             pr ", jint j%s" n
10617         | Int64 n ->
10618             pr ", jlong j%s" n
10619       ) (snd style);
10620       pr ")\n";
10621       pr "{\n";
10622       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
10623       let error_code, no_ret =
10624         match fst style with
10625         | RErr -> pr "  int r;\n"; "-1", ""
10626         | RBool _
10627         | RInt _ -> pr "  int r;\n"; "-1", "0"
10628         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
10629         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
10630         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
10631         | RString _ ->
10632             pr "  jstring jr;\n";
10633             pr "  char *r;\n"; "NULL", "NULL"
10634         | RStringList _ ->
10635             pr "  jobjectArray jr;\n";
10636             pr "  int r_len;\n";
10637             pr "  jclass cl;\n";
10638             pr "  jstring jstr;\n";
10639             pr "  char **r;\n"; "NULL", "NULL"
10640         | RStruct (_, typ) ->
10641             pr "  jobject jr;\n";
10642             pr "  jclass cl;\n";
10643             pr "  jfieldID fl;\n";
10644             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
10645         | RStructList (_, typ) ->
10646             pr "  jobjectArray jr;\n";
10647             pr "  jclass cl;\n";
10648             pr "  jfieldID fl;\n";
10649             pr "  jobject jfl;\n";
10650             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
10651         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
10652         | RBufferOut _ ->
10653             pr "  jstring jr;\n";
10654             pr "  char *r;\n";
10655             pr "  size_t size;\n";
10656             "NULL", "NULL" in
10657       List.iter (
10658         function
10659         | Pathname n
10660         | Device n | Dev_or_Path n
10661         | String n
10662         | OptString n
10663         | FileIn n
10664         | FileOut n ->
10665             pr "  const char *%s;\n" n
10666         | BufferIn n ->
10667             pr "  jbyte *%s;\n" n;
10668             pr "  size_t %s_size;\n" n
10669         | StringList n | DeviceList n ->
10670             pr "  int %s_len;\n" n;
10671             pr "  const char **%s;\n" n
10672         | Bool n
10673         | Int n ->
10674             pr "  int %s;\n" n
10675         | Int64 n ->
10676             pr "  int64_t %s;\n" n
10677       ) (snd style);
10678
10679       let needs_i =
10680         (match fst style with
10681          | RStringList _ | RStructList _ -> true
10682          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
10683          | RConstOptString _
10684          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
10685           List.exists (function
10686                        | StringList _ -> true
10687                        | DeviceList _ -> true
10688                        | _ -> false) (snd style) in
10689       if needs_i then
10690         pr "  size_t i;\n";
10691
10692       pr "\n";
10693
10694       (* Get the parameters. *)
10695       List.iter (
10696         function
10697         | Pathname n
10698         | Device n | Dev_or_Path n
10699         | String n
10700         | FileIn n
10701         | FileOut n ->
10702             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
10703         | OptString n ->
10704             (* This is completely undocumented, but Java null becomes
10705              * a NULL parameter.
10706              *)
10707             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
10708         | BufferIn n ->
10709             pr "  %s = (*env)->GetByteArrayElements (env, j%s, NULL);\n" n n;
10710             pr "  %s_size = (*env)->GetArrayLength (env, j%s);\n" n n
10711         | StringList n | DeviceList n ->
10712             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
10713             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
10714             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10715             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10716               n;
10717             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
10718             pr "  }\n";
10719             pr "  %s[%s_len] = NULL;\n" n n;
10720         | Bool n
10721         | Int n
10722         | Int64 n ->
10723             pr "  %s = j%s;\n" n n
10724       ) (snd style);
10725
10726       (* Make the call. *)
10727       pr "  r = guestfs_%s " name;
10728       generate_c_call_args ~handle:"g" style;
10729       pr ";\n";
10730
10731       (* Release the parameters. *)
10732       List.iter (
10733         function
10734         | Pathname n
10735         | Device n | Dev_or_Path n
10736         | String n
10737         | FileIn n
10738         | FileOut n ->
10739             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10740         | OptString n ->
10741             pr "  if (j%s)\n" n;
10742             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10743         | BufferIn n ->
10744             pr "  (*env)->ReleaseByteArrayElements (env, j%s, %s, 0);\n" n n
10745         | StringList n | DeviceList n ->
10746             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10747             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10748               n;
10749             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10750             pr "  }\n";
10751             pr "  free (%s);\n" n
10752         | Bool n
10753         | Int n
10754         | Int64 n -> ()
10755       ) (snd style);
10756
10757       (* Check for errors. *)
10758       pr "  if (r == %s) {\n" error_code;
10759       pr "    throw_exception (env, guestfs_last_error (g));\n";
10760       pr "    return %s;\n" no_ret;
10761       pr "  }\n";
10762
10763       (* Return value. *)
10764       (match fst style with
10765        | RErr -> ()
10766        | RInt _ -> pr "  return (jint) r;\n"
10767        | RBool _ -> pr "  return (jboolean) r;\n"
10768        | RInt64 _ -> pr "  return (jlong) r;\n"
10769        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10770        | RConstOptString _ ->
10771            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10772        | RString _ ->
10773            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10774            pr "  free (r);\n";
10775            pr "  return jr;\n"
10776        | RStringList _ ->
10777            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10778            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10779            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10780            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10781            pr "  for (i = 0; i < r_len; ++i) {\n";
10782            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10783            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10784            pr "    free (r[i]);\n";
10785            pr "  }\n";
10786            pr "  free (r);\n";
10787            pr "  return jr;\n"
10788        | RStruct (_, typ) ->
10789            let jtyp = java_name_of_struct typ in
10790            let cols = cols_of_struct typ in
10791            generate_java_struct_return typ jtyp cols
10792        | RStructList (_, typ) ->
10793            let jtyp = java_name_of_struct typ in
10794            let cols = cols_of_struct typ in
10795            generate_java_struct_list_return typ jtyp cols
10796        | RHashtable _ ->
10797            (* XXX *)
10798            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10799            pr "  return NULL;\n"
10800        | RBufferOut _ ->
10801            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10802            pr "  free (r);\n";
10803            pr "  return jr;\n"
10804       );
10805
10806       pr "}\n";
10807       pr "\n"
10808   ) all_functions
10809
10810 and generate_java_struct_return typ jtyp cols =
10811   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10812   pr "  jr = (*env)->AllocObject (env, cl);\n";
10813   List.iter (
10814     function
10815     | name, FString ->
10816         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10817         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10818     | name, FUUID ->
10819         pr "  {\n";
10820         pr "    char s[33];\n";
10821         pr "    memcpy (s, r->%s, 32);\n" name;
10822         pr "    s[32] = 0;\n";
10823         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10824         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10825         pr "  }\n";
10826     | name, FBuffer ->
10827         pr "  {\n";
10828         pr "    int len = r->%s_len;\n" name;
10829         pr "    char s[len+1];\n";
10830         pr "    memcpy (s, r->%s, len);\n" name;
10831         pr "    s[len] = 0;\n";
10832         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10833         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10834         pr "  }\n";
10835     | name, (FBytes|FUInt64|FInt64) ->
10836         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10837         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10838     | name, (FUInt32|FInt32) ->
10839         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10840         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10841     | name, FOptPercent ->
10842         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10843         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10844     | name, FChar ->
10845         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10846         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10847   ) cols;
10848   pr "  free (r);\n";
10849   pr "  return jr;\n"
10850
10851 and generate_java_struct_list_return typ jtyp cols =
10852   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10853   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10854   pr "  for (i = 0; i < r->len; ++i) {\n";
10855   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10856   List.iter (
10857     function
10858     | name, FString ->
10859         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10860         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10861     | name, FUUID ->
10862         pr "    {\n";
10863         pr "      char s[33];\n";
10864         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10865         pr "      s[32] = 0;\n";
10866         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10867         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10868         pr "    }\n";
10869     | name, FBuffer ->
10870         pr "    {\n";
10871         pr "      int len = r->val[i].%s_len;\n" name;
10872         pr "      char s[len+1];\n";
10873         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10874         pr "      s[len] = 0;\n";
10875         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10876         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10877         pr "    }\n";
10878     | name, (FBytes|FUInt64|FInt64) ->
10879         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10880         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10881     | name, (FUInt32|FInt32) ->
10882         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10883         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10884     | name, FOptPercent ->
10885         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10886         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10887     | name, FChar ->
10888         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10889         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10890   ) cols;
10891   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10892   pr "  }\n";
10893   pr "  guestfs_free_%s_list (r);\n" typ;
10894   pr "  return jr;\n"
10895
10896 and generate_java_makefile_inc () =
10897   generate_header HashStyle GPLv2plus;
10898
10899   pr "java_built_sources = \\\n";
10900   List.iter (
10901     fun (typ, jtyp) ->
10902         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10903   ) java_structs;
10904   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10905
10906 and generate_haskell_hs () =
10907   generate_header HaskellStyle LGPLv2plus;
10908
10909   (* XXX We only know how to generate partial FFI for Haskell
10910    * at the moment.  Please help out!
10911    *)
10912   let can_generate style =
10913     match style with
10914     | RErr, _
10915     | RInt _, _
10916     | RInt64 _, _ -> true
10917     | RBool _, _
10918     | RConstString _, _
10919     | RConstOptString _, _
10920     | RString _, _
10921     | RStringList _, _
10922     | RStruct _, _
10923     | RStructList _, _
10924     | RHashtable _, _
10925     | RBufferOut _, _ -> false in
10926
10927   pr "\
10928 {-# INCLUDE <guestfs.h> #-}
10929 {-# LANGUAGE ForeignFunctionInterface #-}
10930
10931 module Guestfs (
10932   create";
10933
10934   (* List out the names of the actions we want to export. *)
10935   List.iter (
10936     fun (name, style, _, _, _, _, _) ->
10937       if can_generate style then pr ",\n  %s" name
10938   ) all_functions;
10939
10940   pr "
10941   ) where
10942
10943 -- Unfortunately some symbols duplicate ones already present
10944 -- in Prelude.  We don't know which, so we hard-code a list
10945 -- here.
10946 import Prelude hiding (truncate)
10947
10948 import Foreign
10949 import Foreign.C
10950 import Foreign.C.Types
10951 import IO
10952 import Control.Exception
10953 import Data.Typeable
10954
10955 data GuestfsS = GuestfsS            -- represents the opaque C struct
10956 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10957 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10958
10959 -- XXX define properly later XXX
10960 data PV = PV
10961 data VG = VG
10962 data LV = LV
10963 data IntBool = IntBool
10964 data Stat = Stat
10965 data StatVFS = StatVFS
10966 data Hashtable = Hashtable
10967
10968 foreign import ccall unsafe \"guestfs_create\" c_create
10969   :: IO GuestfsP
10970 foreign import ccall unsafe \"&guestfs_close\" c_close
10971   :: FunPtr (GuestfsP -> IO ())
10972 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10973   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10974
10975 create :: IO GuestfsH
10976 create = do
10977   p <- c_create
10978   c_set_error_handler p nullPtr nullPtr
10979   h <- newForeignPtr c_close p
10980   return h
10981
10982 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10983   :: GuestfsP -> IO CString
10984
10985 -- last_error :: GuestfsH -> IO (Maybe String)
10986 -- last_error h = do
10987 --   str <- withForeignPtr h (\\p -> c_last_error p)
10988 --   maybePeek peekCString str
10989
10990 last_error :: GuestfsH -> IO (String)
10991 last_error h = do
10992   str <- withForeignPtr h (\\p -> c_last_error p)
10993   if (str == nullPtr)
10994     then return \"no error\"
10995     else peekCString str
10996
10997 ";
10998
10999   (* Generate wrappers for each foreign function. *)
11000   List.iter (
11001     fun (name, style, _, _, _, _, _) ->
11002       if can_generate style then (
11003         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
11004         pr "  :: ";
11005         generate_haskell_prototype ~handle:"GuestfsP" style;
11006         pr "\n";
11007         pr "\n";
11008         pr "%s :: " name;
11009         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
11010         pr "\n";
11011         pr "%s %s = do\n" name
11012           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
11013         pr "  r <- ";
11014         (* Convert pointer arguments using with* functions. *)
11015         List.iter (
11016           function
11017           | FileIn n
11018           | FileOut n
11019           | Pathname n | Device n | Dev_or_Path n | String n ->
11020               pr "withCString %s $ \\%s -> " n n
11021           | BufferIn n ->
11022               pr "withCStringLen %s $ \\(%s, %s_size) -> " n n n
11023           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
11024           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
11025           | Bool _ | Int _ | Int64 _ -> ()
11026         ) (snd style);
11027         (* Convert integer arguments. *)
11028         let args =
11029           List.map (
11030             function
11031             | Bool n -> sprintf "(fromBool %s)" n
11032             | Int n -> sprintf "(fromIntegral %s)" n
11033             | Int64 n -> sprintf "(fromIntegral %s)" n
11034             | FileIn n | FileOut n
11035             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
11036             | BufferIn n -> sprintf "%s (fromIntegral %s_size)" n n
11037           ) (snd style) in
11038         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
11039           (String.concat " " ("p" :: args));
11040         (match fst style with
11041          | RErr | RInt _ | RInt64 _ | RBool _ ->
11042              pr "  if (r == -1)\n";
11043              pr "    then do\n";
11044              pr "      err <- last_error h\n";
11045              pr "      fail err\n";
11046          | RConstString _ | RConstOptString _ | RString _
11047          | RStringList _ | RStruct _
11048          | RStructList _ | RHashtable _ | RBufferOut _ ->
11049              pr "  if (r == nullPtr)\n";
11050              pr "    then do\n";
11051              pr "      err <- last_error h\n";
11052              pr "      fail err\n";
11053         );
11054         (match fst style with
11055          | RErr ->
11056              pr "    else return ()\n"
11057          | RInt _ ->
11058              pr "    else return (fromIntegral r)\n"
11059          | RInt64 _ ->
11060              pr "    else return (fromIntegral r)\n"
11061          | RBool _ ->
11062              pr "    else return (toBool r)\n"
11063          | RConstString _
11064          | RConstOptString _
11065          | RString _
11066          | RStringList _
11067          | RStruct _
11068          | RStructList _
11069          | RHashtable _
11070          | RBufferOut _ ->
11071              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
11072         );
11073         pr "\n";
11074       )
11075   ) all_functions
11076
11077 and generate_haskell_prototype ~handle ?(hs = false) style =
11078   pr "%s -> " handle;
11079   let string = if hs then "String" else "CString" in
11080   let int = if hs then "Int" else "CInt" in
11081   let bool = if hs then "Bool" else "CInt" in
11082   let int64 = if hs then "Integer" else "Int64" in
11083   List.iter (
11084     fun arg ->
11085       (match arg with
11086        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
11087        | BufferIn _ ->
11088            if hs then pr "String"
11089            else pr "CString -> CInt"
11090        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
11091        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
11092        | Bool _ -> pr "%s" bool
11093        | Int _ -> pr "%s" int
11094        | Int64 _ -> pr "%s" int
11095        | FileIn _ -> pr "%s" string
11096        | FileOut _ -> pr "%s" string
11097       );
11098       pr " -> ";
11099   ) (snd style);
11100   pr "IO (";
11101   (match fst style with
11102    | RErr -> if not hs then pr "CInt"
11103    | RInt _ -> pr "%s" int
11104    | RInt64 _ -> pr "%s" int64
11105    | RBool _ -> pr "%s" bool
11106    | RConstString _ -> pr "%s" string
11107    | RConstOptString _ -> pr "Maybe %s" string
11108    | RString _ -> pr "%s" string
11109    | RStringList _ -> pr "[%s]" string
11110    | RStruct (_, typ) ->
11111        let name = java_name_of_struct typ in
11112        pr "%s" name
11113    | RStructList (_, typ) ->
11114        let name = java_name_of_struct typ in
11115        pr "[%s]" name
11116    | RHashtable _ -> pr "Hashtable"
11117    | RBufferOut _ -> pr "%s" string
11118   );
11119   pr ")"
11120
11121 and generate_csharp () =
11122   generate_header CPlusPlusStyle LGPLv2plus;
11123
11124   (* XXX Make this configurable by the C# assembly users. *)
11125   let library = "libguestfs.so.0" in
11126
11127   pr "\
11128 // These C# bindings are highly experimental at present.
11129 //
11130 // Firstly they only work on Linux (ie. Mono).  In order to get them
11131 // to work on Windows (ie. .Net) you would need to port the library
11132 // itself to Windows first.
11133 //
11134 // The second issue is that some calls are known to be incorrect and
11135 // can cause Mono to segfault.  Particularly: calls which pass or
11136 // return string[], or return any structure value.  This is because
11137 // we haven't worked out the correct way to do this from C#.
11138 //
11139 // The third issue is that when compiling you get a lot of warnings.
11140 // We are not sure whether the warnings are important or not.
11141 //
11142 // Fourthly we do not routinely build or test these bindings as part
11143 // of the make && make check cycle, which means that regressions might
11144 // go unnoticed.
11145 //
11146 // Suggestions and patches are welcome.
11147
11148 // To compile:
11149 //
11150 // gmcs Libguestfs.cs
11151 // mono Libguestfs.exe
11152 //
11153 // (You'll probably want to add a Test class / static main function
11154 // otherwise this won't do anything useful).
11155
11156 using System;
11157 using System.IO;
11158 using System.Runtime.InteropServices;
11159 using System.Runtime.Serialization;
11160 using System.Collections;
11161
11162 namespace Guestfs
11163 {
11164   class Error : System.ApplicationException
11165   {
11166     public Error (string message) : base (message) {}
11167     protected Error (SerializationInfo info, StreamingContext context) {}
11168   }
11169
11170   class Guestfs
11171   {
11172     IntPtr _handle;
11173
11174     [DllImport (\"%s\")]
11175     static extern IntPtr guestfs_create ();
11176
11177     public Guestfs ()
11178     {
11179       _handle = guestfs_create ();
11180       if (_handle == IntPtr.Zero)
11181         throw new Error (\"could not create guestfs handle\");
11182     }
11183
11184     [DllImport (\"%s\")]
11185     static extern void guestfs_close (IntPtr h);
11186
11187     ~Guestfs ()
11188     {
11189       guestfs_close (_handle);
11190     }
11191
11192     [DllImport (\"%s\")]
11193     static extern string guestfs_last_error (IntPtr h);
11194
11195 " library library library;
11196
11197   (* Generate C# structure bindings.  We prefix struct names with
11198    * underscore because C# cannot have conflicting struct names and
11199    * method names (eg. "class stat" and "stat").
11200    *)
11201   List.iter (
11202     fun (typ, cols) ->
11203       pr "    [StructLayout (LayoutKind.Sequential)]\n";
11204       pr "    public class _%s {\n" typ;
11205       List.iter (
11206         function
11207         | name, FChar -> pr "      char %s;\n" name
11208         | name, FString -> pr "      string %s;\n" name
11209         | name, FBuffer ->
11210             pr "      uint %s_len;\n" name;
11211             pr "      string %s;\n" name
11212         | name, FUUID ->
11213             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
11214             pr "      string %s;\n" name
11215         | name, FUInt32 -> pr "      uint %s;\n" name
11216         | name, FInt32 -> pr "      int %s;\n" name
11217         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
11218         | name, FInt64 -> pr "      long %s;\n" name
11219         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
11220       ) cols;
11221       pr "    }\n";
11222       pr "\n"
11223   ) structs;
11224
11225   (* Generate C# function bindings. *)
11226   List.iter (
11227     fun (name, style, _, _, _, shortdesc, _) ->
11228       let rec csharp_return_type () =
11229         match fst style with
11230         | RErr -> "void"
11231         | RBool n -> "bool"
11232         | RInt n -> "int"
11233         | RInt64 n -> "long"
11234         | RConstString n
11235         | RConstOptString n
11236         | RString n
11237         | RBufferOut n -> "string"
11238         | RStruct (_,n) -> "_" ^ n
11239         | RHashtable n -> "Hashtable"
11240         | RStringList n -> "string[]"
11241         | RStructList (_,n) -> sprintf "_%s[]" n
11242
11243       and c_return_type () =
11244         match fst style with
11245         | RErr
11246         | RBool _
11247         | RInt _ -> "int"
11248         | RInt64 _ -> "long"
11249         | RConstString _
11250         | RConstOptString _
11251         | RString _
11252         | RBufferOut _ -> "string"
11253         | RStruct (_,n) -> "_" ^ n
11254         | RHashtable _
11255         | RStringList _ -> "string[]"
11256         | RStructList (_,n) -> sprintf "_%s[]" n
11257
11258       and c_error_comparison () =
11259         match fst style with
11260         | RErr
11261         | RBool _
11262         | RInt _
11263         | RInt64 _ -> "== -1"
11264         | RConstString _
11265         | RConstOptString _
11266         | RString _
11267         | RBufferOut _
11268         | RStruct (_,_)
11269         | RHashtable _
11270         | RStringList _
11271         | RStructList (_,_) -> "== null"
11272
11273       and generate_extern_prototype () =
11274         pr "    static extern %s guestfs_%s (IntPtr h"
11275           (c_return_type ()) name;
11276         List.iter (
11277           function
11278           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
11279           | FileIn n | FileOut n
11280           | BufferIn n ->
11281               pr ", [In] string %s" n
11282           | StringList n | DeviceList n ->
11283               pr ", [In] string[] %s" n
11284           | Bool n ->
11285               pr ", bool %s" n
11286           | Int n ->
11287               pr ", int %s" n
11288           | Int64 n ->
11289               pr ", long %s" n
11290         ) (snd style);
11291         pr ");\n"
11292
11293       and generate_public_prototype () =
11294         pr "    public %s %s (" (csharp_return_type ()) name;
11295         let comma = ref false in
11296         let next () =
11297           if !comma then pr ", ";
11298           comma := true
11299         in
11300         List.iter (
11301           function
11302           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
11303           | FileIn n | FileOut n
11304           | BufferIn n ->
11305               next (); pr "string %s" n
11306           | StringList n | DeviceList n ->
11307               next (); pr "string[] %s" n
11308           | Bool n ->
11309               next (); pr "bool %s" n
11310           | Int n ->
11311               next (); pr "int %s" n
11312           | Int64 n ->
11313               next (); pr "long %s" n
11314         ) (snd style);
11315         pr ")\n"
11316
11317       and generate_call () =
11318         pr "guestfs_%s (_handle" name;
11319         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
11320         pr ");\n";
11321       in
11322
11323       pr "    [DllImport (\"%s\")]\n" library;
11324       generate_extern_prototype ();
11325       pr "\n";
11326       pr "    /// <summary>\n";
11327       pr "    /// %s\n" shortdesc;
11328       pr "    /// </summary>\n";
11329       generate_public_prototype ();
11330       pr "    {\n";
11331       pr "      %s r;\n" (c_return_type ());
11332       pr "      r = ";
11333       generate_call ();
11334       pr "      if (r %s)\n" (c_error_comparison ());
11335       pr "        throw new Error (guestfs_last_error (_handle));\n";
11336       (match fst style with
11337        | RErr -> ()
11338        | RBool _ ->
11339            pr "      return r != 0 ? true : false;\n"
11340        | RHashtable _ ->
11341            pr "      Hashtable rr = new Hashtable ();\n";
11342            pr "      for (size_t i = 0; i < r.Length; i += 2)\n";
11343            pr "        rr.Add (r[i], r[i+1]);\n";
11344            pr "      return rr;\n"
11345        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
11346        | RString _ | RBufferOut _ | RStruct _ | RStringList _
11347        | RStructList _ ->
11348            pr "      return r;\n"
11349       );
11350       pr "    }\n";
11351       pr "\n";
11352   ) all_functions_sorted;
11353
11354   pr "  }
11355 }
11356 "
11357
11358 and generate_bindtests () =
11359   generate_header CStyle LGPLv2plus;
11360
11361   pr "\
11362 #include <stdio.h>
11363 #include <stdlib.h>
11364 #include <inttypes.h>
11365 #include <string.h>
11366
11367 #include \"guestfs.h\"
11368 #include \"guestfs-internal.h\"
11369 #include \"guestfs-internal-actions.h\"
11370 #include \"guestfs_protocol.h\"
11371
11372 #define error guestfs_error
11373 #define safe_calloc guestfs_safe_calloc
11374 #define safe_malloc guestfs_safe_malloc
11375
11376 static void
11377 print_strings (char *const *argv)
11378 {
11379   size_t argc;
11380
11381   printf (\"[\");
11382   for (argc = 0; argv[argc] != NULL; ++argc) {
11383     if (argc > 0) printf (\", \");
11384     printf (\"\\\"%%s\\\"\", argv[argc]);
11385   }
11386   printf (\"]\\n\");
11387 }
11388
11389 /* The test0 function prints its parameters to stdout. */
11390 ";
11391
11392   let test0, tests =
11393     match test_functions with
11394     | [] -> assert false
11395     | test0 :: tests -> test0, tests in
11396
11397   let () =
11398     let (name, style, _, _, _, _, _) = test0 in
11399     generate_prototype ~extern:false ~semicolon:false ~newline:true
11400       ~handle:"g" ~prefix:"guestfs__" name style;
11401     pr "{\n";
11402     List.iter (
11403       function
11404       | Pathname n
11405       | Device n | Dev_or_Path n
11406       | String n
11407       | FileIn n
11408       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
11409       | BufferIn n ->
11410           pr "  {\n";
11411           pr "    size_t i;\n";
11412           pr "    for (i = 0; i < %s_size; ++i)\n" n;
11413           pr "      printf (\"<%%02x>\", %s[i]);\n" n;
11414           pr "    printf (\"\\n\");\n";
11415           pr "  }\n";
11416       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
11417       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
11418       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
11419       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
11420       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
11421     ) (snd style);
11422     pr "  /* Java changes stdout line buffering so we need this: */\n";
11423     pr "  fflush (stdout);\n";
11424     pr "  return 0;\n";
11425     pr "}\n";
11426     pr "\n" in
11427
11428   List.iter (
11429     fun (name, style, _, _, _, _, _) ->
11430       if String.sub name (String.length name - 3) 3 <> "err" then (
11431         pr "/* Test normal return. */\n";
11432         generate_prototype ~extern:false ~semicolon:false ~newline:true
11433           ~handle:"g" ~prefix:"guestfs__" name style;
11434         pr "{\n";
11435         (match fst style with
11436          | RErr ->
11437              pr "  return 0;\n"
11438          | RInt _ ->
11439              pr "  int r;\n";
11440              pr "  sscanf (val, \"%%d\", &r);\n";
11441              pr "  return r;\n"
11442          | RInt64 _ ->
11443              pr "  int64_t r;\n";
11444              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
11445              pr "  return r;\n"
11446          | RBool _ ->
11447              pr "  return STREQ (val, \"true\");\n"
11448          | RConstString _
11449          | RConstOptString _ ->
11450              (* Can't return the input string here.  Return a static
11451               * string so we ensure we get a segfault if the caller
11452               * tries to free it.
11453               *)
11454              pr "  return \"static string\";\n"
11455          | RString _ ->
11456              pr "  return strdup (val);\n"
11457          | RStringList _ ->
11458              pr "  char **strs;\n";
11459              pr "  int n, i;\n";
11460              pr "  sscanf (val, \"%%d\", &n);\n";
11461              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
11462              pr "  for (i = 0; i < n; ++i) {\n";
11463              pr "    strs[i] = safe_malloc (g, 16);\n";
11464              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
11465              pr "  }\n";
11466              pr "  strs[n] = NULL;\n";
11467              pr "  return strs;\n"
11468          | RStruct (_, typ) ->
11469              pr "  struct guestfs_%s *r;\n" typ;
11470              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
11471              pr "  return r;\n"
11472          | RStructList (_, typ) ->
11473              pr "  struct guestfs_%s_list *r;\n" typ;
11474              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
11475              pr "  sscanf (val, \"%%d\", &r->len);\n";
11476              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
11477              pr "  return r;\n"
11478          | RHashtable _ ->
11479              pr "  char **strs;\n";
11480              pr "  int n, i;\n";
11481              pr "  sscanf (val, \"%%d\", &n);\n";
11482              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
11483              pr "  for (i = 0; i < n; ++i) {\n";
11484              pr "    strs[i*2] = safe_malloc (g, 16);\n";
11485              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
11486              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
11487              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
11488              pr "  }\n";
11489              pr "  strs[n*2] = NULL;\n";
11490              pr "  return strs;\n"
11491          | RBufferOut _ ->
11492              pr "  return strdup (val);\n"
11493         );
11494         pr "}\n";
11495         pr "\n"
11496       ) else (
11497         pr "/* Test error return. */\n";
11498         generate_prototype ~extern:false ~semicolon:false ~newline:true
11499           ~handle:"g" ~prefix:"guestfs__" name style;
11500         pr "{\n";
11501         pr "  error (g, \"error\");\n";
11502         (match fst style with
11503          | RErr | RInt _ | RInt64 _ | RBool _ ->
11504              pr "  return -1;\n"
11505          | RConstString _ | RConstOptString _
11506          | RString _ | RStringList _ | RStruct _
11507          | RStructList _
11508          | RHashtable _
11509          | RBufferOut _ ->
11510              pr "  return NULL;\n"
11511         );
11512         pr "}\n";
11513         pr "\n"
11514       )
11515   ) tests
11516
11517 and generate_ocaml_bindtests () =
11518   generate_header OCamlStyle GPLv2plus;
11519
11520   pr "\
11521 let () =
11522   let g = Guestfs.create () in
11523 ";
11524
11525   let mkargs args =
11526     String.concat " " (
11527       List.map (
11528         function
11529         | CallString s -> "\"" ^ s ^ "\""
11530         | CallOptString None -> "None"
11531         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
11532         | CallStringList xs ->
11533             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
11534         | CallInt i when i >= 0 -> string_of_int i
11535         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
11536         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
11537         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
11538         | CallBool b -> string_of_bool b
11539         | CallBuffer s -> sprintf "%S" s
11540       ) args
11541     )
11542   in
11543
11544   generate_lang_bindtests (
11545     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
11546   );
11547
11548   pr "print_endline \"EOF\"\n"
11549
11550 and generate_perl_bindtests () =
11551   pr "#!/usr/bin/perl -w\n";
11552   generate_header HashStyle GPLv2plus;
11553
11554   pr "\
11555 use strict;
11556
11557 use Sys::Guestfs;
11558
11559 my $g = Sys::Guestfs->new ();
11560 ";
11561
11562   let mkargs args =
11563     String.concat ", " (
11564       List.map (
11565         function
11566         | CallString s -> "\"" ^ s ^ "\""
11567         | CallOptString None -> "undef"
11568         | CallOptString (Some s) -> sprintf "\"%s\"" s
11569         | CallStringList xs ->
11570             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11571         | CallInt i -> string_of_int i
11572         | CallInt64 i -> Int64.to_string i
11573         | CallBool b -> if b then "1" else "0"
11574         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11575       ) args
11576     )
11577   in
11578
11579   generate_lang_bindtests (
11580     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
11581   );
11582
11583   pr "print \"EOF\\n\"\n"
11584
11585 and generate_python_bindtests () =
11586   generate_header HashStyle GPLv2plus;
11587
11588   pr "\
11589 import guestfs
11590
11591 g = guestfs.GuestFS ()
11592 ";
11593
11594   let mkargs args =
11595     String.concat ", " (
11596       List.map (
11597         function
11598         | CallString s -> "\"" ^ s ^ "\""
11599         | CallOptString None -> "None"
11600         | CallOptString (Some s) -> sprintf "\"%s\"" s
11601         | CallStringList xs ->
11602             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11603         | CallInt i -> string_of_int i
11604         | CallInt64 i -> Int64.to_string i
11605         | CallBool b -> if b then "1" else "0"
11606         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11607       ) args
11608     )
11609   in
11610
11611   generate_lang_bindtests (
11612     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
11613   );
11614
11615   pr "print \"EOF\"\n"
11616
11617 and generate_ruby_bindtests () =
11618   generate_header HashStyle GPLv2plus;
11619
11620   pr "\
11621 require 'guestfs'
11622
11623 g = Guestfs::create()
11624 ";
11625
11626   let mkargs args =
11627     String.concat ", " (
11628       List.map (
11629         function
11630         | CallString s -> "\"" ^ s ^ "\""
11631         | CallOptString None -> "nil"
11632         | CallOptString (Some s) -> sprintf "\"%s\"" s
11633         | CallStringList xs ->
11634             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11635         | CallInt i -> string_of_int i
11636         | CallInt64 i -> Int64.to_string i
11637         | CallBool b -> string_of_bool b
11638         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11639       ) args
11640     )
11641   in
11642
11643   generate_lang_bindtests (
11644     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
11645   );
11646
11647   pr "print \"EOF\\n\"\n"
11648
11649 and generate_java_bindtests () =
11650   generate_header CStyle GPLv2plus;
11651
11652   pr "\
11653 import com.redhat.et.libguestfs.*;
11654
11655 public class Bindtests {
11656     public static void main (String[] argv)
11657     {
11658         try {
11659             GuestFS g = new GuestFS ();
11660 ";
11661
11662   let mkargs args =
11663     String.concat ", " (
11664       List.map (
11665         function
11666         | CallString s -> "\"" ^ s ^ "\""
11667         | CallOptString None -> "null"
11668         | CallOptString (Some s) -> sprintf "\"%s\"" s
11669         | CallStringList xs ->
11670             "new String[]{" ^
11671               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
11672         | CallInt i -> string_of_int i
11673         | CallInt64 i -> Int64.to_string i
11674         | CallBool b -> string_of_bool b
11675         | CallBuffer s ->
11676             "new byte[] { " ^ String.concat "," (
11677               map_chars (fun c -> string_of_int (Char.code c)) s
11678             ) ^ " }"
11679       ) args
11680     )
11681   in
11682
11683   generate_lang_bindtests (
11684     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
11685   );
11686
11687   pr "
11688             System.out.println (\"EOF\");
11689         }
11690         catch (Exception exn) {
11691             System.err.println (exn);
11692             System.exit (1);
11693         }
11694     }
11695 }
11696 "
11697
11698 and generate_haskell_bindtests () =
11699   generate_header HaskellStyle GPLv2plus;
11700
11701   pr "\
11702 module Bindtests where
11703 import qualified Guestfs
11704
11705 main = do
11706   g <- Guestfs.create
11707 ";
11708
11709   let mkargs args =
11710     String.concat " " (
11711       List.map (
11712         function
11713         | CallString s -> "\"" ^ s ^ "\""
11714         | CallOptString None -> "Nothing"
11715         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
11716         | CallStringList xs ->
11717             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11718         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
11719         | CallInt i -> string_of_int i
11720         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
11721         | CallInt64 i -> Int64.to_string i
11722         | CallBool true -> "True"
11723         | CallBool false -> "False"
11724         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11725       ) args
11726     )
11727   in
11728
11729   generate_lang_bindtests (
11730     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
11731   );
11732
11733   pr "  putStrLn \"EOF\"\n"
11734
11735 (* Language-independent bindings tests - we do it this way to
11736  * ensure there is parity in testing bindings across all languages.
11737  *)
11738 and generate_lang_bindtests call =
11739   call "test0" [CallString "abc"; CallOptString (Some "def");
11740                 CallStringList []; CallBool false;
11741                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11742                 CallBuffer "abc\000abc"];
11743   call "test0" [CallString "abc"; CallOptString None;
11744                 CallStringList []; CallBool false;
11745                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11746                 CallBuffer "abc\000abc"];
11747   call "test0" [CallString ""; CallOptString (Some "def");
11748                 CallStringList []; CallBool false;
11749                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11750                 CallBuffer "abc\000abc"];
11751   call "test0" [CallString ""; CallOptString (Some "");
11752                 CallStringList []; CallBool false;
11753                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11754                 CallBuffer "abc\000abc"];
11755   call "test0" [CallString "abc"; CallOptString (Some "def");
11756                 CallStringList ["1"]; CallBool false;
11757                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11758                 CallBuffer "abc\000abc"];
11759   call "test0" [CallString "abc"; CallOptString (Some "def");
11760                 CallStringList ["1"; "2"]; CallBool false;
11761                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11762                 CallBuffer "abc\000abc"];
11763   call "test0" [CallString "abc"; CallOptString (Some "def");
11764                 CallStringList ["1"]; CallBool true;
11765                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11766                 CallBuffer "abc\000abc"];
11767   call "test0" [CallString "abc"; CallOptString (Some "def");
11768                 CallStringList ["1"]; CallBool false;
11769                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
11770                 CallBuffer "abc\000abc"];
11771   call "test0" [CallString "abc"; CallOptString (Some "def");
11772                 CallStringList ["1"]; CallBool false;
11773                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
11774                 CallBuffer "abc\000abc"];
11775   call "test0" [CallString "abc"; CallOptString (Some "def");
11776                 CallStringList ["1"]; CallBool false;
11777                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
11778                 CallBuffer "abc\000abc"];
11779   call "test0" [CallString "abc"; CallOptString (Some "def");
11780                 CallStringList ["1"]; CallBool false;
11781                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
11782                 CallBuffer "abc\000abc"];
11783   call "test0" [CallString "abc"; CallOptString (Some "def");
11784                 CallStringList ["1"]; CallBool false;
11785                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
11786                 CallBuffer "abc\000abc"];
11787   call "test0" [CallString "abc"; CallOptString (Some "def");
11788                 CallStringList ["1"]; CallBool false;
11789                 CallInt 0; CallInt64 0L; CallString ""; CallString "";
11790                 CallBuffer "abc\000abc"]
11791
11792 (* XXX Add here tests of the return and error functions. *)
11793
11794 (* Code to generator bindings for virt-inspector.  Currently only
11795  * implemented for OCaml code (for virt-p2v 2.0).
11796  *)
11797 let rng_input = "inspector/virt-inspector.rng"
11798
11799 (* Read the input file and parse it into internal structures.  This is
11800  * by no means a complete RELAX NG parser, but is just enough to be
11801  * able to parse the specific input file.
11802  *)
11803 type rng =
11804   | Element of string * rng list        (* <element name=name/> *)
11805   | Attribute of string * rng list        (* <attribute name=name/> *)
11806   | Interleave of rng list                (* <interleave/> *)
11807   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11808   | OneOrMore of rng                        (* <oneOrMore/> *)
11809   | Optional of rng                        (* <optional/> *)
11810   | Choice of string list                (* <choice><value/>*</choice> *)
11811   | Value of string                        (* <value>str</value> *)
11812   | Text                                (* <text/> *)
11813
11814 let rec string_of_rng = function
11815   | Element (name, xs) ->
11816       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11817   | Attribute (name, xs) ->
11818       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11819   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11820   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11821   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11822   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11823   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11824   | Value value -> "Value \"" ^ value ^ "\""
11825   | Text -> "Text"
11826
11827 and string_of_rng_list xs =
11828   String.concat ", " (List.map string_of_rng xs)
11829
11830 let rec parse_rng ?defines context = function
11831   | [] -> []
11832   | Xml.Element ("element", ["name", name], children) :: rest ->
11833       Element (name, parse_rng ?defines context children)
11834       :: parse_rng ?defines context rest
11835   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11836       Attribute (name, parse_rng ?defines context children)
11837       :: parse_rng ?defines context rest
11838   | Xml.Element ("interleave", [], children) :: rest ->
11839       Interleave (parse_rng ?defines context children)
11840       :: parse_rng ?defines context rest
11841   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11842       let rng = parse_rng ?defines context [child] in
11843       (match rng with
11844        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11845        | _ ->
11846            failwithf "%s: <zeroOrMore> contains more than one child element"
11847              context
11848       )
11849   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11850       let rng = parse_rng ?defines context [child] in
11851       (match rng with
11852        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11853        | _ ->
11854            failwithf "%s: <oneOrMore> contains more than one child element"
11855              context
11856       )
11857   | Xml.Element ("optional", [], [child]) :: rest ->
11858       let rng = parse_rng ?defines context [child] in
11859       (match rng with
11860        | [child] -> Optional child :: parse_rng ?defines context rest
11861        | _ ->
11862            failwithf "%s: <optional> contains more than one child element"
11863              context
11864       )
11865   | Xml.Element ("choice", [], children) :: rest ->
11866       let values = List.map (
11867         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11868         | _ ->
11869             failwithf "%s: can't handle anything except <value> in <choice>"
11870               context
11871       ) children in
11872       Choice values
11873       :: parse_rng ?defines context rest
11874   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11875       Value value :: parse_rng ?defines context rest
11876   | Xml.Element ("text", [], []) :: rest ->
11877       Text :: parse_rng ?defines context rest
11878   | Xml.Element ("ref", ["name", name], []) :: rest ->
11879       (* Look up the reference.  Because of limitations in this parser,
11880        * we can't handle arbitrarily nested <ref> yet.  You can only
11881        * use <ref> from inside <start>.
11882        *)
11883       (match defines with
11884        | None ->
11885            failwithf "%s: contains <ref>, but no refs are defined yet" context
11886        | Some map ->
11887            let rng = StringMap.find name map in
11888            rng @ parse_rng ?defines context rest
11889       )
11890   | x :: _ ->
11891       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11892
11893 let grammar =
11894   let xml = Xml.parse_file rng_input in
11895   match xml with
11896   | Xml.Element ("grammar", _,
11897                  Xml.Element ("start", _, gram) :: defines) ->
11898       (* The <define/> elements are referenced in the <start> section,
11899        * so build a map of those first.
11900        *)
11901       let defines = List.fold_left (
11902         fun map ->
11903           function Xml.Element ("define", ["name", name], defn) ->
11904             StringMap.add name defn map
11905           | _ ->
11906               failwithf "%s: expected <define name=name/>" rng_input
11907       ) StringMap.empty defines in
11908       let defines = StringMap.mapi parse_rng defines in
11909
11910       (* Parse the <start> clause, passing the defines. *)
11911       parse_rng ~defines "<start>" gram
11912   | _ ->
11913       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11914         rng_input
11915
11916 let name_of_field = function
11917   | Element (name, _) | Attribute (name, _)
11918   | ZeroOrMore (Element (name, _))
11919   | OneOrMore (Element (name, _))
11920   | Optional (Element (name, _)) -> name
11921   | Optional (Attribute (name, _)) -> name
11922   | Text -> (* an unnamed field in an element *)
11923       "data"
11924   | rng ->
11925       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11926
11927 (* At the moment this function only generates OCaml types.  However we
11928  * should parameterize it later so it can generate types/structs in a
11929  * variety of languages.
11930  *)
11931 let generate_types xs =
11932   (* A simple type is one that can be printed out directly, eg.
11933    * "string option".  A complex type is one which has a name and has
11934    * to be defined via another toplevel definition, eg. a struct.
11935    *
11936    * generate_type generates code for either simple or complex types.
11937    * In the simple case, it returns the string ("string option").  In
11938    * the complex case, it returns the name ("mountpoint").  In the
11939    * complex case it has to print out the definition before returning,
11940    * so it should only be called when we are at the beginning of a
11941    * new line (BOL context).
11942    *)
11943   let rec generate_type = function
11944     | Text ->                                (* string *)
11945         "string", true
11946     | Choice values ->                        (* [`val1|`val2|...] *)
11947         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11948     | ZeroOrMore rng ->                        (* <rng> list *)
11949         let t, is_simple = generate_type rng in
11950         t ^ " list (* 0 or more *)", is_simple
11951     | OneOrMore rng ->                        (* <rng> list *)
11952         let t, is_simple = generate_type rng in
11953         t ^ " list (* 1 or more *)", is_simple
11954                                         (* virt-inspector hack: bool *)
11955     | Optional (Attribute (name, [Value "1"])) ->
11956         "bool", true
11957     | Optional rng ->                        (* <rng> list *)
11958         let t, is_simple = generate_type rng in
11959         t ^ " option", is_simple
11960                                         (* type name = { fields ... } *)
11961     | Element (name, fields) when is_attrs_interleave fields ->
11962         generate_type_struct name (get_attrs_interleave fields)
11963     | Element (name, [field])                (* type name = field *)
11964     | Attribute (name, [field]) ->
11965         let t, is_simple = generate_type field in
11966         if is_simple then (t, true)
11967         else (
11968           pr "type %s = %s\n" name t;
11969           name, false
11970         )
11971     | Element (name, fields) ->              (* type name = { fields ... } *)
11972         generate_type_struct name fields
11973     | rng ->
11974         failwithf "generate_type failed at: %s" (string_of_rng rng)
11975
11976   and is_attrs_interleave = function
11977     | [Interleave _] -> true
11978     | Attribute _ :: fields -> is_attrs_interleave fields
11979     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11980     | _ -> false
11981
11982   and get_attrs_interleave = function
11983     | [Interleave fields] -> fields
11984     | ((Attribute _) as field) :: fields
11985     | ((Optional (Attribute _)) as field) :: fields ->
11986         field :: get_attrs_interleave fields
11987     | _ -> assert false
11988
11989   and generate_types xs =
11990     List.iter (fun x -> ignore (generate_type x)) xs
11991
11992   and generate_type_struct name fields =
11993     (* Calculate the types of the fields first.  We have to do this
11994      * before printing anything so we are still in BOL context.
11995      *)
11996     let types = List.map fst (List.map generate_type fields) in
11997
11998     (* Special case of a struct containing just a string and another
11999      * field.  Turn it into an assoc list.
12000      *)
12001     match types with
12002     | ["string"; other] ->
12003         let fname1, fname2 =
12004           match fields with
12005           | [f1; f2] -> name_of_field f1, name_of_field f2
12006           | _ -> assert false in
12007         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
12008         name, false
12009
12010     | types ->
12011         pr "type %s = {\n" name;
12012         List.iter (
12013           fun (field, ftype) ->
12014             let fname = name_of_field field in
12015             pr "  %s_%s : %s;\n" name fname ftype
12016         ) (List.combine fields types);
12017         pr "}\n";
12018         (* Return the name of this type, and
12019          * false because it's not a simple type.
12020          *)
12021         name, false
12022   in
12023
12024   generate_types xs
12025
12026 let generate_parsers xs =
12027   (* As for generate_type above, generate_parser makes a parser for
12028    * some type, and returns the name of the parser it has generated.
12029    * Because it (may) need to print something, it should always be
12030    * called in BOL context.
12031    *)
12032   let rec generate_parser = function
12033     | Text ->                                (* string *)
12034         "string_child_or_empty"
12035     | Choice values ->                        (* [`val1|`val2|...] *)
12036         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
12037           (String.concat "|"
12038              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
12039     | ZeroOrMore rng ->                        (* <rng> list *)
12040         let pa = generate_parser rng in
12041         sprintf "(fun x -> List.map %s (Xml.children x))" pa
12042     | OneOrMore rng ->                        (* <rng> list *)
12043         let pa = generate_parser rng in
12044         sprintf "(fun x -> List.map %s (Xml.children x))" pa
12045                                         (* virt-inspector hack: bool *)
12046     | Optional (Attribute (name, [Value "1"])) ->
12047         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
12048     | Optional rng ->                        (* <rng> list *)
12049         let pa = generate_parser rng in
12050         sprintf "(function None -> None | Some x -> Some (%s x))" pa
12051                                         (* type name = { fields ... } *)
12052     | Element (name, fields) when is_attrs_interleave fields ->
12053         generate_parser_struct name (get_attrs_interleave fields)
12054     | Element (name, [field]) ->        (* type name = field *)
12055         let pa = generate_parser field in
12056         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
12057         pr "let %s =\n" parser_name;
12058         pr "  %s\n" pa;
12059         pr "let parse_%s = %s\n" name parser_name;
12060         parser_name
12061     | Attribute (name, [field]) ->
12062         let pa = generate_parser field in
12063         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
12064         pr "let %s =\n" parser_name;
12065         pr "  %s\n" pa;
12066         pr "let parse_%s = %s\n" name parser_name;
12067         parser_name
12068     | Element (name, fields) ->              (* type name = { fields ... } *)
12069         generate_parser_struct name ([], fields)
12070     | rng ->
12071         failwithf "generate_parser failed at: %s" (string_of_rng rng)
12072
12073   and is_attrs_interleave = function
12074     | [Interleave _] -> true
12075     | Attribute _ :: fields -> is_attrs_interleave fields
12076     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
12077     | _ -> false
12078
12079   and get_attrs_interleave = function
12080     | [Interleave fields] -> [], fields
12081     | ((Attribute _) as field) :: fields
12082     | ((Optional (Attribute _)) as field) :: fields ->
12083         let attrs, interleaves = get_attrs_interleave fields in
12084         (field :: attrs), interleaves
12085     | _ -> assert false
12086
12087   and generate_parsers xs =
12088     List.iter (fun x -> ignore (generate_parser x)) xs
12089
12090   and generate_parser_struct name (attrs, interleaves) =
12091     (* Generate parsers for the fields first.  We have to do this
12092      * before printing anything so we are still in BOL context.
12093      *)
12094     let fields = attrs @ interleaves in
12095     let pas = List.map generate_parser fields in
12096
12097     (* Generate an intermediate tuple from all the fields first.
12098      * If the type is just a string + another field, then we will
12099      * return this directly, otherwise it is turned into a record.
12100      *
12101      * RELAX NG note: This code treats <interleave> and plain lists of
12102      * fields the same.  In other words, it doesn't bother enforcing
12103      * any ordering of fields in the XML.
12104      *)
12105     pr "let parse_%s x =\n" name;
12106     pr "  let t = (\n    ";
12107     let comma = ref false in
12108     List.iter (
12109       fun x ->
12110         if !comma then pr ",\n    ";
12111         comma := true;
12112         match x with
12113         | Optional (Attribute (fname, [field])), pa ->
12114             pr "%s x" pa
12115         | Optional (Element (fname, [field])), pa ->
12116             pr "%s (optional_child %S x)" pa fname
12117         | Attribute (fname, [Text]), _ ->
12118             pr "attribute %S x" fname
12119         | (ZeroOrMore _ | OneOrMore _), pa ->
12120             pr "%s x" pa
12121         | Text, pa ->
12122             pr "%s x" pa
12123         | (field, pa) ->
12124             let fname = name_of_field field in
12125             pr "%s (child %S x)" pa fname
12126     ) (List.combine fields pas);
12127     pr "\n  ) in\n";
12128
12129     (match fields with
12130      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
12131          pr "  t\n"
12132
12133      | _ ->
12134          pr "  (Obj.magic t : %s)\n" name
12135 (*
12136          List.iter (
12137            function
12138            | (Optional (Attribute (fname, [field])), pa) ->
12139                pr "  %s_%s =\n" name fname;
12140                pr "    %s x;\n" pa
12141            | (Optional (Element (fname, [field])), pa) ->
12142                pr "  %s_%s =\n" name fname;
12143                pr "    (let x = optional_child %S x in\n" fname;
12144                pr "     %s x);\n" pa
12145            | (field, pa) ->
12146                let fname = name_of_field field in
12147                pr "  %s_%s =\n" name fname;
12148                pr "    (let x = child %S x in\n" fname;
12149                pr "     %s x);\n" pa
12150          ) (List.combine fields pas);
12151          pr "}\n"
12152 *)
12153     );
12154     sprintf "parse_%s" name
12155   in
12156
12157   generate_parsers xs
12158
12159 (* Generate ocaml/guestfs_inspector.mli. *)
12160 let generate_ocaml_inspector_mli () =
12161   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
12162
12163   pr "\
12164 (** This is an OCaml language binding to the external [virt-inspector]
12165     program.
12166
12167     For more information, please read the man page [virt-inspector(1)].
12168 *)
12169
12170 ";
12171
12172   generate_types grammar;
12173   pr "(** The nested information returned from the {!inspect} function. *)\n";
12174   pr "\n";
12175
12176   pr "\
12177 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
12178 (** To inspect a libvirt domain called [name], pass a singleton
12179     list: [inspect [name]].  When using libvirt only, you may
12180     optionally pass a libvirt URI using [inspect ~connect:uri ...].
12181
12182     To inspect a disk image or images, pass a list of the filenames
12183     of the disk images: [inspect filenames]
12184
12185     This function inspects the given guest or disk images and
12186     returns a list of operating system(s) found and a large amount
12187     of information about them.  In the vast majority of cases,
12188     a virtual machine only contains a single operating system.
12189
12190     If the optional [~xml] parameter is given, then this function
12191     skips running the external virt-inspector program and just
12192     parses the given XML directly (which is expected to be XML
12193     produced from a previous run of virt-inspector).  The list of
12194     names and connect URI are ignored in this case.
12195
12196     This function can throw a wide variety of exceptions, for example
12197     if the external virt-inspector program cannot be found, or if
12198     it doesn't generate valid XML.
12199 *)
12200 "
12201
12202 (* Generate ocaml/guestfs_inspector.ml. *)
12203 let generate_ocaml_inspector_ml () =
12204   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
12205
12206   pr "open Unix\n";
12207   pr "\n";
12208
12209   generate_types grammar;
12210   pr "\n";
12211
12212   pr "\
12213 (* Misc functions which are used by the parser code below. *)
12214 let first_child = function
12215   | Xml.Element (_, _, c::_) -> c
12216   | Xml.Element (name, _, []) ->
12217       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
12218   | Xml.PCData str ->
12219       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
12220
12221 let string_child_or_empty = function
12222   | Xml.Element (_, _, [Xml.PCData s]) -> s
12223   | Xml.Element (_, _, []) -> \"\"
12224   | Xml.Element (x, _, _) ->
12225       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
12226                 x ^ \" instead\")
12227   | Xml.PCData str ->
12228       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
12229
12230 let optional_child name xml =
12231   let children = Xml.children xml in
12232   try
12233     Some (List.find (function
12234                      | Xml.Element (n, _, _) when n = name -> true
12235                      | _ -> false) children)
12236   with
12237     Not_found -> None
12238
12239 let child name xml =
12240   match optional_child name xml with
12241   | Some c -> c
12242   | None ->
12243       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
12244
12245 let attribute name xml =
12246   try Xml.attrib xml name
12247   with Xml.No_attribute _ ->
12248     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
12249
12250 ";
12251
12252   generate_parsers grammar;
12253   pr "\n";
12254
12255   pr "\
12256 (* Run external virt-inspector, then use parser to parse the XML. *)
12257 let inspect ?connect ?xml names =
12258   let xml =
12259     match xml with
12260     | None ->
12261         if names = [] then invalid_arg \"inspect: no names given\";
12262         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
12263           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
12264           names in
12265         let cmd = List.map Filename.quote cmd in
12266         let cmd = String.concat \" \" cmd in
12267         let chan = open_process_in cmd in
12268         let xml = Xml.parse_in chan in
12269         (match close_process_in chan with
12270          | WEXITED 0 -> ()
12271          | WEXITED _ -> failwith \"external virt-inspector command failed\"
12272          | WSIGNALED i | WSTOPPED i ->
12273              failwith (\"external virt-inspector command died or stopped on sig \" ^
12274                        string_of_int i)
12275         );
12276         xml
12277     | Some doc ->
12278         Xml.parse_string doc in
12279   parse_operatingsystems xml
12280 "
12281
12282 and generate_max_proc_nr () =
12283   pr "%d\n" max_proc_nr
12284
12285 let output_to filename k =
12286   let filename_new = filename ^ ".new" in
12287   chan := open_out filename_new;
12288   k ();
12289   close_out !chan;
12290   chan := Pervasives.stdout;
12291
12292   (* Is the new file different from the current file? *)
12293   if Sys.file_exists filename && files_equal filename filename_new then
12294     unlink filename_new                 (* same, so skip it *)
12295   else (
12296     (* different, overwrite old one *)
12297     (try chmod filename 0o644 with Unix_error _ -> ());
12298     rename filename_new filename;
12299     chmod filename 0o444;
12300     printf "written %s\n%!" filename;
12301   )
12302
12303 let perror msg = function
12304   | Unix_error (err, _, _) ->
12305       eprintf "%s: %s\n" msg (error_message err)
12306   | exn ->
12307       eprintf "%s: %s\n" msg (Printexc.to_string exn)
12308
12309 (* Main program. *)
12310 let () =
12311   let lock_fd =
12312     try openfile "HACKING" [O_RDWR] 0
12313     with
12314     | Unix_error (ENOENT, _, _) ->
12315         eprintf "\
12316 You are probably running this from the wrong directory.
12317 Run it from the top source directory using the command
12318   src/generator.ml
12319 ";
12320         exit 1
12321     | exn ->
12322         perror "open: HACKING" exn;
12323         exit 1 in
12324
12325   (* Acquire a lock so parallel builds won't try to run the generator
12326    * twice at the same time.  Subsequent builds will wait for the first
12327    * one to finish.  Note the lock is released implicitly when the
12328    * program exits.
12329    *)
12330   (try lockf lock_fd F_LOCK 1
12331    with exn ->
12332      perror "lock: HACKING" exn;
12333      exit 1);
12334
12335   check_functions ();
12336
12337   output_to "src/guestfs_protocol.x" generate_xdr;
12338   output_to "src/guestfs-structs.h" generate_structs_h;
12339   output_to "src/guestfs-actions.h" generate_actions_h;
12340   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
12341   output_to "src/actions.c" generate_client_actions;
12342   output_to "src/bindtests.c" generate_bindtests;
12343   output_to "src/guestfs-structs.pod" generate_structs_pod;
12344   output_to "src/guestfs-actions.pod" generate_actions_pod;
12345   output_to "src/guestfs-availability.pod" generate_availability_pod;
12346   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
12347   output_to "src/libguestfs.syms" generate_linker_script;
12348   output_to "daemon/actions.h" generate_daemon_actions_h;
12349   output_to "daemon/stubs.c" generate_daemon_actions;
12350   output_to "daemon/names.c" generate_daemon_names;
12351   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
12352   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
12353   output_to "capitests/tests.c" generate_tests;
12354   output_to "fish/cmds.c" generate_fish_cmds;
12355   output_to "fish/completion.c" generate_fish_completion;
12356   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
12357   output_to "fish/prepopts.c" generate_fish_prep_options_c;
12358   output_to "fish/prepopts.h" generate_fish_prep_options_h;
12359   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
12360   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
12361   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
12362   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
12363   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
12364   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
12365   output_to "perl/Guestfs.xs" generate_perl_xs;
12366   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
12367   output_to "perl/bindtests.pl" generate_perl_bindtests;
12368   output_to "python/guestfs-py.c" generate_python_c;
12369   output_to "python/guestfs.py" generate_python_py;
12370   output_to "python/bindtests.py" generate_python_bindtests;
12371   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
12372   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
12373   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
12374
12375   List.iter (
12376     fun (typ, jtyp) ->
12377       let cols = cols_of_struct typ in
12378       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
12379       output_to filename (generate_java_struct jtyp cols);
12380   ) java_structs;
12381
12382   output_to "java/Makefile.inc" generate_java_makefile_inc;
12383   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
12384   output_to "java/Bindtests.java" generate_java_bindtests;
12385   output_to "haskell/Guestfs.hs" generate_haskell_hs;
12386   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
12387   output_to "csharp/Libguestfs.cs" generate_csharp;
12388
12389   (* Always generate this file last, and unconditionally.  It's used
12390    * by the Makefile to know when we must re-run the generator.
12391    *)
12392   let chan = open_out "src/stamp-generator" in
12393   fprintf chan "1\n";
12394   close_out chan;
12395
12396   printf "generated %d lines of code\n" !lines