resize2fs: Document this command also works with ext4 (thanks Yufang Zhang).
[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 (* Some initial scenarios for testing. *)
313 and test_init =
314     (* Do nothing, block devices could contain random stuff including
315      * LVM PVs, and some filesystems might be mounted.  This is usually
316      * a bad idea.
317      *)
318   | InitNone
319
320     (* Block devices are empty and no filesystems are mounted. *)
321   | InitEmpty
322
323     (* /dev/sda contains a single partition /dev/sda1, with random
324      * content.  /dev/sdb and /dev/sdc may have random content.
325      * No LVM.
326      *)
327   | InitPartition
328
329     (* /dev/sda contains a single partition /dev/sda1, which is formatted
330      * as ext2, empty [except for lost+found] and mounted on /.
331      * /dev/sdb and /dev/sdc may have random content.
332      * No LVM.
333      *)
334   | InitBasicFS
335
336     (* /dev/sda:
337      *   /dev/sda1 (is a PV):
338      *     /dev/VG/LV (size 8MB):
339      *       formatted as ext2, empty [except for lost+found], mounted on /
340      * /dev/sdb and /dev/sdc may have random content.
341      *)
342   | InitBasicFSonLVM
343
344     (* /dev/sdd (the ISO, see images/ directory in source)
345      * is mounted on /
346      *)
347   | InitISOFS
348
349 (* Sequence of commands for testing. *)
350 and seq = cmd list
351 and cmd = string list
352
353 (* Note about long descriptions: When referring to another
354  * action, use the format C<guestfs_other> (ie. the full name of
355  * the C function).  This will be replaced as appropriate in other
356  * language bindings.
357  *
358  * Apart from that, long descriptions are just perldoc paragraphs.
359  *)
360
361 (* Generate a random UUID (used in tests). *)
362 let uuidgen () =
363   let chan = open_process_in "uuidgen" in
364   let uuid = input_line chan in
365   (match close_process_in chan with
366    | WEXITED 0 -> ()
367    | WEXITED _ ->
368        failwith "uuidgen: process exited with non-zero status"
369    | WSIGNALED _ | WSTOPPED _ ->
370        failwith "uuidgen: process signalled or stopped by signal"
371   );
372   uuid
373
374 (* These test functions are used in the language binding tests. *)
375
376 let test_all_args = [
377   String "str";
378   OptString "optstr";
379   StringList "strlist";
380   Bool "b";
381   Int "integer";
382   Int64 "integer64";
383   FileIn "filein";
384   FileOut "fileout";
385   BufferIn "bufferin";
386 ]
387
388 let test_all_rets = [
389   (* except for RErr, which is tested thoroughly elsewhere *)
390   "test0rint",         RInt "valout";
391   "test0rint64",       RInt64 "valout";
392   "test0rbool",        RBool "valout";
393   "test0rconststring", RConstString "valout";
394   "test0rconstoptstring", RConstOptString "valout";
395   "test0rstring",      RString "valout";
396   "test0rstringlist",  RStringList "valout";
397   "test0rstruct",      RStruct ("valout", "lvm_pv");
398   "test0rstructlist",  RStructList ("valout", "lvm_pv");
399   "test0rhashtable",   RHashtable "valout";
400 ]
401
402 let test_functions = [
403   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
404    [],
405    "internal test function - do not use",
406    "\
407 This is an internal test function which is used to test whether
408 the automatically generated bindings can handle every possible
409 parameter type correctly.
410
411 It echos the contents of each parameter to stdout.
412
413 You probably don't want to call this function.");
414 ] @ List.flatten (
415   List.map (
416     fun (name, ret) ->
417       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
418         [],
419         "internal test function - do not use",
420         "\
421 This is an internal test function which is used to test whether
422 the automatically generated bindings can handle every possible
423 return type correctly.
424
425 It converts string C<val> to the return type.
426
427 You probably don't want to call this function.");
428        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
429         [],
430         "internal test function - do not use",
431         "\
432 This is an internal test function which is used to test whether
433 the automatically generated bindings can handle every possible
434 return type correctly.
435
436 This function always returns an error.
437
438 You probably don't want to call this function.")]
439   ) test_all_rets
440 )
441
442 (* non_daemon_functions are any functions which don't get processed
443  * in the daemon, eg. functions for setting and getting local
444  * configuration values.
445  *)
446
447 let non_daemon_functions = test_functions @ [
448   ("launch", (RErr, []), -1, [FishAlias "run"],
449    [],
450    "launch the qemu subprocess",
451    "\
452 Internally libguestfs is implemented by running a virtual machine
453 using L<qemu(1)>.
454
455 You should call this after configuring the handle
456 (eg. adding drives) but before performing any actions.");
457
458   ("wait_ready", (RErr, []), -1, [NotInFish],
459    [],
460    "wait until the qemu subprocess launches (no op)",
461    "\
462 This function is a no op.
463
464 In versions of the API E<lt> 1.0.71 you had to call this function
465 just after calling C<guestfs_launch> to wait for the launch
466 to complete.  However this is no longer necessary because
467 C<guestfs_launch> now does the waiting.
468
469 If you see any calls to this function in code then you can just
470 remove them, unless you want to retain compatibility with older
471 versions of the API.");
472
473   ("kill_subprocess", (RErr, []), -1, [],
474    [],
475    "kill the qemu subprocess",
476    "\
477 This kills the qemu subprocess.  You should never need to call this.");
478
479   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
480    [],
481    "add an image to examine or modify",
482    "\
483 This function adds a virtual machine disk image C<filename> to the
484 guest.  The first time you call this function, the disk appears as IDE
485 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
486 so on.
487
488 You don't necessarily need to be root when using libguestfs.  However
489 you obviously do need sufficient permissions to access the filename
490 for whatever operations you want to perform (ie. read access if you
491 just want to read the image or write access if you want to modify the
492 image).
493
494 This is equivalent to the qemu parameter
495 C<-drive file=filename,cache=off,if=...>.
496
497 C<cache=off> is omitted in cases where it is not supported by
498 the underlying filesystem.
499
500 C<if=...> is set at compile time by the configuration option
501 C<./configure --with-drive-if=...>.  In the rare case where you
502 might need to change this at run time, use C<guestfs_add_drive_with_if>
503 or C<guestfs_add_drive_ro_with_if>.
504
505 Note that this call checks for the existence of C<filename>.  This
506 stops you from specifying other types of drive which are supported
507 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
508 the general C<guestfs_config> call instead.");
509
510   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
511    [],
512    "add a CD-ROM disk image to examine",
513    "\
514 This function adds a virtual CD-ROM disk image to the guest.
515
516 This is equivalent to the qemu parameter C<-cdrom filename>.
517
518 Notes:
519
520 =over 4
521
522 =item *
523
524 This call checks for the existence of C<filename>.  This
525 stops you from specifying other types of drive which are supported
526 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
527 the general C<guestfs_config> call instead.
528
529 =item *
530
531 If you just want to add an ISO file (often you use this as an
532 efficient way to transfer large files into the guest), then you
533 should probably use C<guestfs_add_drive_ro> instead.
534
535 =back");
536
537   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
538    [],
539    "add a drive in snapshot mode (read-only)",
540    "\
541 This adds a drive in snapshot mode, making it effectively
542 read-only.
543
544 Note that writes to the device are allowed, and will be seen for
545 the duration of the guestfs handle, but they are written
546 to a temporary file which is discarded as soon as the guestfs
547 handle is closed.  We don't currently have any method to enable
548 changes to be committed, although qemu can support this.
549
550 This is equivalent to the qemu parameter
551 C<-drive file=filename,snapshot=on,readonly=on,if=...>.
552
553 C<if=...> is set at compile time by the configuration option
554 C<./configure --with-drive-if=...>.  In the rare case where you
555 might need to change this at run time, use C<guestfs_add_drive_with_if>
556 or C<guestfs_add_drive_ro_with_if>.
557
558 C<readonly=on> is only added where qemu supports this option.
559
560 Note that this call checks for the existence of C<filename>.  This
561 stops you from specifying other types of drive which are supported
562 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
563 the general C<guestfs_config> call instead.");
564
565   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
566    [],
567    "add qemu parameters",
568    "\
569 This can be used to add arbitrary qemu command line parameters
570 of the form C<-param value>.  Actually it's not quite arbitrary - we
571 prevent you from setting some parameters which would interfere with
572 parameters that we use.
573
574 The first character of C<param> string must be a C<-> (dash).
575
576 C<value> can be NULL.");
577
578   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
579    [],
580    "set the qemu binary",
581    "\
582 Set the qemu binary that we will use.
583
584 The default is chosen when the library was compiled by the
585 configure script.
586
587 You can also override this by setting the C<LIBGUESTFS_QEMU>
588 environment variable.
589
590 Setting C<qemu> to C<NULL> restores the default qemu binary.
591
592 Note that you should call this function as early as possible
593 after creating the handle.  This is because some pre-launch
594 operations depend on testing qemu features (by running C<qemu -help>).
595 If the qemu binary changes, we don't retest features, and
596 so you might see inconsistent results.  Using the environment
597 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
598 the qemu binary at the same time as the handle is created.");
599
600   ("get_qemu", (RConstString "qemu", []), -1, [],
601    [InitNone, Always, TestRun (
602       [["get_qemu"]])],
603    "get the qemu binary",
604    "\
605 Return the current qemu binary.
606
607 This is always non-NULL.  If it wasn't set already, then this will
608 return the default qemu binary name.");
609
610   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
611    [],
612    "set the search path",
613    "\
614 Set the path that libguestfs searches for kernel and initrd.img.
615
616 The default is C<$libdir/guestfs> unless overridden by setting
617 C<LIBGUESTFS_PATH> environment variable.
618
619 Setting C<path> to C<NULL> restores the default path.");
620
621   ("get_path", (RConstString "path", []), -1, [],
622    [InitNone, Always, TestRun (
623       [["get_path"]])],
624    "get the search path",
625    "\
626 Return the current search path.
627
628 This is always non-NULL.  If it wasn't set already, then this will
629 return the default path.");
630
631   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
632    [],
633    "add options to kernel command line",
634    "\
635 This function is used to add additional options to the
636 guest kernel command line.
637
638 The default is C<NULL> unless overridden by setting
639 C<LIBGUESTFS_APPEND> environment variable.
640
641 Setting C<append> to C<NULL> means I<no> additional options
642 are passed (libguestfs always adds a few of its own).");
643
644   ("get_append", (RConstOptString "append", []), -1, [],
645    (* This cannot be tested with the current framework.  The
646     * function can return NULL in normal operations, which the
647     * test framework interprets as an error.
648     *)
649    [],
650    "get the additional kernel options",
651    "\
652 Return the additional kernel options which are added to the
653 guest kernel command line.
654
655 If C<NULL> then no options are added.");
656
657   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
658    [],
659    "set autosync mode",
660    "\
661 If C<autosync> is true, this enables autosync.  Libguestfs will make a
662 best effort attempt to run C<guestfs_umount_all> followed by
663 C<guestfs_sync> when the handle is closed
664 (also if the program exits without closing handles).
665
666 This is disabled by default (except in guestfish where it is
667 enabled by default).");
668
669   ("get_autosync", (RBool "autosync", []), -1, [],
670    [InitNone, Always, TestRun (
671       [["get_autosync"]])],
672    "get autosync mode",
673    "\
674 Get the autosync flag.");
675
676   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
677    [],
678    "set verbose mode",
679    "\
680 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
681
682 Verbose messages are disabled unless the environment variable
683 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
684
685   ("get_verbose", (RBool "verbose", []), -1, [],
686    [],
687    "get verbose mode",
688    "\
689 This returns the verbose messages flag.");
690
691   ("is_ready", (RBool "ready", []), -1, [],
692    [InitNone, Always, TestOutputTrue (
693       [["is_ready"]])],
694    "is ready to accept commands",
695    "\
696 This returns true iff this handle is ready to accept commands
697 (in the C<READY> state).
698
699 For more information on states, see L<guestfs(3)>.");
700
701   ("is_config", (RBool "config", []), -1, [],
702    [InitNone, Always, TestOutputFalse (
703       [["is_config"]])],
704    "is in configuration state",
705    "\
706 This returns true iff this handle is being configured
707 (in the C<CONFIG> state).
708
709 For more information on states, see L<guestfs(3)>.");
710
711   ("is_launching", (RBool "launching", []), -1, [],
712    [InitNone, Always, TestOutputFalse (
713       [["is_launching"]])],
714    "is launching subprocess",
715    "\
716 This returns true iff this handle is launching the subprocess
717 (in the C<LAUNCHING> state).
718
719 For more information on states, see L<guestfs(3)>.");
720
721   ("is_busy", (RBool "busy", []), -1, [],
722    [InitNone, Always, TestOutputFalse (
723       [["is_busy"]])],
724    "is busy processing a command",
725    "\
726 This returns true iff this handle is busy processing a command
727 (in the C<BUSY> state).
728
729 For more information on states, see L<guestfs(3)>.");
730
731   ("get_state", (RInt "state", []), -1, [],
732    [],
733    "get the current state",
734    "\
735 This returns the current state as an opaque integer.  This is
736 only useful for printing debug and internal error messages.
737
738 For more information on states, see L<guestfs(3)>.");
739
740   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
741    [InitNone, Always, TestOutputInt (
742       [["set_memsize"; "500"];
743        ["get_memsize"]], 500)],
744    "set memory allocated to the qemu subprocess",
745    "\
746 This sets the memory size in megabytes allocated to the
747 qemu subprocess.  This only has any effect if called before
748 C<guestfs_launch>.
749
750 You can also change this by setting the environment
751 variable C<LIBGUESTFS_MEMSIZE> before the handle is
752 created.
753
754 For more information on the architecture of libguestfs,
755 see L<guestfs(3)>.");
756
757   ("get_memsize", (RInt "memsize", []), -1, [],
758    [InitNone, Always, TestOutputIntOp (
759       [["get_memsize"]], ">=", 256)],
760    "get memory allocated to the qemu subprocess",
761    "\
762 This gets the memory size in megabytes allocated to the
763 qemu subprocess.
764
765 If C<guestfs_set_memsize> was not called
766 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
767 then this returns the compiled-in default value for memsize.
768
769 For more information on the architecture of libguestfs,
770 see L<guestfs(3)>.");
771
772   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
773    [InitNone, Always, TestOutputIntOp (
774       [["get_pid"]], ">=", 1)],
775    "get PID of qemu subprocess",
776    "\
777 Return the process ID of the qemu subprocess.  If there is no
778 qemu subprocess, then this will return an error.
779
780 This is an internal call used for debugging and testing.");
781
782   ("version", (RStruct ("version", "version"), []), -1, [],
783    [InitNone, Always, TestOutputStruct (
784       [["version"]], [CompareWithInt ("major", 1)])],
785    "get the library version number",
786    "\
787 Return the libguestfs version number that the program is linked
788 against.
789
790 Note that because of dynamic linking this is not necessarily
791 the version of libguestfs that you compiled against.  You can
792 compile the program, and then at runtime dynamically link
793 against a completely different C<libguestfs.so> library.
794
795 This call was added in version C<1.0.58>.  In previous
796 versions of libguestfs there was no way to get the version
797 number.  From C code you can use dynamic linker functions
798 to find out if this symbol exists (if it doesn't, then
799 it's an earlier version).
800
801 The call returns a structure with four elements.  The first
802 three (C<major>, C<minor> and C<release>) are numbers and
803 correspond to the usual version triplet.  The fourth element
804 (C<extra>) is a string and is normally empty, but may be
805 used for distro-specific information.
806
807 To construct the original version string:
808 C<$major.$minor.$release$extra>
809
810 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
811
812 I<Note:> Don't use this call to test for availability
813 of features.  In enterprise distributions we backport
814 features from later versions into earlier versions,
815 making this an unreliable way to test for features.
816 Use C<guestfs_available> instead.");
817
818   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
819    [InitNone, Always, TestOutputTrue (
820       [["set_selinux"; "true"];
821        ["get_selinux"]])],
822    "set SELinux enabled or disabled at appliance boot",
823    "\
824 This sets the selinux flag that is passed to the appliance
825 at boot time.  The default is C<selinux=0> (disabled).
826
827 Note that if SELinux is enabled, it is always in
828 Permissive mode (C<enforcing=0>).
829
830 For more information on the architecture of libguestfs,
831 see L<guestfs(3)>.");
832
833   ("get_selinux", (RBool "selinux", []), -1, [],
834    [],
835    "get SELinux enabled flag",
836    "\
837 This returns the current setting of the selinux flag which
838 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
839
840 For more information on the architecture of libguestfs,
841 see L<guestfs(3)>.");
842
843   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
844    [InitNone, Always, TestOutputFalse (
845       [["set_trace"; "false"];
846        ["get_trace"]])],
847    "enable or disable command traces",
848    "\
849 If the command trace flag is set to 1, then commands are
850 printed on stdout before they are executed in a format
851 which is very similar to the one used by guestfish.  In
852 other words, you can run a program with this enabled, and
853 you will get out a script which you can feed to guestfish
854 to perform the same set of actions.
855
856 If you want to trace C API calls into libguestfs (and
857 other libraries) then possibly a better way is to use
858 the external ltrace(1) command.
859
860 Command traces are disabled unless the environment variable
861 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
862
863   ("get_trace", (RBool "trace", []), -1, [],
864    [],
865    "get command trace enabled flag",
866    "\
867 Return the command trace flag.");
868
869   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
870    [InitNone, Always, TestOutputFalse (
871       [["set_direct"; "false"];
872        ["get_direct"]])],
873    "enable or disable direct appliance mode",
874    "\
875 If the direct appliance mode flag is enabled, then stdin and
876 stdout are passed directly through to the appliance once it
877 is launched.
878
879 One consequence of this is that log messages aren't caught
880 by the library and handled by C<guestfs_set_log_message_callback>,
881 but go straight to stdout.
882
883 You probably don't want to use this unless you know what you
884 are doing.
885
886 The default is disabled.");
887
888   ("get_direct", (RBool "direct", []), -1, [],
889    [],
890    "get direct appliance mode flag",
891    "\
892 Return the direct appliance mode flag.");
893
894   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
895    [InitNone, Always, TestOutputTrue (
896       [["set_recovery_proc"; "true"];
897        ["get_recovery_proc"]])],
898    "enable or disable the recovery process",
899    "\
900 If this is called with the parameter C<false> then
901 C<guestfs_launch> does not create a recovery process.  The
902 purpose of the recovery process is to stop runaway qemu
903 processes in the case where the main program aborts abruptly.
904
905 This only has any effect if called before C<guestfs_launch>,
906 and the default is true.
907
908 About the only time when you would want to disable this is
909 if the main process will fork itself into the background
910 (\"daemonize\" itself).  In this case the recovery process
911 thinks that the main program has disappeared and so kills
912 qemu, which is not very helpful.");
913
914   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
915    [],
916    "get recovery process enabled flag",
917    "\
918 Return the recovery process enabled flag.");
919
920   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
921    [],
922    "add a drive specifying the QEMU block emulation to use",
923    "\
924 This is the same as C<guestfs_add_drive> but it allows you
925 to specify the QEMU interface emulation to use at run time.");
926
927   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
928    [],
929    "add a drive read-only specifying the QEMU block emulation to use",
930    "\
931 This is the same as C<guestfs_add_drive_ro> but it allows you
932 to specify the QEMU interface emulation to use at run time.");
933
934 ]
935
936 (* daemon_functions are any functions which cause some action
937  * to take place in the daemon.
938  *)
939
940 let daemon_functions = [
941   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
942    [InitEmpty, Always, TestOutput (
943       [["part_disk"; "/dev/sda"; "mbr"];
944        ["mkfs"; "ext2"; "/dev/sda1"];
945        ["mount"; "/dev/sda1"; "/"];
946        ["write"; "/new"; "new file contents"];
947        ["cat"; "/new"]], "new file contents")],
948    "mount a guest disk at a position in the filesystem",
949    "\
950 Mount a guest disk at a position in the filesystem.  Block devices
951 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
952 the guest.  If those block devices contain partitions, they will have
953 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
954 names can be used.
955
956 The rules are the same as for L<mount(2)>:  A filesystem must
957 first be mounted on C</> before others can be mounted.  Other
958 filesystems can only be mounted on directories which already
959 exist.
960
961 The mounted filesystem is writable, if we have sufficient permissions
962 on the underlying device.
963
964 B<Important note:>
965 When you use this call, the filesystem options C<sync> and C<noatime>
966 are set implicitly.  This was originally done because we thought it
967 would improve reliability, but it turns out that I<-o sync> has a
968 very large negative performance impact and negligible effect on
969 reliability.  Therefore we recommend that you avoid using
970 C<guestfs_mount> in any code that needs performance, and instead
971 use C<guestfs_mount_options> (use an empty string for the first
972 parameter if you don't want any options).");
973
974   ("sync", (RErr, []), 2, [],
975    [ InitEmpty, Always, TestRun [["sync"]]],
976    "sync disks, writes are flushed through to the disk image",
977    "\
978 This syncs the disk, so that any writes are flushed through to the
979 underlying disk image.
980
981 You should always call this if you have modified a disk image, before
982 closing the handle.");
983
984   ("touch", (RErr, [Pathname "path"]), 3, [],
985    [InitBasicFS, Always, TestOutputTrue (
986       [["touch"; "/new"];
987        ["exists"; "/new"]])],
988    "update file timestamps or create a new file",
989    "\
990 Touch acts like the L<touch(1)> command.  It can be used to
991 update the timestamps on a file, or, if the file does not exist,
992 to create a new zero-length file.");
993
994   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
995    [InitISOFS, Always, TestOutput (
996       [["cat"; "/known-2"]], "abcdef\n")],
997    "list the contents of a file",
998    "\
999 Return the contents of the file named C<path>.
1000
1001 Note that this function cannot correctly handle binary files
1002 (specifically, files containing C<\\0> character which is treated
1003 as end of string).  For those you need to use the C<guestfs_read_file>
1004 or C<guestfs_download> functions which have a more complex interface.");
1005
1006   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1007    [], (* XXX Tricky to test because it depends on the exact format
1008         * of the 'ls -l' command, which changes between F10 and F11.
1009         *)
1010    "list the files in a directory (long format)",
1011    "\
1012 List the files in C<directory> (relative to the root directory,
1013 there is no cwd) in the format of 'ls -la'.
1014
1015 This command is mostly useful for interactive sessions.  It
1016 is I<not> intended that you try to parse the output string.");
1017
1018   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1019    [InitBasicFS, Always, TestOutputList (
1020       [["touch"; "/new"];
1021        ["touch"; "/newer"];
1022        ["touch"; "/newest"];
1023        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1024    "list the files in a directory",
1025    "\
1026 List the files in C<directory> (relative to the root directory,
1027 there is no cwd).  The '.' and '..' entries are not returned, but
1028 hidden files are shown.
1029
1030 This command is mostly useful for interactive sessions.  Programs
1031 should probably use C<guestfs_readdir> instead.");
1032
1033   ("list_devices", (RStringList "devices", []), 7, [],
1034    [InitEmpty, Always, TestOutputListOfDevices (
1035       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1036    "list the block devices",
1037    "\
1038 List all the block devices.
1039
1040 The full block device names are returned, eg. C</dev/sda>");
1041
1042   ("list_partitions", (RStringList "partitions", []), 8, [],
1043    [InitBasicFS, Always, TestOutputListOfDevices (
1044       [["list_partitions"]], ["/dev/sda1"]);
1045     InitEmpty, Always, TestOutputListOfDevices (
1046       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1047        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1048    "list the partitions",
1049    "\
1050 List all the partitions detected on all block devices.
1051
1052 The full partition device names are returned, eg. C</dev/sda1>
1053
1054 This does not return logical volumes.  For that you will need to
1055 call C<guestfs_lvs>.");
1056
1057   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1058    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1059       [["pvs"]], ["/dev/sda1"]);
1060     InitEmpty, Always, TestOutputListOfDevices (
1061       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1062        ["pvcreate"; "/dev/sda1"];
1063        ["pvcreate"; "/dev/sda2"];
1064        ["pvcreate"; "/dev/sda3"];
1065        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1066    "list the LVM physical volumes (PVs)",
1067    "\
1068 List all the physical volumes detected.  This is the equivalent
1069 of the L<pvs(8)> command.
1070
1071 This returns a list of just the device names that contain
1072 PVs (eg. C</dev/sda2>).
1073
1074 See also C<guestfs_pvs_full>.");
1075
1076   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1077    [InitBasicFSonLVM, Always, TestOutputList (
1078       [["vgs"]], ["VG"]);
1079     InitEmpty, Always, TestOutputList (
1080       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1081        ["pvcreate"; "/dev/sda1"];
1082        ["pvcreate"; "/dev/sda2"];
1083        ["pvcreate"; "/dev/sda3"];
1084        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1085        ["vgcreate"; "VG2"; "/dev/sda3"];
1086        ["vgs"]], ["VG1"; "VG2"])],
1087    "list the LVM volume groups (VGs)",
1088    "\
1089 List all the volumes groups detected.  This is the equivalent
1090 of the L<vgs(8)> command.
1091
1092 This returns a list of just the volume group names that were
1093 detected (eg. C<VolGroup00>).
1094
1095 See also C<guestfs_vgs_full>.");
1096
1097   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1098    [InitBasicFSonLVM, Always, TestOutputList (
1099       [["lvs"]], ["/dev/VG/LV"]);
1100     InitEmpty, Always, TestOutputList (
1101       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1102        ["pvcreate"; "/dev/sda1"];
1103        ["pvcreate"; "/dev/sda2"];
1104        ["pvcreate"; "/dev/sda3"];
1105        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1106        ["vgcreate"; "VG2"; "/dev/sda3"];
1107        ["lvcreate"; "LV1"; "VG1"; "50"];
1108        ["lvcreate"; "LV2"; "VG1"; "50"];
1109        ["lvcreate"; "LV3"; "VG2"; "50"];
1110        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1111    "list the LVM logical volumes (LVs)",
1112    "\
1113 List all the logical volumes detected.  This is the equivalent
1114 of the L<lvs(8)> command.
1115
1116 This returns a list of the logical volume device names
1117 (eg. C</dev/VolGroup00/LogVol00>).
1118
1119 See also C<guestfs_lvs_full>.");
1120
1121   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1122    [], (* XXX how to test? *)
1123    "list the LVM physical volumes (PVs)",
1124    "\
1125 List all the physical volumes detected.  This is the equivalent
1126 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1127
1128   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1129    [], (* XXX how to test? *)
1130    "list the LVM volume groups (VGs)",
1131    "\
1132 List all the volumes groups detected.  This is the equivalent
1133 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1134
1135   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1136    [], (* XXX how to test? *)
1137    "list the LVM logical volumes (LVs)",
1138    "\
1139 List all the logical volumes detected.  This is the equivalent
1140 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1141
1142   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1143    [InitISOFS, Always, TestOutputList (
1144       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1145     InitISOFS, Always, TestOutputList (
1146       [["read_lines"; "/empty"]], [])],
1147    "read file as lines",
1148    "\
1149 Return the contents of the file named C<path>.
1150
1151 The file contents are returned as a list of lines.  Trailing
1152 C<LF> and C<CRLF> character sequences are I<not> returned.
1153
1154 Note that this function cannot correctly handle binary files
1155 (specifically, files containing C<\\0> character which is treated
1156 as end of line).  For those you need to use the C<guestfs_read_file>
1157 function which has a more complex interface.");
1158
1159   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1160    [], (* XXX Augeas code needs tests. *)
1161    "create a new Augeas handle",
1162    "\
1163 Create a new Augeas handle for editing configuration files.
1164 If there was any previous Augeas handle associated with this
1165 guestfs session, then it is closed.
1166
1167 You must call this before using any other C<guestfs_aug_*>
1168 commands.
1169
1170 C<root> is the filesystem root.  C<root> must not be NULL,
1171 use C</> instead.
1172
1173 The flags are the same as the flags defined in
1174 E<lt>augeas.hE<gt>, the logical I<or> of the following
1175 integers:
1176
1177 =over 4
1178
1179 =item C<AUG_SAVE_BACKUP> = 1
1180
1181 Keep the original file with a C<.augsave> extension.
1182
1183 =item C<AUG_SAVE_NEWFILE> = 2
1184
1185 Save changes into a file with extension C<.augnew>, and
1186 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1187
1188 =item C<AUG_TYPE_CHECK> = 4
1189
1190 Typecheck lenses (can be expensive).
1191
1192 =item C<AUG_NO_STDINC> = 8
1193
1194 Do not use standard load path for modules.
1195
1196 =item C<AUG_SAVE_NOOP> = 16
1197
1198 Make save a no-op, just record what would have been changed.
1199
1200 =item C<AUG_NO_LOAD> = 32
1201
1202 Do not load the tree in C<guestfs_aug_init>.
1203
1204 =back
1205
1206 To close the handle, you can call C<guestfs_aug_close>.
1207
1208 To find out more about Augeas, see L<http://augeas.net/>.");
1209
1210   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1211    [], (* XXX Augeas code needs tests. *)
1212    "close the current Augeas handle",
1213    "\
1214 Close the current Augeas handle and free up any resources
1215 used by it.  After calling this, you have to call
1216 C<guestfs_aug_init> again before you can use any other
1217 Augeas functions.");
1218
1219   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1220    [], (* XXX Augeas code needs tests. *)
1221    "define an Augeas variable",
1222    "\
1223 Defines an Augeas variable C<name> whose value is the result
1224 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1225 undefined.
1226
1227 On success this returns the number of nodes in C<expr>, or
1228 C<0> if C<expr> evaluates to something which is not a nodeset.");
1229
1230   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1231    [], (* XXX Augeas code needs tests. *)
1232    "define an Augeas node",
1233    "\
1234 Defines a variable C<name> whose value is the result of
1235 evaluating C<expr>.
1236
1237 If C<expr> evaluates to an empty nodeset, a node is created,
1238 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1239 C<name> will be the nodeset containing that single node.
1240
1241 On success this returns a pair containing the
1242 number of nodes in the nodeset, and a boolean flag
1243 if a node was created.");
1244
1245   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1246    [], (* XXX Augeas code needs tests. *)
1247    "look up the value of an Augeas path",
1248    "\
1249 Look up the value associated with C<path>.  If C<path>
1250 matches exactly one node, the C<value> is returned.");
1251
1252   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1253    [], (* XXX Augeas code needs tests. *)
1254    "set Augeas path to value",
1255    "\
1256 Set the value associated with C<path> to C<val>.
1257
1258 In the Augeas API, it is possible to clear a node by setting
1259 the value to NULL.  Due to an oversight in the libguestfs API
1260 you cannot do that with this call.  Instead you must use the
1261 C<guestfs_aug_clear> call.");
1262
1263   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1264    [], (* XXX Augeas code needs tests. *)
1265    "insert a sibling Augeas node",
1266    "\
1267 Create a new sibling C<label> for C<path>, inserting it into
1268 the tree before or after C<path> (depending on the boolean
1269 flag C<before>).
1270
1271 C<path> must match exactly one existing node in the tree, and
1272 C<label> must be a label, ie. not contain C</>, C<*> or end
1273 with a bracketed index C<[N]>.");
1274
1275   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1276    [], (* XXX Augeas code needs tests. *)
1277    "remove an Augeas path",
1278    "\
1279 Remove C<path> and all of its children.
1280
1281 On success this returns the number of entries which were removed.");
1282
1283   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1284    [], (* XXX Augeas code needs tests. *)
1285    "move Augeas node",
1286    "\
1287 Move the node C<src> to C<dest>.  C<src> must match exactly
1288 one node.  C<dest> is overwritten if it exists.");
1289
1290   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1291    [], (* XXX Augeas code needs tests. *)
1292    "return Augeas nodes which match augpath",
1293    "\
1294 Returns a list of paths which match the path expression C<path>.
1295 The returned paths are sufficiently qualified so that they match
1296 exactly one node in the current tree.");
1297
1298   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1299    [], (* XXX Augeas code needs tests. *)
1300    "write all pending Augeas changes to disk",
1301    "\
1302 This writes all pending changes to disk.
1303
1304 The flags which were passed to C<guestfs_aug_init> affect exactly
1305 how files are saved.");
1306
1307   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1308    [], (* XXX Augeas code needs tests. *)
1309    "load files into the tree",
1310    "\
1311 Load files into the tree.
1312
1313 See C<aug_load> in the Augeas documentation for the full gory
1314 details.");
1315
1316   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1317    [], (* XXX Augeas code needs tests. *)
1318    "list Augeas nodes under augpath",
1319    "\
1320 This is just a shortcut for listing C<guestfs_aug_match>
1321 C<path/*> and sorting the resulting nodes into alphabetical order.");
1322
1323   ("rm", (RErr, [Pathname "path"]), 29, [],
1324    [InitBasicFS, Always, TestRun
1325       [["touch"; "/new"];
1326        ["rm"; "/new"]];
1327     InitBasicFS, Always, TestLastFail
1328       [["rm"; "/new"]];
1329     InitBasicFS, Always, TestLastFail
1330       [["mkdir"; "/new"];
1331        ["rm"; "/new"]]],
1332    "remove a file",
1333    "\
1334 Remove the single file C<path>.");
1335
1336   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1337    [InitBasicFS, Always, TestRun
1338       [["mkdir"; "/new"];
1339        ["rmdir"; "/new"]];
1340     InitBasicFS, Always, TestLastFail
1341       [["rmdir"; "/new"]];
1342     InitBasicFS, Always, TestLastFail
1343       [["touch"; "/new"];
1344        ["rmdir"; "/new"]]],
1345    "remove a directory",
1346    "\
1347 Remove the single directory C<path>.");
1348
1349   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1350    [InitBasicFS, Always, TestOutputFalse
1351       [["mkdir"; "/new"];
1352        ["mkdir"; "/new/foo"];
1353        ["touch"; "/new/foo/bar"];
1354        ["rm_rf"; "/new"];
1355        ["exists"; "/new"]]],
1356    "remove a file or directory recursively",
1357    "\
1358 Remove the file or directory C<path>, recursively removing the
1359 contents if its a directory.  This is like the C<rm -rf> shell
1360 command.");
1361
1362   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1363    [InitBasicFS, Always, TestOutputTrue
1364       [["mkdir"; "/new"];
1365        ["is_dir"; "/new"]];
1366     InitBasicFS, Always, TestLastFail
1367       [["mkdir"; "/new/foo/bar"]]],
1368    "create a directory",
1369    "\
1370 Create a directory named C<path>.");
1371
1372   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1373    [InitBasicFS, Always, TestOutputTrue
1374       [["mkdir_p"; "/new/foo/bar"];
1375        ["is_dir"; "/new/foo/bar"]];
1376     InitBasicFS, Always, TestOutputTrue
1377       [["mkdir_p"; "/new/foo/bar"];
1378        ["is_dir"; "/new/foo"]];
1379     InitBasicFS, Always, TestOutputTrue
1380       [["mkdir_p"; "/new/foo/bar"];
1381        ["is_dir"; "/new"]];
1382     (* Regression tests for RHBZ#503133: *)
1383     InitBasicFS, Always, TestRun
1384       [["mkdir"; "/new"];
1385        ["mkdir_p"; "/new"]];
1386     InitBasicFS, Always, TestLastFail
1387       [["touch"; "/new"];
1388        ["mkdir_p"; "/new"]]],
1389    "create a directory and parents",
1390    "\
1391 Create a directory named C<path>, creating any parent directories
1392 as necessary.  This is like the C<mkdir -p> shell command.");
1393
1394   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1395    [], (* XXX Need stat command to test *)
1396    "change file mode",
1397    "\
1398 Change the mode (permissions) of C<path> to C<mode>.  Only
1399 numeric modes are supported.
1400
1401 I<Note>: When using this command from guestfish, C<mode>
1402 by default would be decimal, unless you prefix it with
1403 C<0> to get octal, ie. use C<0700> not C<700>.
1404
1405 The mode actually set is affected by the umask.");
1406
1407   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1408    [], (* XXX Need stat command to test *)
1409    "change file owner and group",
1410    "\
1411 Change the file owner to C<owner> and group to C<group>.
1412
1413 Only numeric uid and gid are supported.  If you want to use
1414 names, you will need to locate and parse the password file
1415 yourself (Augeas support makes this relatively easy).");
1416
1417   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1418    [InitISOFS, Always, TestOutputTrue (
1419       [["exists"; "/empty"]]);
1420     InitISOFS, Always, TestOutputTrue (
1421       [["exists"; "/directory"]])],
1422    "test if file or directory exists",
1423    "\
1424 This returns C<true> if and only if there is a file, directory
1425 (or anything) with the given C<path> name.
1426
1427 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1428
1429   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1430    [InitISOFS, Always, TestOutputTrue (
1431       [["is_file"; "/known-1"]]);
1432     InitISOFS, Always, TestOutputFalse (
1433       [["is_file"; "/directory"]])],
1434    "test if file exists",
1435    "\
1436 This returns C<true> if and only if there is a file
1437 with the given C<path> name.  Note that it returns false for
1438 other objects like directories.
1439
1440 See also C<guestfs_stat>.");
1441
1442   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1443    [InitISOFS, Always, TestOutputFalse (
1444       [["is_dir"; "/known-3"]]);
1445     InitISOFS, Always, TestOutputTrue (
1446       [["is_dir"; "/directory"]])],
1447    "test if file exists",
1448    "\
1449 This returns C<true> if and only if there is a directory
1450 with the given C<path> name.  Note that it returns false for
1451 other objects like files.
1452
1453 See also C<guestfs_stat>.");
1454
1455   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1456    [InitEmpty, Always, TestOutputListOfDevices (
1457       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1458        ["pvcreate"; "/dev/sda1"];
1459        ["pvcreate"; "/dev/sda2"];
1460        ["pvcreate"; "/dev/sda3"];
1461        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1462    "create an LVM physical volume",
1463    "\
1464 This creates an LVM physical volume on the named C<device>,
1465 where C<device> should usually be a partition name such
1466 as C</dev/sda1>.");
1467
1468   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1469    [InitEmpty, Always, TestOutputList (
1470       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1471        ["pvcreate"; "/dev/sda1"];
1472        ["pvcreate"; "/dev/sda2"];
1473        ["pvcreate"; "/dev/sda3"];
1474        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1475        ["vgcreate"; "VG2"; "/dev/sda3"];
1476        ["vgs"]], ["VG1"; "VG2"])],
1477    "create an LVM volume group",
1478    "\
1479 This creates an LVM volume group called C<volgroup>
1480 from the non-empty list of physical volumes C<physvols>.");
1481
1482   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1483    [InitEmpty, Always, TestOutputList (
1484       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1485        ["pvcreate"; "/dev/sda1"];
1486        ["pvcreate"; "/dev/sda2"];
1487        ["pvcreate"; "/dev/sda3"];
1488        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1489        ["vgcreate"; "VG2"; "/dev/sda3"];
1490        ["lvcreate"; "LV1"; "VG1"; "50"];
1491        ["lvcreate"; "LV2"; "VG1"; "50"];
1492        ["lvcreate"; "LV3"; "VG2"; "50"];
1493        ["lvcreate"; "LV4"; "VG2"; "50"];
1494        ["lvcreate"; "LV5"; "VG2"; "50"];
1495        ["lvs"]],
1496       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1497        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1498    "create an LVM logical volume",
1499    "\
1500 This creates an LVM logical volume called C<logvol>
1501 on the volume group C<volgroup>, with C<size> megabytes.");
1502
1503   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1504    [InitEmpty, Always, TestOutput (
1505       [["part_disk"; "/dev/sda"; "mbr"];
1506        ["mkfs"; "ext2"; "/dev/sda1"];
1507        ["mount_options"; ""; "/dev/sda1"; "/"];
1508        ["write"; "/new"; "new file contents"];
1509        ["cat"; "/new"]], "new file contents")],
1510    "make a filesystem",
1511    "\
1512 This creates a filesystem on C<device> (usually a partition
1513 or LVM logical volume).  The filesystem type is C<fstype>, for
1514 example C<ext3>.");
1515
1516   ("sfdisk", (RErr, [Device "device";
1517                      Int "cyls"; Int "heads"; Int "sectors";
1518                      StringList "lines"]), 43, [DangerWillRobinson],
1519    [],
1520    "create partitions on a block device",
1521    "\
1522 This is a direct interface to the L<sfdisk(8)> program for creating
1523 partitions on block devices.
1524
1525 C<device> should be a block device, for example C</dev/sda>.
1526
1527 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1528 and sectors on the device, which are passed directly to sfdisk as
1529 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1530 of these, then the corresponding parameter is omitted.  Usually for
1531 'large' disks, you can just pass C<0> for these, but for small
1532 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1533 out the right geometry and you will need to tell it.
1534
1535 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1536 information refer to the L<sfdisk(8)> manpage.
1537
1538 To create a single partition occupying the whole disk, you would
1539 pass C<lines> as a single element list, when the single element being
1540 the string C<,> (comma).
1541
1542 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1543 C<guestfs_part_init>");
1544
1545   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],
1546    (* Regression test for RHBZ#597135. *)
1547    [InitBasicFS, Always, TestLastFail
1548       [["write_file"; "/new"; "abc"; "10000"]]],
1549    "create a file",
1550    "\
1551 This call creates a file called C<path>.  The contents of the
1552 file is the string C<content> (which can contain any 8 bit data),
1553 with length C<size>.
1554
1555 As a special case, if C<size> is C<0>
1556 then the length is calculated using C<strlen> (so in this case
1557 the content cannot contain embedded ASCII NULs).
1558
1559 I<NB.> Owing to a bug, writing content containing ASCII NUL
1560 characters does I<not> work, even if the length is specified.");
1561
1562   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1563    [InitEmpty, Always, TestOutputListOfDevices (
1564       [["part_disk"; "/dev/sda"; "mbr"];
1565        ["mkfs"; "ext2"; "/dev/sda1"];
1566        ["mount_options"; ""; "/dev/sda1"; "/"];
1567        ["mounts"]], ["/dev/sda1"]);
1568     InitEmpty, Always, TestOutputList (
1569       [["part_disk"; "/dev/sda"; "mbr"];
1570        ["mkfs"; "ext2"; "/dev/sda1"];
1571        ["mount_options"; ""; "/dev/sda1"; "/"];
1572        ["umount"; "/"];
1573        ["mounts"]], [])],
1574    "unmount a filesystem",
1575    "\
1576 This unmounts the given filesystem.  The filesystem may be
1577 specified either by its mountpoint (path) or the device which
1578 contains the filesystem.");
1579
1580   ("mounts", (RStringList "devices", []), 46, [],
1581    [InitBasicFS, Always, TestOutputListOfDevices (
1582       [["mounts"]], ["/dev/sda1"])],
1583    "show mounted filesystems",
1584    "\
1585 This returns the list of currently mounted filesystems.  It returns
1586 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1587
1588 Some internal mounts are not shown.
1589
1590 See also: C<guestfs_mountpoints>");
1591
1592   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1593    [InitBasicFS, Always, TestOutputList (
1594       [["umount_all"];
1595        ["mounts"]], []);
1596     (* check that umount_all can unmount nested mounts correctly: *)
1597     InitEmpty, Always, TestOutputList (
1598       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1599        ["mkfs"; "ext2"; "/dev/sda1"];
1600        ["mkfs"; "ext2"; "/dev/sda2"];
1601        ["mkfs"; "ext2"; "/dev/sda3"];
1602        ["mount_options"; ""; "/dev/sda1"; "/"];
1603        ["mkdir"; "/mp1"];
1604        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1605        ["mkdir"; "/mp1/mp2"];
1606        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1607        ["mkdir"; "/mp1/mp2/mp3"];
1608        ["umount_all"];
1609        ["mounts"]], [])],
1610    "unmount all filesystems",
1611    "\
1612 This unmounts all mounted filesystems.
1613
1614 Some internal mounts are not unmounted by this call.");
1615
1616   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1617    [],
1618    "remove all LVM LVs, VGs and PVs",
1619    "\
1620 This command removes all LVM logical volumes, volume groups
1621 and physical volumes.");
1622
1623   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1624    [InitISOFS, Always, TestOutput (
1625       [["file"; "/empty"]], "empty");
1626     InitISOFS, Always, TestOutput (
1627       [["file"; "/known-1"]], "ASCII text");
1628     InitISOFS, Always, TestLastFail (
1629       [["file"; "/notexists"]])],
1630    "determine file type",
1631    "\
1632 This call uses the standard L<file(1)> command to determine
1633 the type or contents of the file.  This also works on devices,
1634 for example to find out whether a partition contains a filesystem.
1635
1636 This call will also transparently look inside various types
1637 of compressed file.
1638
1639 The exact command which runs is C<file -zbsL path>.  Note in
1640 particular that the filename is not prepended to the output
1641 (the C<-b> option).");
1642
1643   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1644    [InitBasicFS, Always, TestOutput (
1645       [["upload"; "test-command"; "/test-command"];
1646        ["chmod"; "0o755"; "/test-command"];
1647        ["command"; "/test-command 1"]], "Result1");
1648     InitBasicFS, Always, TestOutput (
1649       [["upload"; "test-command"; "/test-command"];
1650        ["chmod"; "0o755"; "/test-command"];
1651        ["command"; "/test-command 2"]], "Result2\n");
1652     InitBasicFS, Always, TestOutput (
1653       [["upload"; "test-command"; "/test-command"];
1654        ["chmod"; "0o755"; "/test-command"];
1655        ["command"; "/test-command 3"]], "\nResult3");
1656     InitBasicFS, Always, TestOutput (
1657       [["upload"; "test-command"; "/test-command"];
1658        ["chmod"; "0o755"; "/test-command"];
1659        ["command"; "/test-command 4"]], "\nResult4\n");
1660     InitBasicFS, Always, TestOutput (
1661       [["upload"; "test-command"; "/test-command"];
1662        ["chmod"; "0o755"; "/test-command"];
1663        ["command"; "/test-command 5"]], "\nResult5\n\n");
1664     InitBasicFS, Always, TestOutput (
1665       [["upload"; "test-command"; "/test-command"];
1666        ["chmod"; "0o755"; "/test-command"];
1667        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1668     InitBasicFS, Always, TestOutput (
1669       [["upload"; "test-command"; "/test-command"];
1670        ["chmod"; "0o755"; "/test-command"];
1671        ["command"; "/test-command 7"]], "");
1672     InitBasicFS, Always, TestOutput (
1673       [["upload"; "test-command"; "/test-command"];
1674        ["chmod"; "0o755"; "/test-command"];
1675        ["command"; "/test-command 8"]], "\n");
1676     InitBasicFS, Always, TestOutput (
1677       [["upload"; "test-command"; "/test-command"];
1678        ["chmod"; "0o755"; "/test-command"];
1679        ["command"; "/test-command 9"]], "\n\n");
1680     InitBasicFS, Always, TestOutput (
1681       [["upload"; "test-command"; "/test-command"];
1682        ["chmod"; "0o755"; "/test-command"];
1683        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1684     InitBasicFS, Always, TestOutput (
1685       [["upload"; "test-command"; "/test-command"];
1686        ["chmod"; "0o755"; "/test-command"];
1687        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1688     InitBasicFS, Always, TestLastFail (
1689       [["upload"; "test-command"; "/test-command"];
1690        ["chmod"; "0o755"; "/test-command"];
1691        ["command"; "/test-command"]])],
1692    "run a command from the guest filesystem",
1693    "\
1694 This call runs a command from the guest filesystem.  The
1695 filesystem must be mounted, and must contain a compatible
1696 operating system (ie. something Linux, with the same
1697 or compatible processor architecture).
1698
1699 The single parameter is an argv-style list of arguments.
1700 The first element is the name of the program to run.
1701 Subsequent elements are parameters.  The list must be
1702 non-empty (ie. must contain a program name).  Note that
1703 the command runs directly, and is I<not> invoked via
1704 the shell (see C<guestfs_sh>).
1705
1706 The return value is anything printed to I<stdout> by
1707 the command.
1708
1709 If the command returns a non-zero exit status, then
1710 this function returns an error message.  The error message
1711 string is the content of I<stderr> from the command.
1712
1713 The C<$PATH> environment variable will contain at least
1714 C</usr/bin> and C</bin>.  If you require a program from
1715 another location, you should provide the full path in the
1716 first parameter.
1717
1718 Shared libraries and data files required by the program
1719 must be available on filesystems which are mounted in the
1720 correct places.  It is the caller's responsibility to ensure
1721 all filesystems that are needed are mounted at the right
1722 locations.");
1723
1724   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1725    [InitBasicFS, Always, TestOutputList (
1726       [["upload"; "test-command"; "/test-command"];
1727        ["chmod"; "0o755"; "/test-command"];
1728        ["command_lines"; "/test-command 1"]], ["Result1"]);
1729     InitBasicFS, Always, TestOutputList (
1730       [["upload"; "test-command"; "/test-command"];
1731        ["chmod"; "0o755"; "/test-command"];
1732        ["command_lines"; "/test-command 2"]], ["Result2"]);
1733     InitBasicFS, Always, TestOutputList (
1734       [["upload"; "test-command"; "/test-command"];
1735        ["chmod"; "0o755"; "/test-command"];
1736        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1737     InitBasicFS, Always, TestOutputList (
1738       [["upload"; "test-command"; "/test-command"];
1739        ["chmod"; "0o755"; "/test-command"];
1740        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1741     InitBasicFS, Always, TestOutputList (
1742       [["upload"; "test-command"; "/test-command"];
1743        ["chmod"; "0o755"; "/test-command"];
1744        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1745     InitBasicFS, Always, TestOutputList (
1746       [["upload"; "test-command"; "/test-command"];
1747        ["chmod"; "0o755"; "/test-command"];
1748        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1749     InitBasicFS, Always, TestOutputList (
1750       [["upload"; "test-command"; "/test-command"];
1751        ["chmod"; "0o755"; "/test-command"];
1752        ["command_lines"; "/test-command 7"]], []);
1753     InitBasicFS, Always, TestOutputList (
1754       [["upload"; "test-command"; "/test-command"];
1755        ["chmod"; "0o755"; "/test-command"];
1756        ["command_lines"; "/test-command 8"]], [""]);
1757     InitBasicFS, Always, TestOutputList (
1758       [["upload"; "test-command"; "/test-command"];
1759        ["chmod"; "0o755"; "/test-command"];
1760        ["command_lines"; "/test-command 9"]], ["";""]);
1761     InitBasicFS, Always, TestOutputList (
1762       [["upload"; "test-command"; "/test-command"];
1763        ["chmod"; "0o755"; "/test-command"];
1764        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1765     InitBasicFS, Always, TestOutputList (
1766       [["upload"; "test-command"; "/test-command"];
1767        ["chmod"; "0o755"; "/test-command"];
1768        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1769    "run a command, returning lines",
1770    "\
1771 This is the same as C<guestfs_command>, but splits the
1772 result into a list of lines.
1773
1774 See also: C<guestfs_sh_lines>");
1775
1776   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1777    [InitISOFS, Always, TestOutputStruct (
1778       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1779    "get file information",
1780    "\
1781 Returns file information for the given C<path>.
1782
1783 This is the same as the C<stat(2)> system call.");
1784
1785   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1786    [InitISOFS, Always, TestOutputStruct (
1787       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1788    "get file information for a symbolic link",
1789    "\
1790 Returns file information for the given C<path>.
1791
1792 This is the same as C<guestfs_stat> except that if C<path>
1793 is a symbolic link, then the link is stat-ed, not the file it
1794 refers to.
1795
1796 This is the same as the C<lstat(2)> system call.");
1797
1798   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1799    [InitISOFS, Always, TestOutputStruct (
1800       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1801    "get file system statistics",
1802    "\
1803 Returns file system statistics for any mounted file system.
1804 C<path> should be a file or directory in the mounted file system
1805 (typically it is the mount point itself, but it doesn't need to be).
1806
1807 This is the same as the C<statvfs(2)> system call.");
1808
1809   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1810    [], (* XXX test *)
1811    "get ext2/ext3/ext4 superblock details",
1812    "\
1813 This returns the contents of the ext2, ext3 or ext4 filesystem
1814 superblock on C<device>.
1815
1816 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1817 manpage for more details.  The list of fields returned isn't
1818 clearly defined, and depends on both the version of C<tune2fs>
1819 that libguestfs was built against, and the filesystem itself.");
1820
1821   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1822    [InitEmpty, Always, TestOutputTrue (
1823       [["blockdev_setro"; "/dev/sda"];
1824        ["blockdev_getro"; "/dev/sda"]])],
1825    "set block device to read-only",
1826    "\
1827 Sets the block device named C<device> to read-only.
1828
1829 This uses the L<blockdev(8)> command.");
1830
1831   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1832    [InitEmpty, Always, TestOutputFalse (
1833       [["blockdev_setrw"; "/dev/sda"];
1834        ["blockdev_getro"; "/dev/sda"]])],
1835    "set block device to read-write",
1836    "\
1837 Sets the block device named C<device> to read-write.
1838
1839 This uses the L<blockdev(8)> command.");
1840
1841   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1842    [InitEmpty, Always, TestOutputTrue (
1843       [["blockdev_setro"; "/dev/sda"];
1844        ["blockdev_getro"; "/dev/sda"]])],
1845    "is block device set to read-only",
1846    "\
1847 Returns a boolean indicating if the block device is read-only
1848 (true if read-only, false if not).
1849
1850 This uses the L<blockdev(8)> command.");
1851
1852   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1853    [InitEmpty, Always, TestOutputInt (
1854       [["blockdev_getss"; "/dev/sda"]], 512)],
1855    "get sectorsize of block device",
1856    "\
1857 This returns the size of sectors on a block device.
1858 Usually 512, but can be larger for modern devices.
1859
1860 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1861 for that).
1862
1863 This uses the L<blockdev(8)> command.");
1864
1865   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1866    [InitEmpty, Always, TestOutputInt (
1867       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1868    "get blocksize of block device",
1869    "\
1870 This returns the block size of a device.
1871
1872 (Note this is different from both I<size in blocks> and
1873 I<filesystem block size>).
1874
1875 This uses the L<blockdev(8)> command.");
1876
1877   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1878    [], (* XXX test *)
1879    "set blocksize of block device",
1880    "\
1881 This sets the block size of a device.
1882
1883 (Note this is different from both I<size in blocks> and
1884 I<filesystem block size>).
1885
1886 This uses the L<blockdev(8)> command.");
1887
1888   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1889    [InitEmpty, Always, TestOutputInt (
1890       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1891    "get total size of device in 512-byte sectors",
1892    "\
1893 This returns the size of the device in units of 512-byte sectors
1894 (even if the sectorsize isn't 512 bytes ... weird).
1895
1896 See also C<guestfs_blockdev_getss> for the real sector size of
1897 the device, and C<guestfs_blockdev_getsize64> for the more
1898 useful I<size in bytes>.
1899
1900 This uses the L<blockdev(8)> command.");
1901
1902   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1903    [InitEmpty, Always, TestOutputInt (
1904       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1905    "get total size of device in bytes",
1906    "\
1907 This returns the size of the device in bytes.
1908
1909 See also C<guestfs_blockdev_getsz>.
1910
1911 This uses the L<blockdev(8)> command.");
1912
1913   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1914    [InitEmpty, Always, TestRun
1915       [["blockdev_flushbufs"; "/dev/sda"]]],
1916    "flush device buffers",
1917    "\
1918 This tells the kernel to flush internal buffers associated
1919 with C<device>.
1920
1921 This uses the L<blockdev(8)> command.");
1922
1923   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1924    [InitEmpty, Always, TestRun
1925       [["blockdev_rereadpt"; "/dev/sda"]]],
1926    "reread partition table",
1927    "\
1928 Reread the partition table on C<device>.
1929
1930 This uses the L<blockdev(8)> command.");
1931
1932   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1933    [InitBasicFS, Always, TestOutput (
1934       (* Pick a file from cwd which isn't likely to change. *)
1935       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1936        ["checksum"; "md5"; "/COPYING.LIB"]],
1937       Digest.to_hex (Digest.file "COPYING.LIB"))],
1938    "upload a file from the local machine",
1939    "\
1940 Upload local file C<filename> to C<remotefilename> on the
1941 filesystem.
1942
1943 C<filename> can also be a named pipe.
1944
1945 See also C<guestfs_download>.");
1946
1947   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1948    [InitBasicFS, Always, TestOutput (
1949       (* Pick a file from cwd which isn't likely to change. *)
1950       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1951        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1952        ["upload"; "testdownload.tmp"; "/upload"];
1953        ["checksum"; "md5"; "/upload"]],
1954       Digest.to_hex (Digest.file "COPYING.LIB"))],
1955    "download a file to the local machine",
1956    "\
1957 Download file C<remotefilename> and save it as C<filename>
1958 on the local machine.
1959
1960 C<filename> can also be a named pipe.
1961
1962 See also C<guestfs_upload>, C<guestfs_cat>.");
1963
1964   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1965    [InitISOFS, Always, TestOutput (
1966       [["checksum"; "crc"; "/known-3"]], "2891671662");
1967     InitISOFS, Always, TestLastFail (
1968       [["checksum"; "crc"; "/notexists"]]);
1969     InitISOFS, Always, TestOutput (
1970       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1971     InitISOFS, Always, TestOutput (
1972       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1973     InitISOFS, Always, TestOutput (
1974       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1975     InitISOFS, Always, TestOutput (
1976       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1977     InitISOFS, Always, TestOutput (
1978       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1979     InitISOFS, Always, TestOutput (
1980       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6");
1981     (* Test for RHBZ#579608, absolute symbolic links. *)
1982     InitISOFS, Always, TestOutput (
1983       [["checksum"; "sha512"; "/abssymlink"]], "5f57d0639bc95081c53afc63a449403883818edc64da48930ad6b1a4fb49be90404686877743fbcd7c99811f3def7df7bc22635c885c6a8cf79c806b43451c1a")],
1984    "compute MD5, SHAx or CRC checksum of file",
1985    "\
1986 This call computes the MD5, SHAx or CRC checksum of the
1987 file named C<path>.
1988
1989 The type of checksum to compute is given by the C<csumtype>
1990 parameter which must have one of the following values:
1991
1992 =over 4
1993
1994 =item C<crc>
1995
1996 Compute the cyclic redundancy check (CRC) specified by POSIX
1997 for the C<cksum> command.
1998
1999 =item C<md5>
2000
2001 Compute the MD5 hash (using the C<md5sum> program).
2002
2003 =item C<sha1>
2004
2005 Compute the SHA1 hash (using the C<sha1sum> program).
2006
2007 =item C<sha224>
2008
2009 Compute the SHA224 hash (using the C<sha224sum> program).
2010
2011 =item C<sha256>
2012
2013 Compute the SHA256 hash (using the C<sha256sum> program).
2014
2015 =item C<sha384>
2016
2017 Compute the SHA384 hash (using the C<sha384sum> program).
2018
2019 =item C<sha512>
2020
2021 Compute the SHA512 hash (using the C<sha512sum> program).
2022
2023 =back
2024
2025 The checksum is returned as a printable string.
2026
2027 To get the checksum for a device, use C<guestfs_checksum_device>.
2028
2029 To get the checksums for many files, use C<guestfs_checksums_out>.");
2030
2031   ("tar_in", (RErr, [FileIn "tarfile"; Pathname "directory"]), 69, [],
2032    [InitBasicFS, Always, TestOutput (
2033       [["tar_in"; "../images/helloworld.tar"; "/"];
2034        ["cat"; "/hello"]], "hello\n")],
2035    "unpack tarfile to directory",
2036    "\
2037 This command uploads and unpacks local file C<tarfile> (an
2038 I<uncompressed> tar file) into C<directory>.
2039
2040 To upload a compressed tarball, use C<guestfs_tgz_in>
2041 or C<guestfs_txz_in>.");
2042
2043   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2044    [],
2045    "pack directory into tarfile",
2046    "\
2047 This command packs the contents of C<directory> and downloads
2048 it to local file C<tarfile>.
2049
2050 To download a compressed tarball, use C<guestfs_tgz_out>
2051 or C<guestfs_txz_out>.");
2052
2053   ("tgz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 71, [],
2054    [InitBasicFS, Always, TestOutput (
2055       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2056        ["cat"; "/hello"]], "hello\n")],
2057    "unpack compressed tarball to directory",
2058    "\
2059 This command uploads and unpacks local file C<tarball> (a
2060 I<gzip compressed> tar file) into C<directory>.
2061
2062 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2063
2064   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2065    [],
2066    "pack directory into compressed tarball",
2067    "\
2068 This command packs the contents of C<directory> and downloads
2069 it to local file C<tarball>.
2070
2071 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2072
2073   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2074    [InitBasicFS, Always, TestLastFail (
2075       [["umount"; "/"];
2076        ["mount_ro"; "/dev/sda1"; "/"];
2077        ["touch"; "/new"]]);
2078     InitBasicFS, Always, TestOutput (
2079       [["write"; "/new"; "data"];
2080        ["umount"; "/"];
2081        ["mount_ro"; "/dev/sda1"; "/"];
2082        ["cat"; "/new"]], "data")],
2083    "mount a guest disk, read-only",
2084    "\
2085 This is the same as the C<guestfs_mount> command, but it
2086 mounts the filesystem with the read-only (I<-o ro>) flag.");
2087
2088   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2089    [],
2090    "mount a guest disk with mount options",
2091    "\
2092 This is the same as the C<guestfs_mount> command, but it
2093 allows you to set the mount options as for the
2094 L<mount(8)> I<-o> flag.
2095
2096 If the C<options> parameter is an empty string, then
2097 no options are passed (all options default to whatever
2098 the filesystem uses).");
2099
2100   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2101    [],
2102    "mount a guest disk with mount options and vfstype",
2103    "\
2104 This is the same as the C<guestfs_mount> command, but it
2105 allows you to set both the mount options and the vfstype
2106 as for the L<mount(8)> I<-o> and I<-t> flags.");
2107
2108   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2109    [],
2110    "debugging and internals",
2111    "\
2112 The C<guestfs_debug> command exposes some internals of
2113 C<guestfsd> (the guestfs daemon) that runs inside the
2114 qemu subprocess.
2115
2116 There is no comprehensive help for this command.  You have
2117 to look at the file C<daemon/debug.c> in the libguestfs source
2118 to find out what you can do.");
2119
2120   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2121    [InitEmpty, Always, TestOutputList (
2122       [["part_disk"; "/dev/sda"; "mbr"];
2123        ["pvcreate"; "/dev/sda1"];
2124        ["vgcreate"; "VG"; "/dev/sda1"];
2125        ["lvcreate"; "LV1"; "VG"; "50"];
2126        ["lvcreate"; "LV2"; "VG"; "50"];
2127        ["lvremove"; "/dev/VG/LV1"];
2128        ["lvs"]], ["/dev/VG/LV2"]);
2129     InitEmpty, Always, TestOutputList (
2130       [["part_disk"; "/dev/sda"; "mbr"];
2131        ["pvcreate"; "/dev/sda1"];
2132        ["vgcreate"; "VG"; "/dev/sda1"];
2133        ["lvcreate"; "LV1"; "VG"; "50"];
2134        ["lvcreate"; "LV2"; "VG"; "50"];
2135        ["lvremove"; "/dev/VG"];
2136        ["lvs"]], []);
2137     InitEmpty, Always, TestOutputList (
2138       [["part_disk"; "/dev/sda"; "mbr"];
2139        ["pvcreate"; "/dev/sda1"];
2140        ["vgcreate"; "VG"; "/dev/sda1"];
2141        ["lvcreate"; "LV1"; "VG"; "50"];
2142        ["lvcreate"; "LV2"; "VG"; "50"];
2143        ["lvremove"; "/dev/VG"];
2144        ["vgs"]], ["VG"])],
2145    "remove an LVM logical volume",
2146    "\
2147 Remove an LVM logical volume C<device>, where C<device> is
2148 the path to the LV, such as C</dev/VG/LV>.
2149
2150 You can also remove all LVs in a volume group by specifying
2151 the VG name, C</dev/VG>.");
2152
2153   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2154    [InitEmpty, Always, TestOutputList (
2155       [["part_disk"; "/dev/sda"; "mbr"];
2156        ["pvcreate"; "/dev/sda1"];
2157        ["vgcreate"; "VG"; "/dev/sda1"];
2158        ["lvcreate"; "LV1"; "VG"; "50"];
2159        ["lvcreate"; "LV2"; "VG"; "50"];
2160        ["vgremove"; "VG"];
2161        ["lvs"]], []);
2162     InitEmpty, Always, TestOutputList (
2163       [["part_disk"; "/dev/sda"; "mbr"];
2164        ["pvcreate"; "/dev/sda1"];
2165        ["vgcreate"; "VG"; "/dev/sda1"];
2166        ["lvcreate"; "LV1"; "VG"; "50"];
2167        ["lvcreate"; "LV2"; "VG"; "50"];
2168        ["vgremove"; "VG"];
2169        ["vgs"]], [])],
2170    "remove an LVM volume group",
2171    "\
2172 Remove an LVM volume group C<vgname>, (for example C<VG>).
2173
2174 This also forcibly removes all logical volumes in the volume
2175 group (if any).");
2176
2177   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2178    [InitEmpty, Always, TestOutputListOfDevices (
2179       [["part_disk"; "/dev/sda"; "mbr"];
2180        ["pvcreate"; "/dev/sda1"];
2181        ["vgcreate"; "VG"; "/dev/sda1"];
2182        ["lvcreate"; "LV1"; "VG"; "50"];
2183        ["lvcreate"; "LV2"; "VG"; "50"];
2184        ["vgremove"; "VG"];
2185        ["pvremove"; "/dev/sda1"];
2186        ["lvs"]], []);
2187     InitEmpty, Always, TestOutputListOfDevices (
2188       [["part_disk"; "/dev/sda"; "mbr"];
2189        ["pvcreate"; "/dev/sda1"];
2190        ["vgcreate"; "VG"; "/dev/sda1"];
2191        ["lvcreate"; "LV1"; "VG"; "50"];
2192        ["lvcreate"; "LV2"; "VG"; "50"];
2193        ["vgremove"; "VG"];
2194        ["pvremove"; "/dev/sda1"];
2195        ["vgs"]], []);
2196     InitEmpty, Always, TestOutputListOfDevices (
2197       [["part_disk"; "/dev/sda"; "mbr"];
2198        ["pvcreate"; "/dev/sda1"];
2199        ["vgcreate"; "VG"; "/dev/sda1"];
2200        ["lvcreate"; "LV1"; "VG"; "50"];
2201        ["lvcreate"; "LV2"; "VG"; "50"];
2202        ["vgremove"; "VG"];
2203        ["pvremove"; "/dev/sda1"];
2204        ["pvs"]], [])],
2205    "remove an LVM physical volume",
2206    "\
2207 This wipes a physical volume C<device> so that LVM will no longer
2208 recognise it.
2209
2210 The implementation uses the C<pvremove> command which refuses to
2211 wipe physical volumes that contain any volume groups, so you have
2212 to remove those first.");
2213
2214   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2215    [InitBasicFS, Always, TestOutput (
2216       [["set_e2label"; "/dev/sda1"; "testlabel"];
2217        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2218    "set the ext2/3/4 filesystem label",
2219    "\
2220 This sets the ext2/3/4 filesystem label of the filesystem on
2221 C<device> to C<label>.  Filesystem labels are limited to
2222 16 characters.
2223
2224 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2225 to return the existing label on a filesystem.");
2226
2227   ("get_e2label", (RString "label", [Device "device"]), 81, [DeprecatedBy "vfs_label"],
2228    [],
2229    "get the ext2/3/4 filesystem label",
2230    "\
2231 This returns the ext2/3/4 filesystem label of the filesystem on
2232 C<device>.");
2233
2234   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2235    (let uuid = uuidgen () in
2236     [InitBasicFS, Always, TestOutput (
2237        [["set_e2uuid"; "/dev/sda1"; uuid];
2238         ["get_e2uuid"; "/dev/sda1"]], uuid);
2239      InitBasicFS, Always, TestOutput (
2240        [["set_e2uuid"; "/dev/sda1"; "clear"];
2241         ["get_e2uuid"; "/dev/sda1"]], "");
2242      (* We can't predict what UUIDs will be, so just check the commands run. *)
2243      InitBasicFS, Always, TestRun (
2244        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2245      InitBasicFS, Always, TestRun (
2246        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2247    "set the ext2/3/4 filesystem UUID",
2248    "\
2249 This sets the ext2/3/4 filesystem UUID of the filesystem on
2250 C<device> to C<uuid>.  The format of the UUID and alternatives
2251 such as C<clear>, C<random> and C<time> are described in the
2252 L<tune2fs(8)> manpage.
2253
2254 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2255 to return the existing UUID of a filesystem.");
2256
2257   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [DeprecatedBy "vfs_uuid"],
2258    (* Regression test for RHBZ#597112. *)
2259    (let uuid = uuidgen () in
2260     [InitBasicFS, Always, TestOutput (
2261        [["mke2journal"; "1024"; "/dev/sdb"];
2262         ["set_e2uuid"; "/dev/sdb"; uuid];
2263         ["get_e2uuid"; "/dev/sdb"]], uuid)]),
2264    "get the ext2/3/4 filesystem UUID",
2265    "\
2266 This returns the ext2/3/4 filesystem UUID of the filesystem on
2267 C<device>.");
2268
2269   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [FishOutput FishOutputHexadecimal],
2270    [InitBasicFS, Always, TestOutputInt (
2271       [["umount"; "/dev/sda1"];
2272        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2273     InitBasicFS, Always, TestOutputInt (
2274       [["umount"; "/dev/sda1"];
2275        ["zero"; "/dev/sda1"];
2276        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2277    "run the filesystem checker",
2278    "\
2279 This runs the filesystem checker (fsck) on C<device> which
2280 should have filesystem type C<fstype>.
2281
2282 The returned integer is the status.  See L<fsck(8)> for the
2283 list of status codes from C<fsck>.
2284
2285 Notes:
2286
2287 =over 4
2288
2289 =item *
2290
2291 Multiple status codes can be summed together.
2292
2293 =item *
2294
2295 A non-zero return code can mean \"success\", for example if
2296 errors have been corrected on the filesystem.
2297
2298 =item *
2299
2300 Checking or repairing NTFS volumes is not supported
2301 (by linux-ntfs).
2302
2303 =back
2304
2305 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2306
2307   ("zero", (RErr, [Device "device"]), 85, [],
2308    [InitBasicFS, Always, TestOutput (
2309       [["umount"; "/dev/sda1"];
2310        ["zero"; "/dev/sda1"];
2311        ["file"; "/dev/sda1"]], "data")],
2312    "write zeroes to the device",
2313    "\
2314 This command writes zeroes over the first few blocks of C<device>.
2315
2316 How many blocks are zeroed isn't specified (but it's I<not> enough
2317 to securely wipe the device).  It should be sufficient to remove
2318 any partition tables, filesystem superblocks and so on.
2319
2320 See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
2321
2322   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2323    (* Test disabled because grub-install incompatible with virtio-blk driver.
2324     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2325     *)
2326    [InitBasicFS, Disabled, TestOutputTrue (
2327       [["grub_install"; "/"; "/dev/sda1"];
2328        ["is_dir"; "/boot"]])],
2329    "install GRUB",
2330    "\
2331 This command installs GRUB (the Grand Unified Bootloader) on
2332 C<device>, with the root directory being C<root>.");
2333
2334   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2335    [InitBasicFS, Always, TestOutput (
2336       [["write"; "/old"; "file content"];
2337        ["cp"; "/old"; "/new"];
2338        ["cat"; "/new"]], "file content");
2339     InitBasicFS, Always, TestOutputTrue (
2340       [["write"; "/old"; "file content"];
2341        ["cp"; "/old"; "/new"];
2342        ["is_file"; "/old"]]);
2343     InitBasicFS, Always, TestOutput (
2344       [["write"; "/old"; "file content"];
2345        ["mkdir"; "/dir"];
2346        ["cp"; "/old"; "/dir/new"];
2347        ["cat"; "/dir/new"]], "file content")],
2348    "copy a file",
2349    "\
2350 This copies a file from C<src> to C<dest> where C<dest> is
2351 either a destination filename or destination directory.");
2352
2353   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2354    [InitBasicFS, Always, TestOutput (
2355       [["mkdir"; "/olddir"];
2356        ["mkdir"; "/newdir"];
2357        ["write"; "/olddir/file"; "file content"];
2358        ["cp_a"; "/olddir"; "/newdir"];
2359        ["cat"; "/newdir/olddir/file"]], "file content")],
2360    "copy a file or directory recursively",
2361    "\
2362 This copies a file or directory from C<src> to C<dest>
2363 recursively using the C<cp -a> command.");
2364
2365   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2366    [InitBasicFS, Always, TestOutput (
2367       [["write"; "/old"; "file content"];
2368        ["mv"; "/old"; "/new"];
2369        ["cat"; "/new"]], "file content");
2370     InitBasicFS, Always, TestOutputFalse (
2371       [["write"; "/old"; "file content"];
2372        ["mv"; "/old"; "/new"];
2373        ["is_file"; "/old"]])],
2374    "move a file",
2375    "\
2376 This moves a file from C<src> to C<dest> where C<dest> is
2377 either a destination filename or destination directory.");
2378
2379   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2380    [InitEmpty, Always, TestRun (
2381       [["drop_caches"; "3"]])],
2382    "drop kernel page cache, dentries and inodes",
2383    "\
2384 This instructs the guest kernel to drop its page cache,
2385 and/or dentries and inode caches.  The parameter C<whattodrop>
2386 tells the kernel what precisely to drop, see
2387 L<http://linux-mm.org/Drop_Caches>
2388
2389 Setting C<whattodrop> to 3 should drop everything.
2390
2391 This automatically calls L<sync(2)> before the operation,
2392 so that the maximum guest memory is freed.");
2393
2394   ("dmesg", (RString "kmsgs", []), 91, [],
2395    [InitEmpty, Always, TestRun (
2396       [["dmesg"]])],
2397    "return kernel messages",
2398    "\
2399 This returns the kernel messages (C<dmesg> output) from
2400 the guest kernel.  This is sometimes useful for extended
2401 debugging of problems.
2402
2403 Another way to get the same information is to enable
2404 verbose messages with C<guestfs_set_verbose> or by setting
2405 the environment variable C<LIBGUESTFS_DEBUG=1> before
2406 running the program.");
2407
2408   ("ping_daemon", (RErr, []), 92, [],
2409    [InitEmpty, Always, TestRun (
2410       [["ping_daemon"]])],
2411    "ping the guest daemon",
2412    "\
2413 This is a test probe into the guestfs daemon running inside
2414 the qemu subprocess.  Calling this function checks that the
2415 daemon responds to the ping message, without affecting the daemon
2416 or attached block device(s) in any other way.");
2417
2418   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2419    [InitBasicFS, Always, TestOutputTrue (
2420       [["write"; "/file1"; "contents of a file"];
2421        ["cp"; "/file1"; "/file2"];
2422        ["equal"; "/file1"; "/file2"]]);
2423     InitBasicFS, Always, TestOutputFalse (
2424       [["write"; "/file1"; "contents of a file"];
2425        ["write"; "/file2"; "contents of another file"];
2426        ["equal"; "/file1"; "/file2"]]);
2427     InitBasicFS, Always, TestLastFail (
2428       [["equal"; "/file1"; "/file2"]])],
2429    "test if two files have equal contents",
2430    "\
2431 This compares the two files C<file1> and C<file2> and returns
2432 true if their content is exactly equal, or false otherwise.
2433
2434 The external L<cmp(1)> program is used for the comparison.");
2435
2436   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2437    [InitISOFS, Always, TestOutputList (
2438       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2439     InitISOFS, Always, TestOutputList (
2440       [["strings"; "/empty"]], []);
2441     (* Test for RHBZ#579608, absolute symbolic links. *)
2442     InitISOFS, Always, TestRun (
2443       [["strings"; "/abssymlink"]])],
2444    "print the printable strings in a file",
2445    "\
2446 This runs the L<strings(1)> command on a file and returns
2447 the list of printable strings found.");
2448
2449   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2450    [InitISOFS, Always, TestOutputList (
2451       [["strings_e"; "b"; "/known-5"]], []);
2452     InitBasicFS, Always, TestOutputList (
2453       [["write"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"];
2454        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2455    "print the printable strings in a file",
2456    "\
2457 This is like the C<guestfs_strings> command, but allows you to
2458 specify the encoding of strings that are looked for in
2459 the source file C<path>.
2460
2461 Allowed encodings are:
2462
2463 =over 4
2464
2465 =item s
2466
2467 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2468 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2469
2470 =item S
2471
2472 Single 8-bit-byte characters.
2473
2474 =item b
2475
2476 16-bit big endian strings such as those encoded in
2477 UTF-16BE or UCS-2BE.
2478
2479 =item l (lower case letter L)
2480
2481 16-bit little endian such as UTF-16LE and UCS-2LE.
2482 This is useful for examining binaries in Windows guests.
2483
2484 =item B
2485
2486 32-bit big endian such as UCS-4BE.
2487
2488 =item L
2489
2490 32-bit little endian such as UCS-4LE.
2491
2492 =back
2493
2494 The returned strings are transcoded to UTF-8.");
2495
2496   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2497    [InitISOFS, Always, TestOutput (
2498       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2499     (* Test for RHBZ#501888c2 regression which caused large hexdump
2500      * commands to segfault.
2501      *)
2502     InitISOFS, Always, TestRun (
2503       [["hexdump"; "/100krandom"]]);
2504     (* Test for RHBZ#579608, absolute symbolic links. *)
2505     InitISOFS, Always, TestRun (
2506       [["hexdump"; "/abssymlink"]])],
2507    "dump a file in hexadecimal",
2508    "\
2509 This runs C<hexdump -C> on the given C<path>.  The result is
2510 the human-readable, canonical hex dump of the file.");
2511
2512   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2513    [InitNone, Always, TestOutput (
2514       [["part_disk"; "/dev/sda"; "mbr"];
2515        ["mkfs"; "ext3"; "/dev/sda1"];
2516        ["mount_options"; ""; "/dev/sda1"; "/"];
2517        ["write"; "/new"; "test file"];
2518        ["umount"; "/dev/sda1"];
2519        ["zerofree"; "/dev/sda1"];
2520        ["mount_options"; ""; "/dev/sda1"; "/"];
2521        ["cat"; "/new"]], "test file")],
2522    "zero unused inodes and disk blocks on ext2/3 filesystem",
2523    "\
2524 This runs the I<zerofree> program on C<device>.  This program
2525 claims to zero unused inodes and disk blocks on an ext2/3
2526 filesystem, thus making it possible to compress the filesystem
2527 more effectively.
2528
2529 You should B<not> run this program if the filesystem is
2530 mounted.
2531
2532 It is possible that using this program can damage the filesystem
2533 or data on the filesystem.");
2534
2535   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2536    [],
2537    "resize an LVM physical volume",
2538    "\
2539 This resizes (expands or shrinks) an existing LVM physical
2540 volume to match the new size of the underlying device.");
2541
2542   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2543                        Int "cyls"; Int "heads"; Int "sectors";
2544                        String "line"]), 99, [DangerWillRobinson],
2545    [],
2546    "modify a single partition on a block device",
2547    "\
2548 This runs L<sfdisk(8)> option to modify just the single
2549 partition C<n> (note: C<n> counts from 1).
2550
2551 For other parameters, see C<guestfs_sfdisk>.  You should usually
2552 pass C<0> for the cyls/heads/sectors parameters.
2553
2554 See also: C<guestfs_part_add>");
2555
2556   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2557    [],
2558    "display the partition table",
2559    "\
2560 This displays the partition table on C<device>, in the
2561 human-readable output of the L<sfdisk(8)> command.  It is
2562 not intended to be parsed.
2563
2564 See also: C<guestfs_part_list>");
2565
2566   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2567    [],
2568    "display the kernel geometry",
2569    "\
2570 This displays the kernel's idea of the geometry of C<device>.
2571
2572 The result is in human-readable format, and not designed to
2573 be parsed.");
2574
2575   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2576    [],
2577    "display the disk geometry from the partition table",
2578    "\
2579 This displays the disk geometry of C<device> read from the
2580 partition table.  Especially in the case where the underlying
2581 block device has been resized, this can be different from the
2582 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2583
2584 The result is in human-readable format, and not designed to
2585 be parsed.");
2586
2587   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2588    [],
2589    "activate or deactivate all volume groups",
2590    "\
2591 This command activates or (if C<activate> is false) deactivates
2592 all logical volumes in all volume groups.
2593 If activated, then they are made known to the
2594 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2595 then those devices disappear.
2596
2597 This command is the same as running C<vgchange -a y|n>");
2598
2599   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2600    [],
2601    "activate or deactivate some volume groups",
2602    "\
2603 This command activates or (if C<activate> is false) deactivates
2604 all logical volumes in the listed volume groups C<volgroups>.
2605 If activated, then they are made known to the
2606 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2607 then those devices disappear.
2608
2609 This command is the same as running C<vgchange -a y|n volgroups...>
2610
2611 Note that if C<volgroups> is an empty list then B<all> volume groups
2612 are activated or deactivated.");
2613
2614   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2615    [InitNone, Always, TestOutput (
2616       [["part_disk"; "/dev/sda"; "mbr"];
2617        ["pvcreate"; "/dev/sda1"];
2618        ["vgcreate"; "VG"; "/dev/sda1"];
2619        ["lvcreate"; "LV"; "VG"; "10"];
2620        ["mkfs"; "ext2"; "/dev/VG/LV"];
2621        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2622        ["write"; "/new"; "test content"];
2623        ["umount"; "/"];
2624        ["lvresize"; "/dev/VG/LV"; "20"];
2625        ["e2fsck_f"; "/dev/VG/LV"];
2626        ["resize2fs"; "/dev/VG/LV"];
2627        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2628        ["cat"; "/new"]], "test content");
2629     InitNone, Always, TestRun (
2630       (* Make an LV smaller to test RHBZ#587484. *)
2631       [["part_disk"; "/dev/sda"; "mbr"];
2632        ["pvcreate"; "/dev/sda1"];
2633        ["vgcreate"; "VG"; "/dev/sda1"];
2634        ["lvcreate"; "LV"; "VG"; "20"];
2635        ["lvresize"; "/dev/VG/LV"; "10"]])],
2636    "resize an LVM logical volume",
2637    "\
2638 This resizes (expands or shrinks) an existing LVM logical
2639 volume to C<mbytes>.  When reducing, data in the reduced part
2640 is lost.");
2641
2642   ("resize2fs", (RErr, [Device "device"]), 106, [],
2643    [], (* lvresize tests this *)
2644    "resize an ext2, ext3 or ext4 filesystem",
2645    "\
2646 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2647 the underlying device.
2648
2649 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2650 on the C<device> before calling this command.  For unknown reasons
2651 C<resize2fs> sometimes gives an error about this and sometimes not.
2652 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2653 calling this function.");
2654
2655   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2656    [InitBasicFS, Always, TestOutputList (
2657       [["find"; "/"]], ["lost+found"]);
2658     InitBasicFS, Always, TestOutputList (
2659       [["touch"; "/a"];
2660        ["mkdir"; "/b"];
2661        ["touch"; "/b/c"];
2662        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2663     InitBasicFS, Always, TestOutputList (
2664       [["mkdir_p"; "/a/b/c"];
2665        ["touch"; "/a/b/c/d"];
2666        ["find"; "/a/b/"]], ["c"; "c/d"])],
2667    "find all files and directories",
2668    "\
2669 This command lists out all files and directories, recursively,
2670 starting at C<directory>.  It is essentially equivalent to
2671 running the shell command C<find directory -print> but some
2672 post-processing happens on the output, described below.
2673
2674 This returns a list of strings I<without any prefix>.  Thus
2675 if the directory structure was:
2676
2677  /tmp/a
2678  /tmp/b
2679  /tmp/c/d
2680
2681 then the returned list from C<guestfs_find> C</tmp> would be
2682 4 elements:
2683
2684  a
2685  b
2686  c
2687  c/d
2688
2689 If C<directory> is not a directory, then this command returns
2690 an error.
2691
2692 The returned list is sorted.
2693
2694 See also C<guestfs_find0>.");
2695
2696   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2697    [], (* lvresize tests this *)
2698    "check an ext2/ext3 filesystem",
2699    "\
2700 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2701 filesystem checker on C<device>, noninteractively (C<-p>),
2702 even if the filesystem appears to be clean (C<-f>).
2703
2704 This command is only needed because of C<guestfs_resize2fs>
2705 (q.v.).  Normally you should use C<guestfs_fsck>.");
2706
2707   ("sleep", (RErr, [Int "secs"]), 109, [],
2708    [InitNone, Always, TestRun (
2709       [["sleep"; "1"]])],
2710    "sleep for some seconds",
2711    "\
2712 Sleep for C<secs> seconds.");
2713
2714   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2715    [InitNone, Always, TestOutputInt (
2716       [["part_disk"; "/dev/sda"; "mbr"];
2717        ["mkfs"; "ntfs"; "/dev/sda1"];
2718        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2719     InitNone, Always, TestOutputInt (
2720       [["part_disk"; "/dev/sda"; "mbr"];
2721        ["mkfs"; "ext2"; "/dev/sda1"];
2722        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2723    "probe NTFS volume",
2724    "\
2725 This command runs the L<ntfs-3g.probe(8)> command which probes
2726 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2727 be mounted read-write, and some cannot be mounted at all).
2728
2729 C<rw> is a boolean flag.  Set it to true if you want to test
2730 if the volume can be mounted read-write.  Set it to false if
2731 you want to test if the volume can be mounted read-only.
2732
2733 The return value is an integer which C<0> if the operation
2734 would succeed, or some non-zero value documented in the
2735 L<ntfs-3g.probe(8)> manual page.");
2736
2737   ("sh", (RString "output", [String "command"]), 111, [],
2738    [], (* XXX needs tests *)
2739    "run a command via the shell",
2740    "\
2741 This call runs a command from the guest filesystem via the
2742 guest's C</bin/sh>.
2743
2744 This is like C<guestfs_command>, but passes the command to:
2745
2746  /bin/sh -c \"command\"
2747
2748 Depending on the guest's shell, this usually results in
2749 wildcards being expanded, shell expressions being interpolated
2750 and so on.
2751
2752 All the provisos about C<guestfs_command> apply to this call.");
2753
2754   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2755    [], (* XXX needs tests *)
2756    "run a command via the shell returning lines",
2757    "\
2758 This is the same as C<guestfs_sh>, but splits the result
2759 into a list of lines.
2760
2761 See also: C<guestfs_command_lines>");
2762
2763   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2764    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2765     * code in stubs.c, since all valid glob patterns must start with "/".
2766     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2767     *)
2768    [InitBasicFS, Always, TestOutputList (
2769       [["mkdir_p"; "/a/b/c"];
2770        ["touch"; "/a/b/c/d"];
2771        ["touch"; "/a/b/c/e"];
2772        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2773     InitBasicFS, Always, TestOutputList (
2774       [["mkdir_p"; "/a/b/c"];
2775        ["touch"; "/a/b/c/d"];
2776        ["touch"; "/a/b/c/e"];
2777        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2778     InitBasicFS, Always, TestOutputList (
2779       [["mkdir_p"; "/a/b/c"];
2780        ["touch"; "/a/b/c/d"];
2781        ["touch"; "/a/b/c/e"];
2782        ["glob_expand"; "/a/*/x/*"]], [])],
2783    "expand a wildcard path",
2784    "\
2785 This command searches for all the pathnames matching
2786 C<pattern> according to the wildcard expansion rules
2787 used by the shell.
2788
2789 If no paths match, then this returns an empty list
2790 (note: not an error).
2791
2792 It is just a wrapper around the C L<glob(3)> function
2793 with flags C<GLOB_MARK|GLOB_BRACE>.
2794 See that manual page for more details.");
2795
2796   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2797    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2798       [["scrub_device"; "/dev/sdc"]])],
2799    "scrub (securely wipe) a device",
2800    "\
2801 This command writes patterns over C<device> to make data retrieval
2802 more difficult.
2803
2804 It is an interface to the L<scrub(1)> program.  See that
2805 manual page for more details.");
2806
2807   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2808    [InitBasicFS, Always, TestRun (
2809       [["write"; "/file"; "content"];
2810        ["scrub_file"; "/file"]])],
2811    "scrub (securely wipe) a file",
2812    "\
2813 This command writes patterns over a file to make data retrieval
2814 more difficult.
2815
2816 The file is I<removed> after scrubbing.
2817
2818 It is an interface to the L<scrub(1)> program.  See that
2819 manual page for more details.");
2820
2821   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2822    [], (* XXX needs testing *)
2823    "scrub (securely wipe) free space",
2824    "\
2825 This command creates the directory C<dir> and then fills it
2826 with files until the filesystem is full, and scrubs the files
2827 as for C<guestfs_scrub_file>, and deletes them.
2828 The intention is to scrub any free space on the partition
2829 containing C<dir>.
2830
2831 It is an interface to the L<scrub(1)> program.  See that
2832 manual page for more details.");
2833
2834   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2835    [InitBasicFS, Always, TestRun (
2836       [["mkdir"; "/tmp"];
2837        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2838    "create a temporary directory",
2839    "\
2840 This command creates a temporary directory.  The
2841 C<template> parameter should be a full pathname for the
2842 temporary directory name with the final six characters being
2843 \"XXXXXX\".
2844
2845 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2846 the second one being suitable for Windows filesystems.
2847
2848 The name of the temporary directory that was created
2849 is returned.
2850
2851 The temporary directory is created with mode 0700
2852 and is owned by root.
2853
2854 The caller is responsible for deleting the temporary
2855 directory and its contents after use.
2856
2857 See also: L<mkdtemp(3)>");
2858
2859   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2860    [InitISOFS, Always, TestOutputInt (
2861       [["wc_l"; "/10klines"]], 10000);
2862     (* Test for RHBZ#579608, absolute symbolic links. *)
2863     InitISOFS, Always, TestOutputInt (
2864       [["wc_l"; "/abssymlink"]], 10000)],
2865    "count lines in a file",
2866    "\
2867 This command counts the lines in a file, using the
2868 C<wc -l> external command.");
2869
2870   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2871    [InitISOFS, Always, TestOutputInt (
2872       [["wc_w"; "/10klines"]], 10000)],
2873    "count words in a file",
2874    "\
2875 This command counts the words in a file, using the
2876 C<wc -w> external command.");
2877
2878   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2879    [InitISOFS, Always, TestOutputInt (
2880       [["wc_c"; "/100kallspaces"]], 102400)],
2881    "count characters in a file",
2882    "\
2883 This command counts the characters in a file, using the
2884 C<wc -c> external command.");
2885
2886   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2887    [InitISOFS, Always, TestOutputList (
2888       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"]);
2889     (* Test for RHBZ#579608, absolute symbolic links. *)
2890     InitISOFS, Always, TestOutputList (
2891       [["head"; "/abssymlink"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2892    "return first 10 lines of a file",
2893    "\
2894 This command returns up to the first 10 lines of a file as
2895 a list of strings.");
2896
2897   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2898    [InitISOFS, Always, TestOutputList (
2899       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2900     InitISOFS, Always, TestOutputList (
2901       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2902     InitISOFS, Always, TestOutputList (
2903       [["head_n"; "0"; "/10klines"]], [])],
2904    "return first N lines of a file",
2905    "\
2906 If the parameter C<nrlines> is a positive number, this returns the first
2907 C<nrlines> lines of the file C<path>.
2908
2909 If the parameter C<nrlines> is a negative number, this returns lines
2910 from the file C<path>, excluding the last C<nrlines> lines.
2911
2912 If the parameter C<nrlines> is zero, this returns an empty list.");
2913
2914   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2915    [InitISOFS, Always, TestOutputList (
2916       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2917    "return last 10 lines of a file",
2918    "\
2919 This command returns up to the last 10 lines of a file as
2920 a list of strings.");
2921
2922   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2923    [InitISOFS, Always, TestOutputList (
2924       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2925     InitISOFS, Always, TestOutputList (
2926       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2927     InitISOFS, Always, TestOutputList (
2928       [["tail_n"; "0"; "/10klines"]], [])],
2929    "return last N lines of a file",
2930    "\
2931 If the parameter C<nrlines> is a positive number, this returns the last
2932 C<nrlines> lines of the file C<path>.
2933
2934 If the parameter C<nrlines> is a negative number, this returns lines
2935 from the file C<path>, starting with the C<-nrlines>th line.
2936
2937 If the parameter C<nrlines> is zero, this returns an empty list.");
2938
2939   ("df", (RString "output", []), 125, [],
2940    [], (* XXX Tricky to test because it depends on the exact format
2941         * of the 'df' command and other imponderables.
2942         *)
2943    "report file system disk space usage",
2944    "\
2945 This command runs the C<df> command to report disk space used.
2946
2947 This command is mostly useful for interactive sessions.  It
2948 is I<not> intended that you try to parse the output string.
2949 Use C<statvfs> from programs.");
2950
2951   ("df_h", (RString "output", []), 126, [],
2952    [], (* XXX Tricky to test because it depends on the exact format
2953         * of the 'df' command and other imponderables.
2954         *)
2955    "report file system disk space usage (human readable)",
2956    "\
2957 This command runs the C<df -h> command to report disk space used
2958 in human-readable format.
2959
2960 This command is mostly useful for interactive sessions.  It
2961 is I<not> intended that you try to parse the output string.
2962 Use C<statvfs> from programs.");
2963
2964   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2965    [InitISOFS, Always, TestOutputInt (
2966       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2967    "estimate file space usage",
2968    "\
2969 This command runs the C<du -s> command to estimate file space
2970 usage for C<path>.
2971
2972 C<path> can be a file or a directory.  If C<path> is a directory
2973 then the estimate includes the contents of the directory and all
2974 subdirectories (recursively).
2975
2976 The result is the estimated size in I<kilobytes>
2977 (ie. units of 1024 bytes).");
2978
2979   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2980    [InitISOFS, Always, TestOutputList (
2981       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2982    "list files in an initrd",
2983    "\
2984 This command lists out files contained in an initrd.
2985
2986 The files are listed without any initial C</> character.  The
2987 files are listed in the order they appear (not necessarily
2988 alphabetical).  Directory names are listed as separate items.
2989
2990 Old Linux kernels (2.4 and earlier) used a compressed ext2
2991 filesystem as initrd.  We I<only> support the newer initramfs
2992 format (compressed cpio files).");
2993
2994   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2995    [],
2996    "mount a file using the loop device",
2997    "\
2998 This command lets you mount C<file> (a filesystem image
2999 in a file) on a mount point.  It is entirely equivalent to
3000 the command C<mount -o loop file mountpoint>.");
3001
3002   ("mkswap", (RErr, [Device "device"]), 130, [],
3003    [InitEmpty, Always, TestRun (
3004       [["part_disk"; "/dev/sda"; "mbr"];
3005        ["mkswap"; "/dev/sda1"]])],
3006    "create a swap partition",
3007    "\
3008 Create a swap partition on C<device>.");
3009
3010   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3011    [InitEmpty, Always, TestRun (
3012       [["part_disk"; "/dev/sda"; "mbr"];
3013        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3014    "create a swap partition with a label",
3015    "\
3016 Create a swap partition on C<device> with label C<label>.
3017
3018 Note that you cannot attach a swap label to a block device
3019 (eg. C</dev/sda>), just to a partition.  This appears to be
3020 a limitation of the kernel or swap tools.");
3021
3022   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3023    (let uuid = uuidgen () in
3024     [InitEmpty, Always, TestRun (
3025        [["part_disk"; "/dev/sda"; "mbr"];
3026         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3027    "create a swap partition with an explicit UUID",
3028    "\
3029 Create a swap partition on C<device> with UUID C<uuid>.");
3030
3031   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3032    [InitBasicFS, Always, TestOutputStruct (
3033       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3034        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3035        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3036     InitBasicFS, Always, TestOutputStruct (
3037       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3038        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3039    "make block, character or FIFO devices",
3040    "\
3041 This call creates block or character special devices, or
3042 named pipes (FIFOs).
3043
3044 The C<mode> parameter should be the mode, using the standard
3045 constants.  C<devmajor> and C<devminor> are the
3046 device major and minor numbers, only used when creating block
3047 and character special devices.
3048
3049 Note that, just like L<mknod(2)>, the mode must be bitwise
3050 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3051 just creates a regular file).  These constants are
3052 available in the standard Linux header files, or you can use
3053 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3054 which are wrappers around this command which bitwise OR
3055 in the appropriate constant for you.
3056
3057 The mode actually set is affected by the umask.");
3058
3059   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3060    [InitBasicFS, Always, TestOutputStruct (
3061       [["mkfifo"; "0o777"; "/node"];
3062        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3063    "make FIFO (named pipe)",
3064    "\
3065 This call creates a FIFO (named pipe) called C<path> with
3066 mode C<mode>.  It is just a convenient wrapper around
3067 C<guestfs_mknod>.
3068
3069 The mode actually set is affected by the umask.");
3070
3071   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3072    [InitBasicFS, Always, TestOutputStruct (
3073       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3074        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3075    "make block device node",
3076    "\
3077 This call creates a block device node called C<path> with
3078 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3079 It is just a convenient wrapper around C<guestfs_mknod>.
3080
3081 The mode actually set is affected by the umask.");
3082
3083   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3084    [InitBasicFS, Always, TestOutputStruct (
3085       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3086        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3087    "make char device node",
3088    "\
3089 This call creates a char device node called C<path> with
3090 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3091 It is just a convenient wrapper around C<guestfs_mknod>.
3092
3093 The mode actually set is affected by the umask.");
3094
3095   ("umask", (RInt "oldmask", [Int "mask"]), 137, [FishOutput FishOutputOctal],
3096    [InitEmpty, Always, TestOutputInt (
3097       [["umask"; "0o22"]], 0o22)],
3098    "set file mode creation mask (umask)",
3099    "\
3100 This function sets the mask used for creating new files and
3101 device nodes to C<mask & 0777>.
3102
3103 Typical umask values would be C<022> which creates new files
3104 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3105 C<002> which creates new files with permissions like
3106 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3107
3108 The default umask is C<022>.  This is important because it
3109 means that directories and device nodes will be created with
3110 C<0644> or C<0755> mode even if you specify C<0777>.
3111
3112 See also C<guestfs_get_umask>,
3113 L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3114
3115 This call returns the previous umask.");
3116
3117   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3118    [],
3119    "read directories entries",
3120    "\
3121 This returns the list of directory entries in directory C<dir>.
3122
3123 All entries in the directory are returned, including C<.> and
3124 C<..>.  The entries are I<not> sorted, but returned in the same
3125 order as the underlying filesystem.
3126
3127 Also this call returns basic file type information about each
3128 file.  The C<ftyp> field will contain one of the following characters:
3129
3130 =over 4
3131
3132 =item 'b'
3133
3134 Block special
3135
3136 =item 'c'
3137
3138 Char special
3139
3140 =item 'd'
3141
3142 Directory
3143
3144 =item 'f'
3145
3146 FIFO (named pipe)
3147
3148 =item 'l'
3149
3150 Symbolic link
3151
3152 =item 'r'
3153
3154 Regular file
3155
3156 =item 's'
3157
3158 Socket
3159
3160 =item 'u'
3161
3162 Unknown file type
3163
3164 =item '?'
3165
3166 The L<readdir(3)> call returned a C<d_type> field with an
3167 unexpected value
3168
3169 =back
3170
3171 This function is primarily intended for use by programs.  To
3172 get a simple list of names, use C<guestfs_ls>.  To get a printable
3173 directory for human consumption, use C<guestfs_ll>.");
3174
3175   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3176    [],
3177    "create partitions on a block device",
3178    "\
3179 This is a simplified interface to the C<guestfs_sfdisk>
3180 command, where partition sizes are specified in megabytes
3181 only (rounded to the nearest cylinder) and you don't need
3182 to specify the cyls, heads and sectors parameters which
3183 were rarely if ever used anyway.
3184
3185 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3186 and C<guestfs_part_disk>");
3187
3188   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3189    [],
3190    "determine file type inside a compressed file",
3191    "\
3192 This command runs C<file> after first decompressing C<path>
3193 using C<method>.
3194
3195 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3196
3197 Since 1.0.63, use C<guestfs_file> instead which can now
3198 process compressed files.");
3199
3200   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3201    [],
3202    "list extended attributes of a file or directory",
3203    "\
3204 This call lists the extended attributes of the file or directory
3205 C<path>.
3206
3207 At the system call level, this is a combination of the
3208 L<listxattr(2)> and L<getxattr(2)> calls.
3209
3210 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3211
3212   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3213    [],
3214    "list extended attributes of a file or directory",
3215    "\
3216 This is the same as C<guestfs_getxattrs>, but if C<path>
3217 is a symbolic link, then it returns the extended attributes
3218 of the link itself.");
3219
3220   ("setxattr", (RErr, [String "xattr";
3221                        String "val"; Int "vallen"; (* will be BufferIn *)
3222                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3223    [],
3224    "set extended attribute of a file or directory",
3225    "\
3226 This call sets the extended attribute named C<xattr>
3227 of the file C<path> to the value C<val> (of length C<vallen>).
3228 The value is arbitrary 8 bit data.
3229
3230 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3231
3232   ("lsetxattr", (RErr, [String "xattr";
3233                         String "val"; Int "vallen"; (* will be BufferIn *)
3234                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3235    [],
3236    "set extended attribute of a file or directory",
3237    "\
3238 This is the same as C<guestfs_setxattr>, but if C<path>
3239 is a symbolic link, then it sets an extended attribute
3240 of the link itself.");
3241
3242   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3243    [],
3244    "remove extended attribute of a file or directory",
3245    "\
3246 This call removes the extended attribute named C<xattr>
3247 of the file C<path>.
3248
3249 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3250
3251   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3252    [],
3253    "remove extended attribute of a file or directory",
3254    "\
3255 This is the same as C<guestfs_removexattr>, but if C<path>
3256 is a symbolic link, then it removes an extended attribute
3257 of the link itself.");
3258
3259   ("mountpoints", (RHashtable "mps", []), 147, [],
3260    [],
3261    "show mountpoints",
3262    "\
3263 This call is similar to C<guestfs_mounts>.  That call returns
3264 a list of devices.  This one returns a hash table (map) of
3265 device name to directory where the device is mounted.");
3266
3267   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3268    (* This is a special case: while you would expect a parameter
3269     * of type "Pathname", that doesn't work, because it implies
3270     * NEED_ROOT in the generated calling code in stubs.c, and
3271     * this function cannot use NEED_ROOT.
3272     *)
3273    [],
3274    "create a mountpoint",
3275    "\
3276 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3277 specialized calls that can be used to create extra mountpoints
3278 before mounting the first filesystem.
3279
3280 These calls are I<only> necessary in some very limited circumstances,
3281 mainly the case where you want to mount a mix of unrelated and/or
3282 read-only filesystems together.
3283
3284 For example, live CDs often contain a \"Russian doll\" nest of
3285 filesystems, an ISO outer layer, with a squashfs image inside, with
3286 an ext2/3 image inside that.  You can unpack this as follows
3287 in guestfish:
3288
3289  add-ro Fedora-11-i686-Live.iso
3290  run
3291  mkmountpoint /cd
3292  mkmountpoint /squash
3293  mkmountpoint /ext3
3294  mount /dev/sda /cd
3295  mount-loop /cd/LiveOS/squashfs.img /squash
3296  mount-loop /squash/LiveOS/ext3fs.img /ext3
3297
3298 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3299
3300   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3301    [],
3302    "remove a mountpoint",
3303    "\
3304 This calls removes a mountpoint that was previously created
3305 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3306 for full details.");
3307
3308   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3309    [InitISOFS, Always, TestOutputBuffer (
3310       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3311     (* Test various near large, large and too large files (RHBZ#589039). *)
3312     InitBasicFS, Always, TestLastFail (
3313       [["touch"; "/a"];
3314        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3315        ["read_file"; "/a"]]);
3316     InitBasicFS, Always, TestLastFail (
3317       [["touch"; "/a"];
3318        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3319        ["read_file"; "/a"]]);
3320     InitBasicFS, Always, TestLastFail (
3321       [["touch"; "/a"];
3322        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3323        ["read_file"; "/a"]])],
3324    "read a file",
3325    "\
3326 This calls returns the contents of the file C<path> as a
3327 buffer.
3328
3329 Unlike C<guestfs_cat>, this function can correctly
3330 handle files that contain embedded ASCII NUL characters.
3331 However unlike C<guestfs_download>, this function is limited
3332 in the total size of file that can be handled.");
3333
3334   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3335    [InitISOFS, Always, TestOutputList (
3336       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3337     InitISOFS, Always, TestOutputList (
3338       [["grep"; "nomatch"; "/test-grep.txt"]], []);
3339     (* Test for RHBZ#579608, absolute symbolic links. *)
3340     InitISOFS, Always, TestOutputList (
3341       [["grep"; "nomatch"; "/abssymlink"]], [])],
3342    "return lines matching a pattern",
3343    "\
3344 This calls the external C<grep> program and returns the
3345 matching lines.");
3346
3347   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3348    [InitISOFS, Always, TestOutputList (
3349       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3350    "return lines matching a pattern",
3351    "\
3352 This calls the external C<egrep> program and returns the
3353 matching lines.");
3354
3355   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3356    [InitISOFS, Always, TestOutputList (
3357       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3358    "return lines matching a pattern",
3359    "\
3360 This calls the external C<fgrep> program and returns the
3361 matching lines.");
3362
3363   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3364    [InitISOFS, Always, TestOutputList (
3365       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3366    "return lines matching a pattern",
3367    "\
3368 This calls the external C<grep -i> program and returns the
3369 matching lines.");
3370
3371   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3372    [InitISOFS, Always, TestOutputList (
3373       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3374    "return lines matching a pattern",
3375    "\
3376 This calls the external C<egrep -i> program and returns the
3377 matching lines.");
3378
3379   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3380    [InitISOFS, Always, TestOutputList (
3381       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3382    "return lines matching a pattern",
3383    "\
3384 This calls the external C<fgrep -i> program and returns the
3385 matching lines.");
3386
3387   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3388    [InitISOFS, Always, TestOutputList (
3389       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3390    "return lines matching a pattern",
3391    "\
3392 This calls the external C<zgrep> program and returns the
3393 matching lines.");
3394
3395   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3396    [InitISOFS, Always, TestOutputList (
3397       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3398    "return lines matching a pattern",
3399    "\
3400 This calls the external C<zegrep> program and returns the
3401 matching lines.");
3402
3403   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3404    [InitISOFS, Always, TestOutputList (
3405       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3406    "return lines matching a pattern",
3407    "\
3408 This calls the external C<zfgrep> program and returns the
3409 matching lines.");
3410
3411   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3412    [InitISOFS, Always, TestOutputList (
3413       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3414    "return lines matching a pattern",
3415    "\
3416 This calls the external C<zgrep -i> program and returns the
3417 matching lines.");
3418
3419   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3420    [InitISOFS, Always, TestOutputList (
3421       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3422    "return lines matching a pattern",
3423    "\
3424 This calls the external C<zegrep -i> program and returns the
3425 matching lines.");
3426
3427   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3428    [InitISOFS, Always, TestOutputList (
3429       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3430    "return lines matching a pattern",
3431    "\
3432 This calls the external C<zfgrep -i> program and returns the
3433 matching lines.");
3434
3435   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3436    [InitISOFS, Always, TestOutput (
3437       [["realpath"; "/../directory"]], "/directory")],
3438    "canonicalized absolute pathname",
3439    "\
3440 Return the canonicalized absolute pathname of C<path>.  The
3441 returned path has no C<.>, C<..> or symbolic link path elements.");
3442
3443   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3444    [InitBasicFS, Always, TestOutputStruct (
3445       [["touch"; "/a"];
3446        ["ln"; "/a"; "/b"];
3447        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3448    "create a hard link",
3449    "\
3450 This command creates a hard link using the C<ln> command.");
3451
3452   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3453    [InitBasicFS, Always, TestOutputStruct (
3454       [["touch"; "/a"];
3455        ["touch"; "/b"];
3456        ["ln_f"; "/a"; "/b"];
3457        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3458    "create a hard link",
3459    "\
3460 This command creates a hard link using the C<ln -f> command.
3461 The C<-f> option removes the link (C<linkname>) if it exists already.");
3462
3463   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3464    [InitBasicFS, Always, TestOutputStruct (
3465       [["touch"; "/a"];
3466        ["ln_s"; "a"; "/b"];
3467        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3468    "create a symbolic link",
3469    "\
3470 This command creates a symbolic link using the C<ln -s> command.");
3471
3472   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3473    [InitBasicFS, Always, TestOutput (
3474       [["mkdir_p"; "/a/b"];
3475        ["touch"; "/a/b/c"];
3476        ["ln_sf"; "../d"; "/a/b/c"];
3477        ["readlink"; "/a/b/c"]], "../d")],
3478    "create a symbolic link",
3479    "\
3480 This command creates a symbolic link using the C<ln -sf> command,
3481 The C<-f> option removes the link (C<linkname>) if it exists already.");
3482
3483   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3484    [] (* XXX tested above *),
3485    "read the target of a symbolic link",
3486    "\
3487 This command reads the target of a symbolic link.");
3488
3489   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [DeprecatedBy "fallocate64"],
3490    [InitBasicFS, Always, TestOutputStruct (
3491       [["fallocate"; "/a"; "1000000"];
3492        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3493    "preallocate a file in the guest filesystem",
3494    "\
3495 This command preallocates a file (containing zero bytes) named
3496 C<path> of size C<len> bytes.  If the file exists already, it
3497 is overwritten.
3498
3499 Do not confuse this with the guestfish-specific
3500 C<alloc> command which allocates a file in the host and
3501 attaches it as a device.");
3502
3503   ("swapon_device", (RErr, [Device "device"]), 170, [],
3504    [InitPartition, Always, TestRun (
3505       [["mkswap"; "/dev/sda1"];
3506        ["swapon_device"; "/dev/sda1"];
3507        ["swapoff_device"; "/dev/sda1"]])],
3508    "enable swap on device",
3509    "\
3510 This command enables the libguestfs appliance to use the
3511 swap device or partition named C<device>.  The increased
3512 memory is made available for all commands, for example
3513 those run using C<guestfs_command> or C<guestfs_sh>.
3514
3515 Note that you should not swap to existing guest swap
3516 partitions unless you know what you are doing.  They may
3517 contain hibernation information, or other information that
3518 the guest doesn't want you to trash.  You also risk leaking
3519 information about the host to the guest this way.  Instead,
3520 attach a new host device to the guest and swap on that.");
3521
3522   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3523    [], (* XXX tested by swapon_device *)
3524    "disable swap on device",
3525    "\
3526 This command disables the libguestfs appliance swap
3527 device or partition named C<device>.
3528 See C<guestfs_swapon_device>.");
3529
3530   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3531    [InitBasicFS, Always, TestRun (
3532       [["fallocate"; "/swap"; "8388608"];
3533        ["mkswap_file"; "/swap"];
3534        ["swapon_file"; "/swap"];
3535        ["swapoff_file"; "/swap"]])],
3536    "enable swap on file",
3537    "\
3538 This command enables swap to a file.
3539 See C<guestfs_swapon_device> for other notes.");
3540
3541   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3542    [], (* XXX tested by swapon_file *)
3543    "disable swap on file",
3544    "\
3545 This command disables the libguestfs appliance swap on file.");
3546
3547   ("swapon_label", (RErr, [String "label"]), 174, [],
3548    [InitEmpty, Always, TestRun (
3549       [["part_disk"; "/dev/sdb"; "mbr"];
3550        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3551        ["swapon_label"; "swapit"];
3552        ["swapoff_label"; "swapit"];
3553        ["zero"; "/dev/sdb"];
3554        ["blockdev_rereadpt"; "/dev/sdb"]])],
3555    "enable swap on labeled swap partition",
3556    "\
3557 This command enables swap to a labeled swap partition.
3558 See C<guestfs_swapon_device> for other notes.");
3559
3560   ("swapoff_label", (RErr, [String "label"]), 175, [],
3561    [], (* XXX tested by swapon_label *)
3562    "disable swap on labeled swap partition",
3563    "\
3564 This command disables the libguestfs appliance swap on
3565 labeled swap partition.");
3566
3567   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3568    (let uuid = uuidgen () in
3569     [InitEmpty, Always, TestRun (
3570        [["mkswap_U"; uuid; "/dev/sdb"];
3571         ["swapon_uuid"; uuid];
3572         ["swapoff_uuid"; uuid]])]),
3573    "enable swap on swap partition by UUID",
3574    "\
3575 This command enables swap to a swap partition with the given UUID.
3576 See C<guestfs_swapon_device> for other notes.");
3577
3578   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3579    [], (* XXX tested by swapon_uuid *)
3580    "disable swap on swap partition by UUID",
3581    "\
3582 This command disables the libguestfs appliance swap partition
3583 with the given UUID.");
3584
3585   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3586    [InitBasicFS, Always, TestRun (
3587       [["fallocate"; "/swap"; "8388608"];
3588        ["mkswap_file"; "/swap"]])],
3589    "create a swap file",
3590    "\
3591 Create a swap file.
3592
3593 This command just writes a swap file signature to an existing
3594 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3595
3596   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3597    [InitISOFS, Always, TestRun (
3598       [["inotify_init"; "0"]])],
3599    "create an inotify handle",
3600    "\
3601 This command creates a new inotify handle.
3602 The inotify subsystem can be used to notify events which happen to
3603 objects in the guest filesystem.
3604
3605 C<maxevents> is the maximum number of events which will be
3606 queued up between calls to C<guestfs_inotify_read> or
3607 C<guestfs_inotify_files>.
3608 If this is passed as C<0>, then the kernel (or previously set)
3609 default is used.  For Linux 2.6.29 the default was 16384 events.
3610 Beyond this limit, the kernel throws away events, but records
3611 the fact that it threw them away by setting a flag
3612 C<IN_Q_OVERFLOW> in the returned structure list (see
3613 C<guestfs_inotify_read>).
3614
3615 Before any events are generated, you have to add some
3616 watches to the internal watch list.  See:
3617 C<guestfs_inotify_add_watch>,
3618 C<guestfs_inotify_rm_watch> and
3619 C<guestfs_inotify_watch_all>.
3620
3621 Queued up events should be read periodically by calling
3622 C<guestfs_inotify_read>
3623 (or C<guestfs_inotify_files> which is just a helpful
3624 wrapper around C<guestfs_inotify_read>).  If you don't
3625 read the events out often enough then you risk the internal
3626 queue overflowing.
3627
3628 The handle should be closed after use by calling
3629 C<guestfs_inotify_close>.  This also removes any
3630 watches automatically.
3631
3632 See also L<inotify(7)> for an overview of the inotify interface
3633 as exposed by the Linux kernel, which is roughly what we expose
3634 via libguestfs.  Note that there is one global inotify handle
3635 per libguestfs instance.");
3636
3637   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3638    [InitBasicFS, Always, TestOutputList (
3639       [["inotify_init"; "0"];
3640        ["inotify_add_watch"; "/"; "1073741823"];
3641        ["touch"; "/a"];
3642        ["touch"; "/b"];
3643        ["inotify_files"]], ["a"; "b"])],
3644    "add an inotify watch",
3645    "\
3646 Watch C<path> for the events listed in C<mask>.
3647
3648 Note that if C<path> is a directory then events within that
3649 directory are watched, but this does I<not> happen recursively
3650 (in subdirectories).
3651
3652 Note for non-C or non-Linux callers: the inotify events are
3653 defined by the Linux kernel ABI and are listed in
3654 C</usr/include/sys/inotify.h>.");
3655
3656   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3657    [],
3658    "remove an inotify watch",
3659    "\
3660 Remove a previously defined inotify watch.
3661 See C<guestfs_inotify_add_watch>.");
3662
3663   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3664    [],
3665    "return list of inotify events",
3666    "\
3667 Return the complete queue of events that have happened
3668 since the previous read call.
3669
3670 If no events have happened, this returns an empty list.
3671
3672 I<Note>: In order to make sure that all events have been
3673 read, you must call this function repeatedly until it
3674 returns an empty list.  The reason is that the call will
3675 read events up to the maximum appliance-to-host message
3676 size and leave remaining events in the queue.");
3677
3678   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3679    [],
3680    "return list of watched files that had events",
3681    "\
3682 This function is a helpful wrapper around C<guestfs_inotify_read>
3683 which just returns a list of pathnames of objects that were
3684 touched.  The returned pathnames are sorted and deduplicated.");
3685
3686   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3687    [],
3688    "close the inotify handle",
3689    "\
3690 This closes the inotify handle which was previously
3691 opened by inotify_init.  It removes all watches, throws
3692 away any pending events, and deallocates all resources.");
3693
3694   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3695    [],
3696    "set SELinux security context",
3697    "\
3698 This sets the SELinux security context of the daemon
3699 to the string C<context>.
3700
3701 See the documentation about SELINUX in L<guestfs(3)>.");
3702
3703   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3704    [],
3705    "get SELinux security context",
3706    "\
3707 This gets the SELinux security context of the daemon.
3708
3709 See the documentation about SELINUX in L<guestfs(3)>,
3710 and C<guestfs_setcon>");
3711
3712   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3713    [InitEmpty, Always, TestOutput (
3714       [["part_disk"; "/dev/sda"; "mbr"];
3715        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3716        ["mount_options"; ""; "/dev/sda1"; "/"];
3717        ["write"; "/new"; "new file contents"];
3718        ["cat"; "/new"]], "new file contents")],
3719    "make a filesystem with block size",
3720    "\
3721 This call is similar to C<guestfs_mkfs>, but it allows you to
3722 control the block size of the resulting filesystem.  Supported
3723 block sizes depend on the filesystem type, but typically they
3724 are C<1024>, C<2048> or C<4096> only.");
3725
3726   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3727    [InitEmpty, Always, TestOutput (
3728       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3729        ["mke2journal"; "4096"; "/dev/sda1"];
3730        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3731        ["mount_options"; ""; "/dev/sda2"; "/"];
3732        ["write"; "/new"; "new file contents"];
3733        ["cat"; "/new"]], "new file contents")],
3734    "make ext2/3/4 external journal",
3735    "\
3736 This creates an ext2 external journal on C<device>.  It is equivalent
3737 to the command:
3738
3739  mke2fs -O journal_dev -b blocksize device");
3740
3741   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3742    [InitEmpty, Always, TestOutput (
3743       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3744        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3745        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3746        ["mount_options"; ""; "/dev/sda2"; "/"];
3747        ["write"; "/new"; "new file contents"];
3748        ["cat"; "/new"]], "new file contents")],
3749    "make ext2/3/4 external journal with label",
3750    "\
3751 This creates an ext2 external journal on C<device> with label C<label>.");
3752
3753   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3754    (let uuid = uuidgen () in
3755     [InitEmpty, Always, TestOutput (
3756        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3757         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3758         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3759         ["mount_options"; ""; "/dev/sda2"; "/"];
3760         ["write"; "/new"; "new file contents"];
3761         ["cat"; "/new"]], "new file contents")]),
3762    "make ext2/3/4 external journal with UUID",
3763    "\
3764 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3765
3766   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3767    [],
3768    "make ext2/3/4 filesystem with external journal",
3769    "\
3770 This creates an ext2/3/4 filesystem on C<device> with
3771 an external journal on C<journal>.  It is equivalent
3772 to the command:
3773
3774  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3775
3776 See also C<guestfs_mke2journal>.");
3777
3778   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3779    [],
3780    "make ext2/3/4 filesystem with external journal",
3781    "\
3782 This creates an ext2/3/4 filesystem on C<device> with
3783 an external journal on the journal labeled C<label>.
3784
3785 See also C<guestfs_mke2journal_L>.");
3786
3787   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3788    [],
3789    "make ext2/3/4 filesystem with external journal",
3790    "\
3791 This creates an ext2/3/4 filesystem on C<device> with
3792 an external journal on the journal with UUID C<uuid>.
3793
3794 See also C<guestfs_mke2journal_U>.");
3795
3796   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3797    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3798    "load a kernel module",
3799    "\
3800 This loads a kernel module in the appliance.
3801
3802 The kernel module must have been whitelisted when libguestfs
3803 was built (see C<appliance/kmod.whitelist.in> in the source).");
3804
3805   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3806    [InitNone, Always, TestOutput (
3807       [["echo_daemon"; "This is a test"]], "This is a test"
3808     )],
3809    "echo arguments back to the client",
3810    "\
3811 This command concatenates the list of C<words> passed with single spaces
3812 between them and returns the resulting string.
3813
3814 You can use this command to test the connection through to the daemon.
3815
3816 See also C<guestfs_ping_daemon>.");
3817
3818   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3819    [], (* There is a regression test for this. *)
3820    "find all files and directories, returning NUL-separated list",
3821    "\
3822 This command lists out all files and directories, recursively,
3823 starting at C<directory>, placing the resulting list in the
3824 external file called C<files>.
3825
3826 This command works the same way as C<guestfs_find> with the
3827 following exceptions:
3828
3829 =over 4
3830
3831 =item *
3832
3833 The resulting list is written to an external file.
3834
3835 =item *
3836
3837 Items (filenames) in the result are separated
3838 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3839
3840 =item *
3841
3842 This command is not limited in the number of names that it
3843 can return.
3844
3845 =item *
3846
3847 The result list is not sorted.
3848
3849 =back");
3850
3851   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3852    [InitISOFS, Always, TestOutput (
3853       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3854     InitISOFS, Always, TestOutput (
3855       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3856     InitISOFS, Always, TestOutput (
3857       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3858     InitISOFS, Always, TestLastFail (
3859       [["case_sensitive_path"; "/Known-1/"]]);
3860     InitBasicFS, Always, TestOutput (
3861       [["mkdir"; "/a"];
3862        ["mkdir"; "/a/bbb"];
3863        ["touch"; "/a/bbb/c"];
3864        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3865     InitBasicFS, Always, TestOutput (
3866       [["mkdir"; "/a"];
3867        ["mkdir"; "/a/bbb"];
3868        ["touch"; "/a/bbb/c"];
3869        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3870     InitBasicFS, Always, TestLastFail (
3871       [["mkdir"; "/a"];
3872        ["mkdir"; "/a/bbb"];
3873        ["touch"; "/a/bbb/c"];
3874        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3875    "return true path on case-insensitive filesystem",
3876    "\
3877 This can be used to resolve case insensitive paths on
3878 a filesystem which is case sensitive.  The use case is
3879 to resolve paths which you have read from Windows configuration
3880 files or the Windows Registry, to the true path.
3881
3882 The command handles a peculiarity of the Linux ntfs-3g
3883 filesystem driver (and probably others), which is that although
3884 the underlying filesystem is case-insensitive, the driver
3885 exports the filesystem to Linux as case-sensitive.
3886
3887 One consequence of this is that special directories such
3888 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3889 (or other things) depending on the precise details of how
3890 they were created.  In Windows itself this would not be
3891 a problem.
3892
3893 Bug or feature?  You decide:
3894 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3895
3896 This function resolves the true case of each element in the
3897 path and returns the case-sensitive path.
3898
3899 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3900 might return C<\"/WINDOWS/system32\"> (the exact return value
3901 would depend on details of how the directories were originally
3902 created under Windows).
3903
3904 I<Note>:
3905 This function does not handle drive names, backslashes etc.
3906
3907 See also C<guestfs_realpath>.");
3908
3909   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3910    [InitBasicFS, Always, TestOutput (
3911       [["vfs_type"; "/dev/sda1"]], "ext2")],
3912    "get the Linux VFS type corresponding to a mounted device",
3913    "\
3914 This command gets the filesystem type corresponding to
3915 the filesystem on C<device>.
3916
3917 For most filesystems, the result is the name of the Linux
3918 VFS module which would be used to mount this filesystem
3919 if you mounted it without specifying the filesystem type.
3920 For example a string such as C<ext3> or C<ntfs>.");
3921
3922   ("truncate", (RErr, [Pathname "path"]), 199, [],
3923    [InitBasicFS, Always, TestOutputStruct (
3924       [["write"; "/test"; "some stuff so size is not zero"];
3925        ["truncate"; "/test"];
3926        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3927    "truncate a file to zero size",
3928    "\
3929 This command truncates C<path> to a zero-length file.  The
3930 file must exist already.");
3931
3932   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3933    [InitBasicFS, Always, TestOutputStruct (
3934       [["touch"; "/test"];
3935        ["truncate_size"; "/test"; "1000"];
3936        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3937    "truncate a file to a particular size",
3938    "\
3939 This command truncates C<path> to size C<size> bytes.  The file
3940 must exist already.
3941
3942 If the current file size is less than C<size> then
3943 the file is extended to the required size with zero bytes.
3944 This creates a sparse file (ie. disk blocks are not allocated
3945 for the file until you write to it).  To create a non-sparse
3946 file of zeroes, use C<guestfs_fallocate64> instead.");
3947
3948   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3949    [InitBasicFS, Always, TestOutputStruct (
3950       [["touch"; "/test"];
3951        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3952        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3953    "set timestamp of a file with nanosecond precision",
3954    "\
3955 This command sets the timestamps of a file with nanosecond
3956 precision.
3957
3958 C<atsecs, atnsecs> are the last access time (atime) in secs and
3959 nanoseconds from the epoch.
3960
3961 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3962 secs and nanoseconds from the epoch.
3963
3964 If the C<*nsecs> field contains the special value C<-1> then
3965 the corresponding timestamp is set to the current time.  (The
3966 C<*secs> field is ignored in this case).
3967
3968 If the C<*nsecs> field contains the special value C<-2> then
3969 the corresponding timestamp is left unchanged.  (The
3970 C<*secs> field is ignored in this case).");
3971
3972   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3973    [InitBasicFS, Always, TestOutputStruct (
3974       [["mkdir_mode"; "/test"; "0o111"];
3975        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3976    "create a directory with a particular mode",
3977    "\
3978 This command creates a directory, setting the initial permissions
3979 of the directory to C<mode>.
3980
3981 For common Linux filesystems, the actual mode which is set will
3982 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3983 interpret the mode in other ways.
3984
3985 See also C<guestfs_mkdir>, C<guestfs_umask>");
3986
3987   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3988    [], (* XXX *)
3989    "change file owner and group",
3990    "\
3991 Change the file owner to C<owner> and group to C<group>.
3992 This is like C<guestfs_chown> but if C<path> is a symlink then
3993 the link itself is changed, not the target.
3994
3995 Only numeric uid and gid are supported.  If you want to use
3996 names, you will need to locate and parse the password file
3997 yourself (Augeas support makes this relatively easy).");
3998
3999   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
4000    [], (* XXX *)
4001    "lstat on multiple files",
4002    "\
4003 This call allows you to perform the C<guestfs_lstat> operation
4004 on multiple files, where all files are in the directory C<path>.
4005 C<names> is the list of files from this directory.
4006
4007 On return you get a list of stat structs, with a one-to-one
4008 correspondence to the C<names> list.  If any name did not exist
4009 or could not be lstat'd, then the C<ino> field of that structure
4010 is set to C<-1>.
4011
4012 This call is intended for programs that want to efficiently
4013 list a directory contents without making many round-trips.
4014 See also C<guestfs_lxattrlist> for a similarly efficient call
4015 for getting extended attributes.  Very long directory listings
4016 might cause the protocol message size to be exceeded, causing
4017 this call to fail.  The caller must split up such requests
4018 into smaller groups of names.");
4019
4020   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4021    [], (* XXX *)
4022    "lgetxattr on multiple files",
4023    "\
4024 This call allows you to get the extended attributes
4025 of multiple files, where all files are in the directory C<path>.
4026 C<names> is the list of files from this directory.
4027
4028 On return you get a flat list of xattr structs which must be
4029 interpreted sequentially.  The first xattr struct always has a zero-length
4030 C<attrname>.  C<attrval> in this struct is zero-length
4031 to indicate there was an error doing C<lgetxattr> for this
4032 file, I<or> is a C string which is a decimal number
4033 (the number of following attributes for this file, which could
4034 be C<\"0\">).  Then after the first xattr struct are the
4035 zero or more attributes for the first named file.
4036 This repeats for the second and subsequent files.
4037
4038 This call is intended for programs that want to efficiently
4039 list a directory contents without making many round-trips.
4040 See also C<guestfs_lstatlist> for a similarly efficient call
4041 for getting standard stats.  Very long directory listings
4042 might cause the protocol message size to be exceeded, causing
4043 this call to fail.  The caller must split up such requests
4044 into smaller groups of names.");
4045
4046   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4047    [], (* XXX *)
4048    "readlink on multiple files",
4049    "\
4050 This call allows you to do a C<readlink> operation
4051 on multiple files, where all files are in the directory C<path>.
4052 C<names> is the list of files from this directory.
4053
4054 On return you get a list of strings, with a one-to-one
4055 correspondence to the C<names> list.  Each string is the
4056 value of the symbolic link.
4057
4058 If the C<readlink(2)> operation fails on any name, then
4059 the corresponding result string is the empty string C<\"\">.
4060 However the whole operation is completed even if there
4061 were C<readlink(2)> errors, and so you can call this
4062 function with names where you don't know if they are
4063 symbolic links already (albeit slightly less efficient).
4064
4065 This call is intended for programs that want to efficiently
4066 list a directory contents without making many round-trips.
4067 Very long directory listings might cause the protocol
4068 message size to be exceeded, causing
4069 this call to fail.  The caller must split up such requests
4070 into smaller groups of names.");
4071
4072   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4073    [InitISOFS, Always, TestOutputBuffer (
4074       [["pread"; "/known-4"; "1"; "3"]], "\n");
4075     InitISOFS, Always, TestOutputBuffer (
4076       [["pread"; "/empty"; "0"; "100"]], "")],
4077    "read part of a file",
4078    "\
4079 This command lets you read part of a file.  It reads C<count>
4080 bytes of the file, starting at C<offset>, from file C<path>.
4081
4082 This may read fewer bytes than requested.  For further details
4083 see the L<pread(2)> system call.
4084
4085 See also C<guestfs_pwrite>.");
4086
4087   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4088    [InitEmpty, Always, TestRun (
4089       [["part_init"; "/dev/sda"; "gpt"]])],
4090    "create an empty partition table",
4091    "\
4092 This creates an empty partition table on C<device> of one of the
4093 partition types listed below.  Usually C<parttype> should be
4094 either C<msdos> or C<gpt> (for large disks).
4095
4096 Initially there are no partitions.  Following this, you should
4097 call C<guestfs_part_add> for each partition required.
4098
4099 Possible values for C<parttype> are:
4100
4101 =over 4
4102
4103 =item B<efi> | B<gpt>
4104
4105 Intel EFI / GPT partition table.
4106
4107 This is recommended for >= 2 TB partitions that will be accessed
4108 from Linux and Intel-based Mac OS X.  It also has limited backwards
4109 compatibility with the C<mbr> format.
4110
4111 =item B<mbr> | B<msdos>
4112
4113 The standard PC \"Master Boot Record\" (MBR) format used
4114 by MS-DOS and Windows.  This partition type will B<only> work
4115 for device sizes up to 2 TB.  For large disks we recommend
4116 using C<gpt>.
4117
4118 =back
4119
4120 Other partition table types that may work but are not
4121 supported include:
4122
4123 =over 4
4124
4125 =item B<aix>
4126
4127 AIX disk labels.
4128
4129 =item B<amiga> | B<rdb>
4130
4131 Amiga \"Rigid Disk Block\" format.
4132
4133 =item B<bsd>
4134
4135 BSD disk labels.
4136
4137 =item B<dasd>
4138
4139 DASD, used on IBM mainframes.
4140
4141 =item B<dvh>
4142
4143 MIPS/SGI volumes.
4144
4145 =item B<mac>
4146
4147 Old Mac partition format.  Modern Macs use C<gpt>.
4148
4149 =item B<pc98>
4150
4151 NEC PC-98 format, common in Japan apparently.
4152
4153 =item B<sun>
4154
4155 Sun disk labels.
4156
4157 =back");
4158
4159   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4160    [InitEmpty, Always, TestRun (
4161       [["part_init"; "/dev/sda"; "mbr"];
4162        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4163     InitEmpty, Always, TestRun (
4164       [["part_init"; "/dev/sda"; "gpt"];
4165        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4166        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4167     InitEmpty, Always, TestRun (
4168       [["part_init"; "/dev/sda"; "mbr"];
4169        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4170        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4171        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4172        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4173    "add a partition to the device",
4174    "\
4175 This command adds a partition to C<device>.  If there is no partition
4176 table on the device, call C<guestfs_part_init> first.
4177
4178 The C<prlogex> parameter is the type of partition.  Normally you
4179 should pass C<p> or C<primary> here, but MBR partition tables also
4180 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4181 types.
4182
4183 C<startsect> and C<endsect> are the start and end of the partition
4184 in I<sectors>.  C<endsect> may be negative, which means it counts
4185 backwards from the end of the disk (C<-1> is the last sector).
4186
4187 Creating a partition which covers the whole disk is not so easy.
4188 Use C<guestfs_part_disk> to do that.");
4189
4190   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4191    [InitEmpty, Always, TestRun (
4192       [["part_disk"; "/dev/sda"; "mbr"]]);
4193     InitEmpty, Always, TestRun (
4194       [["part_disk"; "/dev/sda"; "gpt"]])],
4195    "partition whole disk with a single primary partition",
4196    "\
4197 This command is simply a combination of C<guestfs_part_init>
4198 followed by C<guestfs_part_add> to create a single primary partition
4199 covering the whole disk.
4200
4201 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4202 but other possible values are described in C<guestfs_part_init>.");
4203
4204   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4205    [InitEmpty, Always, TestRun (
4206       [["part_disk"; "/dev/sda"; "mbr"];
4207        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4208    "make a partition bootable",
4209    "\
4210 This sets the bootable flag on partition numbered C<partnum> on
4211 device C<device>.  Note that partitions are numbered from 1.
4212
4213 The bootable flag is used by some operating systems (notably
4214 Windows) to determine which partition to boot from.  It is by
4215 no means universally recognized.");
4216
4217   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4218    [InitEmpty, Always, TestRun (
4219       [["part_disk"; "/dev/sda"; "gpt"];
4220        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4221    "set partition name",
4222    "\
4223 This sets the partition name on partition numbered C<partnum> on
4224 device C<device>.  Note that partitions are numbered from 1.
4225
4226 The partition name can only be set on certain types of partition
4227 table.  This works on C<gpt> but not on C<mbr> partitions.");
4228
4229   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4230    [], (* XXX Add a regression test for this. *)
4231    "list partitions on a device",
4232    "\
4233 This command parses the partition table on C<device> and
4234 returns the list of partitions found.
4235
4236 The fields in the returned structure are:
4237
4238 =over 4
4239
4240 =item B<part_num>
4241
4242 Partition number, counting from 1.
4243
4244 =item B<part_start>
4245
4246 Start of the partition I<in bytes>.  To get sectors you have to
4247 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4248
4249 =item B<part_end>
4250
4251 End of the partition in bytes.
4252
4253 =item B<part_size>
4254
4255 Size of the partition in bytes.
4256
4257 =back");
4258
4259   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4260    [InitEmpty, Always, TestOutput (
4261       [["part_disk"; "/dev/sda"; "gpt"];
4262        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4263    "get the partition table type",
4264    "\
4265 This command examines the partition table on C<device> and
4266 returns the partition table type (format) being used.
4267
4268 Common return values include: C<msdos> (a DOS/Windows style MBR
4269 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4270 values are possible, although unusual.  See C<guestfs_part_init>
4271 for a full list.");
4272
4273   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4274    [InitBasicFS, Always, TestOutputBuffer (
4275       [["fill"; "0x63"; "10"; "/test"];
4276        ["read_file"; "/test"]], "cccccccccc")],
4277    "fill a file with octets",
4278    "\
4279 This command creates a new file called C<path>.  The initial
4280 content of the file is C<len> octets of C<c>, where C<c>
4281 must be a number in the range C<[0..255]>.
4282
4283 To fill a file with zero bytes (sparsely), it is
4284 much more efficient to use C<guestfs_truncate_size>.
4285 To create a file with a pattern of repeating bytes
4286 use C<guestfs_fill_pattern>.");
4287
4288   ("available", (RErr, [StringList "groups"]), 216, [],
4289    [InitNone, Always, TestRun [["available"; ""]]],
4290    "test availability of some parts of the API",
4291    "\
4292 This command is used to check the availability of some
4293 groups of functionality in the appliance, which not all builds of
4294 the libguestfs appliance will be able to provide.
4295
4296 The libguestfs groups, and the functions that those
4297 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4298 You can also fetch this list at runtime by calling
4299 C<guestfs_available_all_groups>.
4300
4301 The argument C<groups> is a list of group names, eg:
4302 C<[\"inotify\", \"augeas\"]> would check for the availability of
4303 the Linux inotify functions and Augeas (configuration file
4304 editing) functions.
4305
4306 The command returns no error if I<all> requested groups are available.
4307
4308 It fails with an error if one or more of the requested
4309 groups is unavailable in the appliance.
4310
4311 If an unknown group name is included in the
4312 list of groups then an error is always returned.
4313
4314 I<Notes:>
4315
4316 =over 4
4317
4318 =item *
4319
4320 You must call C<guestfs_launch> before calling this function.
4321
4322 The reason is because we don't know what groups are
4323 supported by the appliance/daemon until it is running and can
4324 be queried.
4325
4326 =item *
4327
4328 If a group of functions is available, this does not necessarily
4329 mean that they will work.  You still have to check for errors
4330 when calling individual API functions even if they are
4331 available.
4332
4333 =item *
4334
4335 It is usually the job of distro packagers to build
4336 complete functionality into the libguestfs appliance.
4337 Upstream libguestfs, if built from source with all
4338 requirements satisfied, will support everything.
4339
4340 =item *
4341
4342 This call was added in version C<1.0.80>.  In previous
4343 versions of libguestfs all you could do would be to speculatively
4344 execute a command to find out if the daemon implemented it.
4345 See also C<guestfs_version>.
4346
4347 =back");
4348
4349   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4350    [InitBasicFS, Always, TestOutputBuffer (
4351       [["write"; "/src"; "hello, world"];
4352        ["dd"; "/src"; "/dest"];
4353        ["read_file"; "/dest"]], "hello, world")],
4354    "copy from source to destination using dd",
4355    "\
4356 This command copies from one source device or file C<src>
4357 to another destination device or file C<dest>.  Normally you
4358 would use this to copy to or from a device or partition, for
4359 example to duplicate a filesystem.
4360
4361 If the destination is a device, it must be as large or larger
4362 than the source file or device, otherwise the copy will fail.
4363 This command cannot do partial copies (see C<guestfs_copy_size>).");
4364
4365   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4366    [InitBasicFS, Always, TestOutputInt (
4367       [["write"; "/file"; "hello, world"];
4368        ["filesize"; "/file"]], 12)],
4369    "return the size of the file in bytes",
4370    "\
4371 This command returns the size of C<file> in bytes.
4372
4373 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4374 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4375 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4376
4377   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4378    [InitBasicFSonLVM, Always, TestOutputList (
4379       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4380        ["lvs"]], ["/dev/VG/LV2"])],
4381    "rename an LVM logical volume",
4382    "\
4383 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4384
4385   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4386    [InitBasicFSonLVM, Always, TestOutputList (
4387       [["umount"; "/"];
4388        ["vg_activate"; "false"; "VG"];
4389        ["vgrename"; "VG"; "VG2"];
4390        ["vg_activate"; "true"; "VG2"];
4391        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4392        ["vgs"]], ["VG2"])],
4393    "rename an LVM volume group",
4394    "\
4395 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4396
4397   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4398    [InitISOFS, Always, TestOutputBuffer (
4399       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4400    "list the contents of a single file in an initrd",
4401    "\
4402 This command unpacks the file C<filename> from the initrd file
4403 called C<initrdpath>.  The filename must be given I<without> the
4404 initial C</> character.
4405
4406 For example, in guestfish you could use the following command
4407 to examine the boot script (usually called C</init>)
4408 contained in a Linux initrd or initramfs image:
4409
4410  initrd-cat /boot/initrd-<version>.img init
4411
4412 See also C<guestfs_initrd_list>.");
4413
4414   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4415    [],
4416    "get the UUID of a physical volume",
4417    "\
4418 This command returns the UUID of the LVM PV C<device>.");
4419
4420   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4421    [],
4422    "get the UUID of a volume group",
4423    "\
4424 This command returns the UUID of the LVM VG named C<vgname>.");
4425
4426   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4427    [],
4428    "get the UUID of a logical volume",
4429    "\
4430 This command returns the UUID of the LVM LV C<device>.");
4431
4432   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4433    [],
4434    "get the PV UUIDs containing the volume group",
4435    "\
4436 Given a VG called C<vgname>, this returns the UUIDs of all
4437 the physical volumes that this volume group resides on.
4438
4439 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4440 calls to associate physical volumes and volume groups.
4441
4442 See also C<guestfs_vglvuuids>.");
4443
4444   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4445    [],
4446    "get the LV UUIDs of all LVs in the volume group",
4447    "\
4448 Given a VG called C<vgname>, this returns the UUIDs of all
4449 the logical volumes created in this volume group.
4450
4451 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4452 calls to associate logical volumes and volume groups.
4453
4454 See also C<guestfs_vgpvuuids>.");
4455
4456   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4457    [InitBasicFS, Always, TestOutputBuffer (
4458       [["write"; "/src"; "hello, world"];
4459        ["copy_size"; "/src"; "/dest"; "5"];
4460        ["read_file"; "/dest"]], "hello")],
4461    "copy size bytes from source to destination using dd",
4462    "\
4463 This command copies exactly C<size> bytes from one source device
4464 or file C<src> to another destination device or file C<dest>.
4465
4466 Note this will fail if the source is too short or if the destination
4467 is not large enough.");
4468
4469   ("zero_device", (RErr, [Device "device"]), 228, [DangerWillRobinson],
4470    [InitBasicFSonLVM, Always, TestRun (
4471       [["zero_device"; "/dev/VG/LV"]])],
4472    "write zeroes to an entire device",
4473    "\
4474 This command writes zeroes over the entire C<device>.  Compare
4475 with C<guestfs_zero> which just zeroes the first few blocks of
4476 a device.");
4477
4478   ("txz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 229, [Optional "xz"],
4479    [InitBasicFS, Always, TestOutput (
4480       [["txz_in"; "../images/helloworld.tar.xz"; "/"];
4481        ["cat"; "/hello"]], "hello\n")],
4482    "unpack compressed tarball to directory",
4483    "\
4484 This command uploads and unpacks local file C<tarball> (an
4485 I<xz compressed> tar file) into C<directory>.");
4486
4487   ("txz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 230, [Optional "xz"],
4488    [],
4489    "pack directory into compressed tarball",
4490    "\
4491 This command packs the contents of C<directory> and downloads
4492 it to local file C<tarball> (as an xz compressed tar archive).");
4493
4494   ("ntfsresize", (RErr, [Device "device"]), 231, [Optional "ntfsprogs"],
4495    [],
4496    "resize an NTFS filesystem",
4497    "\
4498 This command resizes an NTFS filesystem, expanding or
4499 shrinking it to the size of the underlying device.
4500 See also L<ntfsresize(8)>.");
4501
4502   ("vgscan", (RErr, []), 232, [],
4503    [InitEmpty, Always, TestRun (
4504       [["vgscan"]])],
4505    "rescan for LVM physical volumes, volume groups and logical volumes",
4506    "\
4507 This rescans all block devices and rebuilds the list of LVM
4508 physical volumes, volume groups and logical volumes.");
4509
4510   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4511    [InitEmpty, Always, TestRun (
4512       [["part_init"; "/dev/sda"; "mbr"];
4513        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4514        ["part_del"; "/dev/sda"; "1"]])],
4515    "delete a partition",
4516    "\
4517 This command deletes the partition numbered C<partnum> on C<device>.
4518
4519 Note that in the case of MBR partitioning, deleting an
4520 extended partition also deletes any logical partitions
4521 it contains.");
4522
4523   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4524    [InitEmpty, Always, TestOutputTrue (
4525       [["part_init"; "/dev/sda"; "mbr"];
4526        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4527        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4528        ["part_get_bootable"; "/dev/sda"; "1"]])],
4529    "return true if a partition is bootable",
4530    "\
4531 This command returns true if the partition C<partnum> on
4532 C<device> has the bootable flag set.
4533
4534 See also C<guestfs_part_set_bootable>.");
4535
4536   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [FishOutput FishOutputHexadecimal],
4537    [InitEmpty, Always, TestOutputInt (
4538       [["part_init"; "/dev/sda"; "mbr"];
4539        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4540        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4541        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4542    "get the MBR type byte (ID byte) from a partition",
4543    "\
4544 Returns the MBR type byte (also known as the ID byte) from
4545 the numbered partition C<partnum>.
4546
4547 Note that only MBR (old DOS-style) partitions have type bytes.
4548 You will get undefined results for other partition table
4549 types (see C<guestfs_part_get_parttype>).");
4550
4551   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4552    [], (* tested by part_get_mbr_id *)
4553    "set the MBR type byte (ID byte) of a partition",
4554    "\
4555 Sets the MBR type byte (also known as the ID byte) of
4556 the numbered partition C<partnum> to C<idbyte>.  Note
4557 that the type bytes quoted in most documentation are
4558 in fact hexadecimal numbers, but usually documented
4559 without any leading \"0x\" which might be confusing.
4560
4561 Note that only MBR (old DOS-style) partitions have type bytes.
4562 You will get undefined results for other partition table
4563 types (see C<guestfs_part_get_parttype>).");
4564
4565   ("checksum_device", (RString "checksum", [String "csumtype"; Device "device"]), 237, [],
4566    [InitISOFS, Always, TestOutput (
4567       [["checksum_device"; "md5"; "/dev/sdd"]],
4568       (Digest.to_hex (Digest.file "images/test.iso")))],
4569    "compute MD5, SHAx or CRC checksum of the contents of a device",
4570    "\
4571 This call computes the MD5, SHAx or CRC checksum of the
4572 contents of the device named C<device>.  For the types of
4573 checksums supported see the C<guestfs_checksum> command.");
4574
4575   ("lvresize_free", (RErr, [Device "lv"; Int "percent"]), 238, [Optional "lvm2"],
4576    [InitNone, Always, TestRun (
4577       [["part_disk"; "/dev/sda"; "mbr"];
4578        ["pvcreate"; "/dev/sda1"];
4579        ["vgcreate"; "VG"; "/dev/sda1"];
4580        ["lvcreate"; "LV"; "VG"; "10"];
4581        ["lvresize_free"; "/dev/VG/LV"; "100"]])],
4582    "expand an LV to fill free space",
4583    "\
4584 This expands an existing logical volume C<lv> so that it fills
4585 C<pc>% of the remaining free space in the volume group.  Commonly
4586 you would call this with pc = 100 which expands the logical volume
4587 as much as possible, using all remaining free space in the volume
4588 group.");
4589
4590   ("aug_clear", (RErr, [String "augpath"]), 239, [Optional "augeas"],
4591    [], (* XXX Augeas code needs tests. *)
4592    "clear Augeas path",
4593    "\
4594 Set the value associated with C<path> to C<NULL>.  This
4595 is the same as the L<augtool(1)> C<clear> command.");
4596
4597   ("get_umask", (RInt "mask", []), 240, [FishOutput FishOutputOctal],
4598    [InitEmpty, Always, TestOutputInt (
4599       [["get_umask"]], 0o22)],
4600    "get the current umask",
4601    "\
4602 Return the current umask.  By default the umask is C<022>
4603 unless it has been set by calling C<guestfs_umask>.");
4604
4605   ("debug_upload", (RErr, [FileIn "filename"; String "tmpname"; Int "mode"]), 241, [],
4606    [],
4607    "upload a file to the appliance (internal use only)",
4608    "\
4609 The C<guestfs_debug_upload> command uploads a file to
4610 the libguestfs appliance.
4611
4612 There is no comprehensive help for this command.  You have
4613 to look at the file C<daemon/debug.c> in the libguestfs source
4614 to find out what it is for.");
4615
4616   ("base64_in", (RErr, [FileIn "base64file"; Pathname "filename"]), 242, [],
4617    [InitBasicFS, Always, TestOutput (
4618       [["base64_in"; "../images/hello.b64"; "/hello"];
4619        ["cat"; "/hello"]], "hello\n")],
4620    "upload base64-encoded data to file",
4621    "\
4622 This command uploads base64-encoded data from C<base64file>
4623 to C<filename>.");
4624
4625   ("base64_out", (RErr, [Pathname "filename"; FileOut "base64file"]), 243, [],
4626    [],
4627    "download file and encode as base64",
4628    "\
4629 This command downloads the contents of C<filename>, writing
4630 it out to local file C<base64file> encoded as base64.");
4631
4632   ("checksums_out", (RErr, [String "csumtype"; Pathname "directory"; FileOut "sumsfile"]), 244, [],
4633    [],
4634    "compute MD5, SHAx or CRC checksum of files in a directory",
4635    "\
4636 This command computes the checksums of all regular files in
4637 C<directory> and then emits a list of those checksums to
4638 the local output file C<sumsfile>.
4639
4640 This can be used for verifying the integrity of a virtual
4641 machine.  However to be properly secure you should pay
4642 attention to the output of the checksum command (it uses
4643 the ones from GNU coreutils).  In particular when the
4644 filename is not printable, coreutils uses a special
4645 backslash syntax.  For more information, see the GNU
4646 coreutils info file.");
4647
4648   ("fill_pattern", (RErr, [String "pattern"; Int "len"; Pathname "path"]), 245, [],
4649    [InitBasicFS, Always, TestOutputBuffer (
4650       [["fill_pattern"; "abcdefghijklmnopqrstuvwxyz"; "28"; "/test"];
4651        ["read_file"; "/test"]], "abcdefghijklmnopqrstuvwxyzab")],
4652    "fill a file with a repeating pattern of bytes",
4653    "\
4654 This function is like C<guestfs_fill> except that it creates
4655 a new file of length C<len> containing the repeating pattern
4656 of bytes in C<pattern>.  The pattern is truncated if necessary
4657 to ensure the length of the file is exactly C<len> bytes.");
4658
4659   ("write", (RErr, [Pathname "path"; BufferIn "content"]), 246, [ProtocolLimitWarning],
4660    [InitBasicFS, Always, TestOutput (
4661       [["write"; "/new"; "new file contents"];
4662        ["cat"; "/new"]], "new file contents");
4663     InitBasicFS, Always, TestOutput (
4664       [["write"; "/new"; "\nnew file contents\n"];
4665        ["cat"; "/new"]], "\nnew file contents\n");
4666     InitBasicFS, Always, TestOutput (
4667       [["write"; "/new"; "\n\n"];
4668        ["cat"; "/new"]], "\n\n");
4669     InitBasicFS, Always, TestOutput (
4670       [["write"; "/new"; ""];
4671        ["cat"; "/new"]], "");
4672     InitBasicFS, Always, TestOutput (
4673       [["write"; "/new"; "\n\n\n"];
4674        ["cat"; "/new"]], "\n\n\n");
4675     InitBasicFS, Always, TestOutput (
4676       [["write"; "/new"; "\n"];
4677        ["cat"; "/new"]], "\n")],
4678    "create a new file",
4679    "\
4680 This call creates a file called C<path>.  The content of the
4681 file is the string C<content> (which can contain any 8 bit data).");
4682
4683   ("pwrite", (RInt "nbytes", [Pathname "path"; BufferIn "content"; Int64 "offset"]), 247, [ProtocolLimitWarning],
4684    [InitBasicFS, Always, TestOutput (
4685       [["write"; "/new"; "new file contents"];
4686        ["pwrite"; "/new"; "data"; "4"];
4687        ["cat"; "/new"]], "new data contents");
4688     InitBasicFS, Always, TestOutput (
4689       [["write"; "/new"; "new file contents"];
4690        ["pwrite"; "/new"; "is extended"; "9"];
4691        ["cat"; "/new"]], "new file is extended");
4692     InitBasicFS, Always, TestOutput (
4693       [["write"; "/new"; "new file contents"];
4694        ["pwrite"; "/new"; ""; "4"];
4695        ["cat"; "/new"]], "new file contents")],
4696    "write to part of a file",
4697    "\
4698 This command writes to part of a file.  It writes the data
4699 buffer C<content> to the file C<path> starting at offset C<offset>.
4700
4701 This command implements the L<pwrite(2)> system call, and like
4702 that system call it may not write the full data requested.  The
4703 return value is the number of bytes that were actually written
4704 to the file.  This could even be 0, although short writes are
4705 unlikely for regular files in ordinary circumstances.
4706
4707 See also C<guestfs_pread>.");
4708
4709   ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
4710    [],
4711    "resize an ext2, ext3 or ext4 filesystem (with size)",
4712    "\
4713 This command is the same as C<guestfs_resize2fs> except that it
4714 allows you to specify the new size (in bytes) explicitly.");
4715
4716   ("pvresize_size", (RErr, [Device "device"; Int64 "size"]), 249, [Optional "lvm2"],
4717    [],
4718    "resize an LVM physical volume (with size)",
4719    "\
4720 This command is the same as C<guestfs_pvresize> except that it
4721 allows you to specify the new size (in bytes) explicitly.");
4722
4723   ("ntfsresize_size", (RErr, [Device "device"; Int64 "size"]), 250, [Optional "ntfsprogs"],
4724    [],
4725    "resize an NTFS filesystem (with size)",
4726    "\
4727 This command is the same as C<guestfs_ntfsresize> except that it
4728 allows you to specify the new size (in bytes) explicitly.");
4729
4730   ("available_all_groups", (RStringList "groups", []), 251, [],
4731    [InitNone, Always, TestRun [["available_all_groups"]]],
4732    "return a list of all optional groups",
4733    "\
4734 This command returns a list of all optional groups that this
4735 daemon knows about.  Note this returns both supported and unsupported
4736 groups.  To find out which ones the daemon can actually support
4737 you have to call C<guestfs_available> on each member of the
4738 returned list.
4739
4740 See also C<guestfs_available> and L<guestfs(3)/AVAILABILITY>.");
4741
4742   ("fallocate64", (RErr, [Pathname "path"; Int64 "len"]), 252, [],
4743    [InitBasicFS, Always, TestOutputStruct (
4744       [["fallocate64"; "/a"; "1000000"];
4745        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
4746    "preallocate a file in the guest filesystem",
4747    "\
4748 This command preallocates a file (containing zero bytes) named
4749 C<path> of size C<len> bytes.  If the file exists already, it
4750 is overwritten.
4751
4752 Note that this call allocates disk blocks for the file.
4753 To create a sparse file use C<guestfs_truncate_size> instead.
4754
4755 The deprecated call C<guestfs_fallocate> does the same,
4756 but owing to an oversight it only allowed 30 bit lengths
4757 to be specified, effectively limiting the maximum size
4758 of files created through that call to 1GB.
4759
4760 Do not confuse this with the guestfish-specific
4761 C<alloc> and C<sparse> commands which create
4762 a file in the host and attach it as a device.");
4763
4764   ("vfs_label", (RString "label", [Device "device"]), 253, [],
4765    [InitBasicFS, Always, TestOutput (
4766        [["set_e2label"; "/dev/sda1"; "LTEST"];
4767         ["vfs_label"; "/dev/sda1"]], "LTEST")],
4768    "get the filesystem label",
4769    "\
4770 This returns the filesystem label of the filesystem on
4771 C<device>.
4772
4773 If the filesystem is unlabeled, this returns the empty string.");
4774
4775   ("vfs_uuid", (RString "uuid", [Device "device"]), 254, [],
4776    (let uuid = uuidgen () in
4777     [InitBasicFS, Always, TestOutput (
4778        [["set_e2uuid"; "/dev/sda1"; uuid];
4779         ["vfs_uuid"; "/dev/sda1"]], uuid)]),
4780    "get the filesystem UUID",
4781    "\
4782 This returns the filesystem UUID of the filesystem on
4783 C<device>.
4784
4785 If the filesystem does not have a UUID, this returns the empty string.");
4786
4787 ]
4788
4789 let all_functions = non_daemon_functions @ daemon_functions
4790
4791 (* In some places we want the functions to be displayed sorted
4792  * alphabetically, so this is useful:
4793  *)
4794 let all_functions_sorted =
4795   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4796                compare n1 n2) all_functions
4797
4798 (* This is used to generate the src/MAX_PROC_NR file which
4799  * contains the maximum procedure number, a surrogate for the
4800  * ABI version number.  See src/Makefile.am for the details.
4801  *)
4802 let max_proc_nr =
4803   let proc_nrs = List.map (
4804     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
4805   ) daemon_functions in
4806   List.fold_left max 0 proc_nrs
4807
4808 (* Field types for structures. *)
4809 type field =
4810   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4811   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4812   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4813   | FUInt32
4814   | FInt32
4815   | FUInt64
4816   | FInt64
4817   | FBytes                      (* Any int measure that counts bytes. *)
4818   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4819   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4820
4821 (* Because we generate extra parsing code for LVM command line tools,
4822  * we have to pull out the LVM columns separately here.
4823  *)
4824 let lvm_pv_cols = [
4825   "pv_name", FString;
4826   "pv_uuid", FUUID;
4827   "pv_fmt", FString;
4828   "pv_size", FBytes;
4829   "dev_size", FBytes;
4830   "pv_free", FBytes;
4831   "pv_used", FBytes;
4832   "pv_attr", FString (* XXX *);
4833   "pv_pe_count", FInt64;
4834   "pv_pe_alloc_count", FInt64;
4835   "pv_tags", FString;
4836   "pe_start", FBytes;
4837   "pv_mda_count", FInt64;
4838   "pv_mda_free", FBytes;
4839   (* Not in Fedora 10:
4840      "pv_mda_size", FBytes;
4841   *)
4842 ]
4843 let lvm_vg_cols = [
4844   "vg_name", FString;
4845   "vg_uuid", FUUID;
4846   "vg_fmt", FString;
4847   "vg_attr", FString (* XXX *);
4848   "vg_size", FBytes;
4849   "vg_free", FBytes;
4850   "vg_sysid", FString;
4851   "vg_extent_size", FBytes;
4852   "vg_extent_count", FInt64;
4853   "vg_free_count", FInt64;
4854   "max_lv", FInt64;
4855   "max_pv", FInt64;
4856   "pv_count", FInt64;
4857   "lv_count", FInt64;
4858   "snap_count", FInt64;
4859   "vg_seqno", FInt64;
4860   "vg_tags", FString;
4861   "vg_mda_count", FInt64;
4862   "vg_mda_free", FBytes;
4863   (* Not in Fedora 10:
4864      "vg_mda_size", FBytes;
4865   *)
4866 ]
4867 let lvm_lv_cols = [
4868   "lv_name", FString;
4869   "lv_uuid", FUUID;
4870   "lv_attr", FString (* XXX *);
4871   "lv_major", FInt64;
4872   "lv_minor", FInt64;
4873   "lv_kernel_major", FInt64;
4874   "lv_kernel_minor", FInt64;
4875   "lv_size", FBytes;
4876   "seg_count", FInt64;
4877   "origin", FString;
4878   "snap_percent", FOptPercent;
4879   "copy_percent", FOptPercent;
4880   "move_pv", FString;
4881   "lv_tags", FString;
4882   "mirror_log", FString;
4883   "modules", FString;
4884 ]
4885
4886 (* Names and fields in all structures (in RStruct and RStructList)
4887  * that we support.
4888  *)
4889 let structs = [
4890   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4891    * not use this struct in any new code.
4892    *)
4893   "int_bool", [
4894     "i", FInt32;                (* for historical compatibility *)
4895     "b", FInt32;                (* for historical compatibility *)
4896   ];
4897
4898   (* LVM PVs, VGs, LVs. *)
4899   "lvm_pv", lvm_pv_cols;
4900   "lvm_vg", lvm_vg_cols;
4901   "lvm_lv", lvm_lv_cols;
4902
4903   (* Column names and types from stat structures.
4904    * NB. Can't use things like 'st_atime' because glibc header files
4905    * define some of these as macros.  Ugh.
4906    *)
4907   "stat", [
4908     "dev", FInt64;
4909     "ino", FInt64;
4910     "mode", FInt64;
4911     "nlink", FInt64;
4912     "uid", FInt64;
4913     "gid", FInt64;
4914     "rdev", FInt64;
4915     "size", FInt64;
4916     "blksize", FInt64;
4917     "blocks", FInt64;
4918     "atime", FInt64;
4919     "mtime", FInt64;
4920     "ctime", FInt64;
4921   ];
4922   "statvfs", [
4923     "bsize", FInt64;
4924     "frsize", FInt64;
4925     "blocks", FInt64;
4926     "bfree", FInt64;
4927     "bavail", FInt64;
4928     "files", FInt64;
4929     "ffree", FInt64;
4930     "favail", FInt64;
4931     "fsid", FInt64;
4932     "flag", FInt64;
4933     "namemax", FInt64;
4934   ];
4935
4936   (* Column names in dirent structure. *)
4937   "dirent", [
4938     "ino", FInt64;
4939     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4940     "ftyp", FChar;
4941     "name", FString;
4942   ];
4943
4944   (* Version numbers. *)
4945   "version", [
4946     "major", FInt64;
4947     "minor", FInt64;
4948     "release", FInt64;
4949     "extra", FString;
4950   ];
4951
4952   (* Extended attribute. *)
4953   "xattr", [
4954     "attrname", FString;
4955     "attrval", FBuffer;
4956   ];
4957
4958   (* Inotify events. *)
4959   "inotify_event", [
4960     "in_wd", FInt64;
4961     "in_mask", FUInt32;
4962     "in_cookie", FUInt32;
4963     "in_name", FString;
4964   ];
4965
4966   (* Partition table entry. *)
4967   "partition", [
4968     "part_num", FInt32;
4969     "part_start", FBytes;
4970     "part_end", FBytes;
4971     "part_size", FBytes;
4972   ];
4973 ] (* end of structs *)
4974
4975 (* Ugh, Java has to be different ..
4976  * These names are also used by the Haskell bindings.
4977  *)
4978 let java_structs = [
4979   "int_bool", "IntBool";
4980   "lvm_pv", "PV";
4981   "lvm_vg", "VG";
4982   "lvm_lv", "LV";
4983   "stat", "Stat";
4984   "statvfs", "StatVFS";
4985   "dirent", "Dirent";
4986   "version", "Version";
4987   "xattr", "XAttr";
4988   "inotify_event", "INotifyEvent";
4989   "partition", "Partition";
4990 ]
4991
4992 (* What structs are actually returned. *)
4993 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4994
4995 (* Returns a list of RStruct/RStructList structs that are returned
4996  * by any function.  Each element of returned list is a pair:
4997  *
4998  * (structname, RStructOnly)
4999  *    == there exists function which returns RStruct (_, structname)
5000  * (structname, RStructListOnly)
5001  *    == there exists function which returns RStructList (_, structname)
5002  * (structname, RStructAndList)
5003  *    == there are functions returning both RStruct (_, structname)
5004  *                                      and RStructList (_, structname)
5005  *)
5006 let rstructs_used_by functions =
5007   (* ||| is a "logical OR" for rstructs_used_t *)
5008   let (|||) a b =
5009     match a, b with
5010     | RStructAndList, _
5011     | _, RStructAndList -> RStructAndList
5012     | RStructOnly, RStructListOnly
5013     | RStructListOnly, RStructOnly -> RStructAndList
5014     | RStructOnly, RStructOnly -> RStructOnly
5015     | RStructListOnly, RStructListOnly -> RStructListOnly
5016   in
5017
5018   let h = Hashtbl.create 13 in
5019
5020   (* if elem->oldv exists, update entry using ||| operator,
5021    * else just add elem->newv to the hash
5022    *)
5023   let update elem newv =
5024     try  let oldv = Hashtbl.find h elem in
5025          Hashtbl.replace h elem (newv ||| oldv)
5026     with Not_found -> Hashtbl.add h elem newv
5027   in
5028
5029   List.iter (
5030     fun (_, style, _, _, _, _, _) ->
5031       match fst style with
5032       | RStruct (_, structname) -> update structname RStructOnly
5033       | RStructList (_, structname) -> update structname RStructListOnly
5034       | _ -> ()
5035   ) functions;
5036
5037   (* return key->values as a list of (key,value) *)
5038   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
5039
5040 (* Used for testing language bindings. *)
5041 type callt =
5042   | CallString of string
5043   | CallOptString of string option
5044   | CallStringList of string list
5045   | CallInt of int
5046   | CallInt64 of int64
5047   | CallBool of bool
5048   | CallBuffer of string
5049
5050 (* Used to memoize the result of pod2text. *)
5051 let pod2text_memo_filename = "src/.pod2text.data"
5052 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
5053   try
5054     let chan = open_in pod2text_memo_filename in
5055     let v = input_value chan in
5056     close_in chan;
5057     v
5058   with
5059     _ -> Hashtbl.create 13
5060 let pod2text_memo_updated () =
5061   let chan = open_out pod2text_memo_filename in
5062   output_value chan pod2text_memo;
5063   close_out chan
5064
5065 (* Useful functions.
5066  * Note we don't want to use any external OCaml libraries which
5067  * makes this a bit harder than it should be.
5068  *)
5069 module StringMap = Map.Make (String)
5070
5071 let failwithf fs = ksprintf failwith fs
5072
5073 let unique = let i = ref 0 in fun () -> incr i; !i
5074
5075 let replace_char s c1 c2 =
5076   let s2 = String.copy s in
5077   let r = ref false in
5078   for i = 0 to String.length s2 - 1 do
5079     if String.unsafe_get s2 i = c1 then (
5080       String.unsafe_set s2 i c2;
5081       r := true
5082     )
5083   done;
5084   if not !r then s else s2
5085
5086 let isspace c =
5087   c = ' '
5088   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
5089
5090 let triml ?(test = isspace) str =
5091   let i = ref 0 in
5092   let n = ref (String.length str) in
5093   while !n > 0 && test str.[!i]; do
5094     decr n;
5095     incr i
5096   done;
5097   if !i = 0 then str
5098   else String.sub str !i !n
5099
5100 let trimr ?(test = isspace) str =
5101   let n = ref (String.length str) in
5102   while !n > 0 && test str.[!n-1]; do
5103     decr n
5104   done;
5105   if !n = String.length str then str
5106   else String.sub str 0 !n
5107
5108 let trim ?(test = isspace) str =
5109   trimr ~test (triml ~test str)
5110
5111 let rec find s sub =
5112   let len = String.length s in
5113   let sublen = String.length sub in
5114   let rec loop i =
5115     if i <= len-sublen then (
5116       let rec loop2 j =
5117         if j < sublen then (
5118           if s.[i+j] = sub.[j] then loop2 (j+1)
5119           else -1
5120         ) else
5121           i (* found *)
5122       in
5123       let r = loop2 0 in
5124       if r = -1 then loop (i+1) else r
5125     ) else
5126       -1 (* not found *)
5127   in
5128   loop 0
5129
5130 let rec replace_str s s1 s2 =
5131   let len = String.length s in
5132   let sublen = String.length s1 in
5133   let i = find s s1 in
5134   if i = -1 then s
5135   else (
5136     let s' = String.sub s 0 i in
5137     let s'' = String.sub s (i+sublen) (len-i-sublen) in
5138     s' ^ s2 ^ replace_str s'' s1 s2
5139   )
5140
5141 let rec string_split sep str =
5142   let len = String.length str in
5143   let seplen = String.length sep in
5144   let i = find str sep in
5145   if i = -1 then [str]
5146   else (
5147     let s' = String.sub str 0 i in
5148     let s'' = String.sub str (i+seplen) (len-i-seplen) in
5149     s' :: string_split sep s''
5150   )
5151
5152 let files_equal n1 n2 =
5153   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
5154   match Sys.command cmd with
5155   | 0 -> true
5156   | 1 -> false
5157   | i -> failwithf "%s: failed with error code %d" cmd i
5158
5159 let rec filter_map f = function
5160   | [] -> []
5161   | x :: xs ->
5162       match f x with
5163       | Some y -> y :: filter_map f xs
5164       | None -> filter_map f xs
5165
5166 let rec find_map f = function
5167   | [] -> raise Not_found
5168   | x :: xs ->
5169       match f x with
5170       | Some y -> y
5171       | None -> find_map f xs
5172
5173 let iteri f xs =
5174   let rec loop i = function
5175     | [] -> ()
5176     | x :: xs -> f i x; loop (i+1) xs
5177   in
5178   loop 0 xs
5179
5180 let mapi f xs =
5181   let rec loop i = function
5182     | [] -> []
5183     | x :: xs -> let r = f i x in r :: loop (i+1) xs
5184   in
5185   loop 0 xs
5186
5187 let count_chars c str =
5188   let count = ref 0 in
5189   for i = 0 to String.length str - 1 do
5190     if c = String.unsafe_get str i then incr count
5191   done;
5192   !count
5193
5194 let explode str =
5195   let r = ref [] in
5196   for i = 0 to String.length str - 1 do
5197     let c = String.unsafe_get str i in
5198     r := c :: !r;
5199   done;
5200   List.rev !r
5201
5202 let map_chars f str =
5203   List.map f (explode str)
5204
5205 let name_of_argt = function
5206   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
5207   | StringList n | DeviceList n | Bool n | Int n | Int64 n
5208   | FileIn n | FileOut n | BufferIn n -> n
5209
5210 let java_name_of_struct typ =
5211   try List.assoc typ java_structs
5212   with Not_found ->
5213     failwithf
5214       "java_name_of_struct: no java_structs entry corresponding to %s" typ
5215
5216 let cols_of_struct typ =
5217   try List.assoc typ structs
5218   with Not_found ->
5219     failwithf "cols_of_struct: unknown struct %s" typ
5220
5221 let seq_of_test = function
5222   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
5223   | TestOutputListOfDevices (s, _)
5224   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
5225   | TestOutputTrue s | TestOutputFalse s
5226   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
5227   | TestOutputStruct (s, _)
5228   | TestLastFail s -> s
5229
5230 (* Handling for function flags. *)
5231 let protocol_limit_warning =
5232   "Because of the message protocol, there is a transfer limit
5233 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
5234
5235 let danger_will_robinson =
5236   "B<This command is dangerous.  Without careful use you
5237 can easily destroy all your data>."
5238
5239 let deprecation_notice flags =
5240   try
5241     let alt =
5242       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
5243     let txt =
5244       sprintf "This function is deprecated.
5245 In new code, use the C<%s> call instead.
5246
5247 Deprecated functions will not be removed from the API, but the
5248 fact that they are deprecated indicates that there are problems
5249 with correct use of these functions." alt in
5250     Some txt
5251   with
5252     Not_found -> None
5253
5254 (* Create list of optional groups. *)
5255 let optgroups =
5256   let h = Hashtbl.create 13 in
5257   List.iter (
5258     fun (name, _, _, flags, _, _, _) ->
5259       List.iter (
5260         function
5261         | Optional group ->
5262             let names = try Hashtbl.find h group with Not_found -> [] in
5263             Hashtbl.replace h group (name :: names)
5264         | _ -> ()
5265       ) flags
5266   ) daemon_functions;
5267   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
5268   let groups =
5269     List.map (
5270       fun group -> group, List.sort compare (Hashtbl.find h group)
5271     ) groups in
5272   List.sort (fun x y -> compare (fst x) (fst y)) groups
5273
5274 (* Check function names etc. for consistency. *)
5275 let check_functions () =
5276   let contains_uppercase str =
5277     let len = String.length str in
5278     let rec loop i =
5279       if i >= len then false
5280       else (
5281         let c = str.[i] in
5282         if c >= 'A' && c <= 'Z' then true
5283         else loop (i+1)
5284       )
5285     in
5286     loop 0
5287   in
5288
5289   (* Check function names. *)
5290   List.iter (
5291     fun (name, _, _, _, _, _, _) ->
5292       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
5293         failwithf "function name %s does not need 'guestfs' prefix" name;
5294       if name = "" then
5295         failwithf "function name is empty";
5296       if name.[0] < 'a' || name.[0] > 'z' then
5297         failwithf "function name %s must start with lowercase a-z" name;
5298       if String.contains name '-' then
5299         failwithf "function name %s should not contain '-', use '_' instead."
5300           name
5301   ) all_functions;
5302
5303   (* Check function parameter/return names. *)
5304   List.iter (
5305     fun (name, style, _, _, _, _, _) ->
5306       let check_arg_ret_name n =
5307         if contains_uppercase n then
5308           failwithf "%s param/ret %s should not contain uppercase chars"
5309             name n;
5310         if String.contains n '-' || String.contains n '_' then
5311           failwithf "%s param/ret %s should not contain '-' or '_'"
5312             name n;
5313         if n = "value" then
5314           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;
5315         if n = "int" || n = "char" || n = "short" || n = "long" then
5316           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5317         if n = "i" || n = "n" then
5318           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5319         if n = "argv" || n = "args" then
5320           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5321
5322         (* List Haskell, OCaml and C keywords here.
5323          * http://www.haskell.org/haskellwiki/Keywords
5324          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5325          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5326          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5327          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5328          * Omitting _-containing words, since they're handled above.
5329          * Omitting the OCaml reserved word, "val", is ok,
5330          * and saves us from renaming several parameters.
5331          *)
5332         let reserved = [
5333           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5334           "char"; "class"; "const"; "constraint"; "continue"; "data";
5335           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5336           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5337           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5338           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5339           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5340           "interface";
5341           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5342           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5343           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5344           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5345           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5346           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5347           "volatile"; "when"; "where"; "while";
5348           ] in
5349         if List.mem n reserved then
5350           failwithf "%s has param/ret using reserved word %s" name n;
5351       in
5352
5353       (match fst style with
5354        | RErr -> ()
5355        | RInt n | RInt64 n | RBool n
5356        | RConstString n | RConstOptString n | RString n
5357        | RStringList n | RStruct (n, _) | RStructList (n, _)
5358        | RHashtable n | RBufferOut n ->
5359            check_arg_ret_name n
5360       );
5361       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5362   ) all_functions;
5363
5364   (* Check short descriptions. *)
5365   List.iter (
5366     fun (name, _, _, _, _, shortdesc, _) ->
5367       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5368         failwithf "short description of %s should begin with lowercase." name;
5369       let c = shortdesc.[String.length shortdesc-1] in
5370       if c = '\n' || c = '.' then
5371         failwithf "short description of %s should not end with . or \\n." name
5372   ) all_functions;
5373
5374   (* Check long descriptions. *)
5375   List.iter (
5376     fun (name, _, _, _, _, _, longdesc) ->
5377       if longdesc.[String.length longdesc-1] = '\n' then
5378         failwithf "long description of %s should not end with \\n." name
5379   ) all_functions;
5380
5381   (* Check proc_nrs. *)
5382   List.iter (
5383     fun (name, _, proc_nr, _, _, _, _) ->
5384       if proc_nr <= 0 then
5385         failwithf "daemon function %s should have proc_nr > 0" name
5386   ) daemon_functions;
5387
5388   List.iter (
5389     fun (name, _, proc_nr, _, _, _, _) ->
5390       if proc_nr <> -1 then
5391         failwithf "non-daemon function %s should have proc_nr -1" name
5392   ) non_daemon_functions;
5393
5394   let proc_nrs =
5395     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5396       daemon_functions in
5397   let proc_nrs =
5398     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5399   let rec loop = function
5400     | [] -> ()
5401     | [_] -> ()
5402     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5403         loop rest
5404     | (name1,nr1) :: (name2,nr2) :: _ ->
5405         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5406           name1 name2 nr1 nr2
5407   in
5408   loop proc_nrs;
5409
5410   (* Check tests. *)
5411   List.iter (
5412     function
5413       (* Ignore functions that have no tests.  We generate a
5414        * warning when the user does 'make check' instead.
5415        *)
5416     | name, _, _, _, [], _, _ -> ()
5417     | name, _, _, _, tests, _, _ ->
5418         let funcs =
5419           List.map (
5420             fun (_, _, test) ->
5421               match seq_of_test test with
5422               | [] ->
5423                   failwithf "%s has a test containing an empty sequence" name
5424               | cmds -> List.map List.hd cmds
5425           ) tests in
5426         let funcs = List.flatten funcs in
5427
5428         let tested = List.mem name funcs in
5429
5430         if not tested then
5431           failwithf "function %s has tests but does not test itself" name
5432   ) all_functions
5433
5434 (* 'pr' prints to the current output file. *)
5435 let chan = ref Pervasives.stdout
5436 let lines = ref 0
5437 let pr fs =
5438   ksprintf
5439     (fun str ->
5440        let i = count_chars '\n' str in
5441        lines := !lines + i;
5442        output_string !chan str
5443     ) fs
5444
5445 let copyright_years =
5446   let this_year = 1900 + (localtime (time ())).tm_year in
5447   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5448
5449 (* Generate a header block in a number of standard styles. *)
5450 type comment_style =
5451     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5452 type license = GPLv2plus | LGPLv2plus
5453
5454 let generate_header ?(extra_inputs = []) comment license =
5455   let inputs = "src/generator.ml" :: extra_inputs in
5456   let c = match comment with
5457     | CStyle ->         pr "/* "; " *"
5458     | CPlusPlusStyle -> pr "// "; "//"
5459     | HashStyle ->      pr "# ";  "#"
5460     | OCamlStyle ->     pr "(* "; " *"
5461     | HaskellStyle ->   pr "{- "; "  " in
5462   pr "libguestfs generated file\n";
5463   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5464   List.iter (pr "%s   %s\n" c) inputs;
5465   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5466   pr "%s\n" c;
5467   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5468   pr "%s\n" c;
5469   (match license with
5470    | GPLv2plus ->
5471        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5472        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5473        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5474        pr "%s (at your option) any later version.\n" c;
5475        pr "%s\n" c;
5476        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5477        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5478        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5479        pr "%s GNU General Public License for more details.\n" c;
5480        pr "%s\n" c;
5481        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5482        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5483        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5484
5485    | LGPLv2plus ->
5486        pr "%s This library is free software; you can redistribute it and/or\n" c;
5487        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5488        pr "%s License as published by the Free Software Foundation; either\n" c;
5489        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5490        pr "%s\n" c;
5491        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5492        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5493        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5494        pr "%s Lesser General Public License for more details.\n" c;
5495        pr "%s\n" c;
5496        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5497        pr "%s License along with this library; if not, write to the Free Software\n" c;
5498        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5499   );
5500   (match comment with
5501    | CStyle -> pr " */\n"
5502    | CPlusPlusStyle
5503    | HashStyle -> ()
5504    | OCamlStyle -> pr " *)\n"
5505    | HaskellStyle -> pr "-}\n"
5506   );
5507   pr "\n"
5508
5509 (* Start of main code generation functions below this line. *)
5510
5511 (* Generate the pod documentation for the C API. *)
5512 let rec generate_actions_pod () =
5513   List.iter (
5514     fun (shortname, style, _, flags, _, _, longdesc) ->
5515       if not (List.mem NotInDocs flags) then (
5516         let name = "guestfs_" ^ shortname in
5517         pr "=head2 %s\n\n" name;
5518         pr " ";
5519         generate_prototype ~extern:false ~handle:"g" name style;
5520         pr "\n\n";
5521         pr "%s\n\n" longdesc;
5522         (match fst style with
5523          | RErr ->
5524              pr "This function returns 0 on success or -1 on error.\n\n"
5525          | RInt _ ->
5526              pr "On error this function returns -1.\n\n"
5527          | RInt64 _ ->
5528              pr "On error this function returns -1.\n\n"
5529          | RBool _ ->
5530              pr "This function returns a C truth value on success or -1 on error.\n\n"
5531          | RConstString _ ->
5532              pr "This function returns a string, or NULL on error.
5533 The string is owned by the guest handle and must I<not> be freed.\n\n"
5534          | RConstOptString _ ->
5535              pr "This function returns a string which may be NULL.
5536 There is way to return an error from this function.
5537 The string is owned by the guest handle and must I<not> be freed.\n\n"
5538          | RString _ ->
5539              pr "This function returns a string, or NULL on error.
5540 I<The caller must free the returned string after use>.\n\n"
5541          | RStringList _ ->
5542              pr "This function returns a NULL-terminated array of strings
5543 (like L<environ(3)>), or NULL if there was an error.
5544 I<The caller must free the strings and the array after use>.\n\n"
5545          | RStruct (_, typ) ->
5546              pr "This function returns a C<struct guestfs_%s *>,
5547 or NULL if there was an error.
5548 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5549          | RStructList (_, typ) ->
5550              pr "This function returns a C<struct guestfs_%s_list *>
5551 (see E<lt>guestfs-structs.hE<gt>),
5552 or NULL if there was an error.
5553 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5554          | RHashtable _ ->
5555              pr "This function returns a NULL-terminated array of
5556 strings, or NULL if there was an error.
5557 The array of strings will always have length C<2n+1>, where
5558 C<n> keys and values alternate, followed by the trailing NULL entry.
5559 I<The caller must free the strings and the array after use>.\n\n"
5560          | RBufferOut _ ->
5561              pr "This function returns a buffer, or NULL on error.
5562 The size of the returned buffer is written to C<*size_r>.
5563 I<The caller must free the returned buffer after use>.\n\n"
5564         );
5565         if List.mem ProtocolLimitWarning flags then
5566           pr "%s\n\n" protocol_limit_warning;
5567         if List.mem DangerWillRobinson flags then
5568           pr "%s\n\n" danger_will_robinson;
5569         match deprecation_notice flags with
5570         | None -> ()
5571         | Some txt -> pr "%s\n\n" txt
5572       )
5573   ) all_functions_sorted
5574
5575 and generate_structs_pod () =
5576   (* Structs documentation. *)
5577   List.iter (
5578     fun (typ, cols) ->
5579       pr "=head2 guestfs_%s\n" typ;
5580       pr "\n";
5581       pr " struct guestfs_%s {\n" typ;
5582       List.iter (
5583         function
5584         | name, FChar -> pr "   char %s;\n" name
5585         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5586         | name, FInt32 -> pr "   int32_t %s;\n" name
5587         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5588         | name, FInt64 -> pr "   int64_t %s;\n" name
5589         | name, FString -> pr "   char *%s;\n" name
5590         | name, FBuffer ->
5591             pr "   /* The next two fields describe a byte array. */\n";
5592             pr "   uint32_t %s_len;\n" name;
5593             pr "   char *%s;\n" name
5594         | name, FUUID ->
5595             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5596             pr "   char %s[32];\n" name
5597         | name, FOptPercent ->
5598             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5599             pr "   float %s;\n" name
5600       ) cols;
5601       pr " };\n";
5602       pr " \n";
5603       pr " struct guestfs_%s_list {\n" typ;
5604       pr "   uint32_t len; /* Number of elements in list. */\n";
5605       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5606       pr " };\n";
5607       pr " \n";
5608       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5609       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5610         typ typ;
5611       pr "\n"
5612   ) structs
5613
5614 and generate_availability_pod () =
5615   (* Availability documentation. *)
5616   pr "=over 4\n";
5617   pr "\n";
5618   List.iter (
5619     fun (group, functions) ->
5620       pr "=item B<%s>\n" group;
5621       pr "\n";
5622       pr "The following functions:\n";
5623       List.iter (pr "L</guestfs_%s>\n") functions;
5624       pr "\n"
5625   ) optgroups;
5626   pr "=back\n";
5627   pr "\n"
5628
5629 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5630  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5631  *
5632  * We have to use an underscore instead of a dash because otherwise
5633  * rpcgen generates incorrect code.
5634  *
5635  * This header is NOT exported to clients, but see also generate_structs_h.
5636  *)
5637 and generate_xdr () =
5638   generate_header CStyle LGPLv2plus;
5639
5640   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5641   pr "typedef string str<>;\n";
5642   pr "\n";
5643
5644   (* Internal structures. *)
5645   List.iter (
5646     function
5647     | typ, cols ->
5648         pr "struct guestfs_int_%s {\n" typ;
5649         List.iter (function
5650                    | name, FChar -> pr "  char %s;\n" name
5651                    | name, FString -> pr "  string %s<>;\n" name
5652                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5653                    | name, FUUID -> pr "  opaque %s[32];\n" name
5654                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5655                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5656                    | name, FOptPercent -> pr "  float %s;\n" name
5657                   ) cols;
5658         pr "};\n";
5659         pr "\n";
5660         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5661         pr "\n";
5662   ) structs;
5663
5664   List.iter (
5665     fun (shortname, style, _, _, _, _, _) ->
5666       let name = "guestfs_" ^ shortname in
5667
5668       (match snd style with
5669        | [] -> ()
5670        | args ->
5671            pr "struct %s_args {\n" name;
5672            List.iter (
5673              function
5674              | Pathname n | Device n | Dev_or_Path n | String n ->
5675                  pr "  string %s<>;\n" n
5676              | OptString n -> pr "  str *%s;\n" n
5677              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5678              | Bool n -> pr "  bool %s;\n" n
5679              | Int n -> pr "  int %s;\n" n
5680              | Int64 n -> pr "  hyper %s;\n" n
5681              | BufferIn n ->
5682                  pr "  opaque %s<>;\n" n
5683              | FileIn _ | FileOut _ -> ()
5684            ) args;
5685            pr "};\n\n"
5686       );
5687       (match fst style with
5688        | RErr -> ()
5689        | RInt n ->
5690            pr "struct %s_ret {\n" name;
5691            pr "  int %s;\n" n;
5692            pr "};\n\n"
5693        | RInt64 n ->
5694            pr "struct %s_ret {\n" name;
5695            pr "  hyper %s;\n" n;
5696            pr "};\n\n"
5697        | RBool n ->
5698            pr "struct %s_ret {\n" name;
5699            pr "  bool %s;\n" n;
5700            pr "};\n\n"
5701        | RConstString _ | RConstOptString _ ->
5702            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5703        | RString n ->
5704            pr "struct %s_ret {\n" name;
5705            pr "  string %s<>;\n" n;
5706            pr "};\n\n"
5707        | RStringList n ->
5708            pr "struct %s_ret {\n" name;
5709            pr "  str %s<>;\n" n;
5710            pr "};\n\n"
5711        | RStruct (n, typ) ->
5712            pr "struct %s_ret {\n" name;
5713            pr "  guestfs_int_%s %s;\n" typ n;
5714            pr "};\n\n"
5715        | RStructList (n, typ) ->
5716            pr "struct %s_ret {\n" name;
5717            pr "  guestfs_int_%s_list %s;\n" typ n;
5718            pr "};\n\n"
5719        | RHashtable n ->
5720            pr "struct %s_ret {\n" name;
5721            pr "  str %s<>;\n" n;
5722            pr "};\n\n"
5723        | RBufferOut n ->
5724            pr "struct %s_ret {\n" name;
5725            pr "  opaque %s<>;\n" n;
5726            pr "};\n\n"
5727       );
5728   ) daemon_functions;
5729
5730   (* Table of procedure numbers. *)
5731   pr "enum guestfs_procedure {\n";
5732   List.iter (
5733     fun (shortname, _, proc_nr, _, _, _, _) ->
5734       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5735   ) daemon_functions;
5736   pr "  GUESTFS_PROC_NR_PROCS\n";
5737   pr "};\n";
5738   pr "\n";
5739
5740   (* Having to choose a maximum message size is annoying for several
5741    * reasons (it limits what we can do in the API), but it (a) makes
5742    * the protocol a lot simpler, and (b) provides a bound on the size
5743    * of the daemon which operates in limited memory space.
5744    *)
5745   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5746   pr "\n";
5747
5748   (* Message header, etc. *)
5749   pr "\
5750 /* The communication protocol is now documented in the guestfs(3)
5751  * manpage.
5752  */
5753
5754 const GUESTFS_PROGRAM = 0x2000F5F5;
5755 const GUESTFS_PROTOCOL_VERSION = 1;
5756
5757 /* These constants must be larger than any possible message length. */
5758 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5759 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5760
5761 enum guestfs_message_direction {
5762   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5763   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5764 };
5765
5766 enum guestfs_message_status {
5767   GUESTFS_STATUS_OK = 0,
5768   GUESTFS_STATUS_ERROR = 1
5769 };
5770
5771 const GUESTFS_ERROR_LEN = 256;
5772
5773 struct guestfs_message_error {
5774   string error_message<GUESTFS_ERROR_LEN>;
5775 };
5776
5777 struct guestfs_message_header {
5778   unsigned prog;                     /* GUESTFS_PROGRAM */
5779   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5780   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5781   guestfs_message_direction direction;
5782   unsigned serial;                   /* message serial number */
5783   guestfs_message_status status;
5784 };
5785
5786 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5787
5788 struct guestfs_chunk {
5789   int cancel;                        /* if non-zero, transfer is cancelled */
5790   /* data size is 0 bytes if the transfer has finished successfully */
5791   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5792 };
5793 "
5794
5795 (* Generate the guestfs-structs.h file. *)
5796 and generate_structs_h () =
5797   generate_header CStyle LGPLv2plus;
5798
5799   (* This is a public exported header file containing various
5800    * structures.  The structures are carefully written to have
5801    * exactly the same in-memory format as the XDR structures that
5802    * we use on the wire to the daemon.  The reason for creating
5803    * copies of these structures here is just so we don't have to
5804    * export the whole of guestfs_protocol.h (which includes much
5805    * unrelated and XDR-dependent stuff that we don't want to be
5806    * public, or required by clients).
5807    *
5808    * To reiterate, we will pass these structures to and from the
5809    * client with a simple assignment or memcpy, so the format
5810    * must be identical to what rpcgen / the RFC defines.
5811    *)
5812
5813   (* Public structures. *)
5814   List.iter (
5815     fun (typ, cols) ->
5816       pr "struct guestfs_%s {\n" typ;
5817       List.iter (
5818         function
5819         | name, FChar -> pr "  char %s;\n" name
5820         | name, FString -> pr "  char *%s;\n" name
5821         | name, FBuffer ->
5822             pr "  uint32_t %s_len;\n" name;
5823             pr "  char *%s;\n" name
5824         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5825         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5826         | name, FInt32 -> pr "  int32_t %s;\n" name
5827         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5828         | name, FInt64 -> pr "  int64_t %s;\n" name
5829         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5830       ) cols;
5831       pr "};\n";
5832       pr "\n";
5833       pr "struct guestfs_%s_list {\n" typ;
5834       pr "  uint32_t len;\n";
5835       pr "  struct guestfs_%s *val;\n" typ;
5836       pr "};\n";
5837       pr "\n";
5838       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5839       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5840       pr "\n"
5841   ) structs
5842
5843 (* Generate the guestfs-actions.h file. *)
5844 and generate_actions_h () =
5845   generate_header CStyle LGPLv2plus;
5846   List.iter (
5847     fun (shortname, style, _, _, _, _, _) ->
5848       let name = "guestfs_" ^ shortname in
5849       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5850         name style
5851   ) all_functions
5852
5853 (* Generate the guestfs-internal-actions.h file. *)
5854 and generate_internal_actions_h () =
5855   generate_header CStyle LGPLv2plus;
5856   List.iter (
5857     fun (shortname, style, _, _, _, _, _) ->
5858       let name = "guestfs__" ^ shortname in
5859       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5860         name style
5861   ) non_daemon_functions
5862
5863 (* Generate the client-side dispatch stubs. *)
5864 and generate_client_actions () =
5865   generate_header CStyle LGPLv2plus;
5866
5867   pr "\
5868 #include <stdio.h>
5869 #include <stdlib.h>
5870 #include <stdint.h>
5871 #include <string.h>
5872 #include <inttypes.h>
5873
5874 #include \"guestfs.h\"
5875 #include \"guestfs-internal.h\"
5876 #include \"guestfs-internal-actions.h\"
5877 #include \"guestfs_protocol.h\"
5878
5879 #define error guestfs_error
5880 //#define perrorf guestfs_perrorf
5881 #define safe_malloc guestfs_safe_malloc
5882 #define safe_realloc guestfs_safe_realloc
5883 //#define safe_strdup guestfs_safe_strdup
5884 #define safe_memdup guestfs_safe_memdup
5885
5886 /* Check the return message from a call for validity. */
5887 static int
5888 check_reply_header (guestfs_h *g,
5889                     const struct guestfs_message_header *hdr,
5890                     unsigned int proc_nr, unsigned int serial)
5891 {
5892   if (hdr->prog != GUESTFS_PROGRAM) {
5893     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5894     return -1;
5895   }
5896   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5897     error (g, \"wrong protocol version (%%d/%%d)\",
5898            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5899     return -1;
5900   }
5901   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5902     error (g, \"unexpected message direction (%%d/%%d)\",
5903            hdr->direction, GUESTFS_DIRECTION_REPLY);
5904     return -1;
5905   }
5906   if (hdr->proc != proc_nr) {
5907     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5908     return -1;
5909   }
5910   if (hdr->serial != serial) {
5911     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5912     return -1;
5913   }
5914
5915   return 0;
5916 }
5917
5918 /* Check we are in the right state to run a high-level action. */
5919 static int
5920 check_state (guestfs_h *g, const char *caller)
5921 {
5922   if (!guestfs__is_ready (g)) {
5923     if (guestfs__is_config (g) || guestfs__is_launching (g))
5924       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5925         caller);
5926     else
5927       error (g, \"%%s called from the wrong state, %%d != READY\",
5928         caller, guestfs__get_state (g));
5929     return -1;
5930   }
5931   return 0;
5932 }
5933
5934 ";
5935
5936   let error_code_of = function
5937     | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5938     | RConstString _ | RConstOptString _
5939     | RString _ | RStringList _
5940     | RStruct _ | RStructList _
5941     | RHashtable _ | RBufferOut _ -> "NULL"
5942   in
5943
5944   (* Generate code to check String-like parameters are not passed in
5945    * as NULL (returning an error if they are).
5946    *)
5947   let check_null_strings shortname style =
5948     let pr_newline = ref false in
5949     List.iter (
5950       function
5951       (* parameters which should not be NULL *)
5952       | String n
5953       | Device n
5954       | Pathname n
5955       | Dev_or_Path n
5956       | FileIn n
5957       | FileOut n
5958       | BufferIn n
5959       | StringList n
5960       | DeviceList n ->
5961           pr "  if (%s == NULL) {\n" n;
5962           pr "    error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
5963           pr "           \"%s\", \"%s\");\n" shortname n;
5964           pr "    return %s;\n" (error_code_of (fst style));
5965           pr "  }\n";
5966           pr_newline := true
5967
5968       (* can be NULL *)
5969       | OptString _
5970
5971       (* not applicable *)
5972       | Bool _
5973       | Int _
5974       | Int64 _ -> ()
5975     ) (snd style);
5976
5977     if !pr_newline then pr "\n";
5978   in
5979
5980   (* Generate code to generate guestfish call traces. *)
5981   let trace_call shortname style =
5982     pr "  if (guestfs__get_trace (g)) {\n";
5983
5984     let needs_i =
5985       List.exists (function
5986                    | StringList _ | DeviceList _ -> true
5987                    | _ -> false) (snd style) in
5988     if needs_i then (
5989       pr "    int i;\n";
5990       pr "\n"
5991     );
5992
5993     pr "    printf (\"%s\");\n" shortname;
5994     List.iter (
5995       function
5996       | String n                        (* strings *)
5997       | Device n
5998       | Pathname n
5999       | Dev_or_Path n
6000       | FileIn n
6001       | FileOut n
6002       | BufferIn n ->
6003           (* guestfish doesn't support string escaping, so neither do we *)
6004           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
6005       | OptString n ->                  (* string option *)
6006           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
6007           pr "    else printf (\" null\");\n"
6008       | StringList n
6009       | DeviceList n ->                 (* string list *)
6010           pr "    putchar (' ');\n";
6011           pr "    putchar ('\"');\n";
6012           pr "    for (i = 0; %s[i]; ++i) {\n" n;
6013           pr "      if (i > 0) putchar (' ');\n";
6014           pr "      fputs (%s[i], stdout);\n" n;
6015           pr "    }\n";
6016           pr "    putchar ('\"');\n";
6017       | Bool n ->                       (* boolean *)
6018           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
6019       | Int n ->                        (* int *)
6020           pr "    printf (\" %%d\", %s);\n" n
6021       | Int64 n ->
6022           pr "    printf (\" %%\" PRIi64, %s);\n" n
6023     ) (snd style);
6024     pr "    putchar ('\\n');\n";
6025     pr "  }\n";
6026     pr "\n";
6027   in
6028
6029   (* For non-daemon functions, generate a wrapper around each function. *)
6030   List.iter (
6031     fun (shortname, style, _, _, _, _, _) ->
6032       let name = "guestfs_" ^ shortname in
6033
6034       generate_prototype ~extern:false ~semicolon:false ~newline:true
6035         ~handle:"g" name style;
6036       pr "{\n";
6037       check_null_strings shortname style;
6038       trace_call shortname style;
6039       pr "  return guestfs__%s " shortname;
6040       generate_c_call_args ~handle:"g" style;
6041       pr ";\n";
6042       pr "}\n";
6043       pr "\n"
6044   ) non_daemon_functions;
6045
6046   (* Client-side stubs for each function. *)
6047   List.iter (
6048     fun (shortname, style, _, _, _, _, _) ->
6049       let name = "guestfs_" ^ shortname in
6050       let error_code = error_code_of (fst style) in
6051
6052       (* Generate the action stub. *)
6053       generate_prototype ~extern:false ~semicolon:false ~newline:true
6054         ~handle:"g" name style;
6055
6056       pr "{\n";
6057
6058       (match snd style with
6059        | [] -> ()
6060        | _ -> pr "  struct %s_args args;\n" name
6061       );
6062
6063       pr "  guestfs_message_header hdr;\n";
6064       pr "  guestfs_message_error err;\n";
6065       let has_ret =
6066         match fst style with
6067         | RErr -> false
6068         | RConstString _ | RConstOptString _ ->
6069             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6070         | RInt _ | RInt64 _
6071         | RBool _ | RString _ | RStringList _
6072         | RStruct _ | RStructList _
6073         | RHashtable _ | RBufferOut _ ->
6074             pr "  struct %s_ret ret;\n" name;
6075             true in
6076
6077       pr "  int serial;\n";
6078       pr "  int r;\n";
6079       pr "\n";
6080       check_null_strings shortname style;
6081       trace_call shortname style;
6082       pr "  if (check_state (g, \"%s\") == -1) return %s;\n"
6083         shortname error_code;
6084       pr "  guestfs___set_busy (g);\n";
6085       pr "\n";
6086
6087       (* Send the main header and arguments. *)
6088       (match snd style with
6089        | [] ->
6090            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
6091              (String.uppercase shortname)
6092        | args ->
6093            List.iter (
6094              function
6095              | Pathname n | Device n | Dev_or_Path n | String n ->
6096                  pr "  args.%s = (char *) %s;\n" n n
6097              | OptString n ->
6098                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
6099              | StringList n | DeviceList n ->
6100                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
6101                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
6102              | Bool n ->
6103                  pr "  args.%s = %s;\n" n n
6104              | Int n ->
6105                  pr "  args.%s = %s;\n" n n
6106              | Int64 n ->
6107                  pr "  args.%s = %s;\n" n n
6108              | FileIn _ | FileOut _ -> ()
6109              | BufferIn n ->
6110                  pr "  /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
6111                  pr "  if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
6112                  pr "    error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
6113                    shortname;
6114                  pr "    guestfs___end_busy (g);\n";
6115                  pr "    return %s;\n" error_code;
6116                  pr "  }\n";
6117                  pr "  args.%s.%s_val = (char *) %s;\n" n n n;
6118                  pr "  args.%s.%s_len = %s_size;\n" n n n
6119            ) args;
6120            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
6121              (String.uppercase shortname);
6122            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
6123              name;
6124       );
6125       pr "  if (serial == -1) {\n";
6126       pr "    guestfs___end_busy (g);\n";
6127       pr "    return %s;\n" error_code;
6128       pr "  }\n";
6129       pr "\n";
6130
6131       (* Send any additional files (FileIn) requested. *)
6132       let need_read_reply_label = ref false in
6133       List.iter (
6134         function
6135         | FileIn n ->
6136             pr "  r = guestfs___send_file (g, %s);\n" n;
6137             pr "  if (r == -1) {\n";
6138             pr "    guestfs___end_busy (g);\n";
6139             pr "    return %s;\n" error_code;
6140             pr "  }\n";
6141             pr "  if (r == -2) /* daemon cancelled */\n";
6142             pr "    goto read_reply;\n";
6143             need_read_reply_label := true;
6144             pr "\n";
6145         | _ -> ()
6146       ) (snd style);
6147
6148       (* Wait for the reply from the remote end. *)
6149       if !need_read_reply_label then pr " read_reply:\n";
6150       pr "  memset (&hdr, 0, sizeof hdr);\n";
6151       pr "  memset (&err, 0, sizeof err);\n";
6152       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
6153       pr "\n";
6154       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
6155       if not has_ret then
6156         pr "NULL, NULL"
6157       else
6158         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
6159       pr ");\n";
6160
6161       pr "  if (r == -1) {\n";
6162       pr "    guestfs___end_busy (g);\n";
6163       pr "    return %s;\n" error_code;
6164       pr "  }\n";
6165       pr "\n";
6166
6167       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
6168         (String.uppercase shortname);
6169       pr "    guestfs___end_busy (g);\n";
6170       pr "    return %s;\n" error_code;
6171       pr "  }\n";
6172       pr "\n";
6173
6174       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
6175       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
6176       pr "    free (err.error_message);\n";
6177       pr "    guestfs___end_busy (g);\n";
6178       pr "    return %s;\n" error_code;
6179       pr "  }\n";
6180       pr "\n";
6181
6182       (* Expecting to receive further files (FileOut)? *)
6183       List.iter (
6184         function
6185         | FileOut n ->
6186             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
6187             pr "    guestfs___end_busy (g);\n";
6188             pr "    return %s;\n" error_code;
6189             pr "  }\n";
6190             pr "\n";
6191         | _ -> ()
6192       ) (snd style);
6193
6194       pr "  guestfs___end_busy (g);\n";
6195
6196       (match fst style with
6197        | RErr -> pr "  return 0;\n"
6198        | RInt n | RInt64 n | RBool n ->
6199            pr "  return ret.%s;\n" n
6200        | RConstString _ | RConstOptString _ ->
6201            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6202        | RString n ->
6203            pr "  return ret.%s; /* caller will free */\n" n
6204        | RStringList n | RHashtable n ->
6205            pr "  /* caller will free this, but we need to add a NULL entry */\n";
6206            pr "  ret.%s.%s_val =\n" n n;
6207            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
6208            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
6209              n n;
6210            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
6211            pr "  return ret.%s.%s_val;\n" n n
6212        | RStruct (n, _) ->
6213            pr "  /* caller will free this */\n";
6214            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
6215        | RStructList (n, _) ->
6216            pr "  /* caller will free this */\n";
6217            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
6218        | RBufferOut n ->
6219            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
6220            pr "   * _val might be NULL here.  To make the API saner for\n";
6221            pr "   * callers, we turn this case into a unique pointer (using\n";
6222            pr "   * malloc(1)).\n";
6223            pr "   */\n";
6224            pr "  if (ret.%s.%s_len > 0) {\n" n n;
6225            pr "    *size_r = ret.%s.%s_len;\n" n n;
6226            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
6227            pr "  } else {\n";
6228            pr "    free (ret.%s.%s_val);\n" n n;
6229            pr "    char *p = safe_malloc (g, 1);\n";
6230            pr "    *size_r = ret.%s.%s_len;\n" n n;
6231            pr "    return p;\n";
6232            pr "  }\n";
6233       );
6234
6235       pr "}\n\n"
6236   ) daemon_functions;
6237
6238   (* Functions to free structures. *)
6239   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
6240   pr " * structure format is identical to the XDR format.  See note in\n";
6241   pr " * generator.ml.\n";
6242   pr " */\n";
6243   pr "\n";
6244
6245   List.iter (
6246     fun (typ, _) ->
6247       pr "void\n";
6248       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
6249       pr "{\n";
6250       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
6251       pr "  free (x);\n";
6252       pr "}\n";
6253       pr "\n";
6254
6255       pr "void\n";
6256       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
6257       pr "{\n";
6258       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
6259       pr "  free (x);\n";
6260       pr "}\n";
6261       pr "\n";
6262
6263   ) structs;
6264
6265 (* Generate daemon/actions.h. *)
6266 and generate_daemon_actions_h () =
6267   generate_header CStyle GPLv2plus;
6268
6269   pr "#include \"../src/guestfs_protocol.h\"\n";
6270   pr "\n";
6271
6272   List.iter (
6273     fun (name, style, _, _, _, _, _) ->
6274       generate_prototype
6275         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
6276         name style;
6277   ) daemon_functions
6278
6279 (* Generate the linker script which controls the visibility of
6280  * symbols in the public ABI and ensures no other symbols get
6281  * exported accidentally.
6282  *)
6283 and generate_linker_script () =
6284   generate_header HashStyle GPLv2plus;
6285
6286   let globals = [
6287     "guestfs_create";
6288     "guestfs_close";
6289     "guestfs_get_error_handler";
6290     "guestfs_get_out_of_memory_handler";
6291     "guestfs_last_error";
6292     "guestfs_set_error_handler";
6293     "guestfs_set_launch_done_callback";
6294     "guestfs_set_log_message_callback";
6295     "guestfs_set_out_of_memory_handler";
6296     "guestfs_set_subprocess_quit_callback";
6297
6298     (* Unofficial parts of the API: the bindings code use these
6299      * functions, so it is useful to export them.
6300      *)
6301     "guestfs_safe_calloc";
6302     "guestfs_safe_malloc";
6303   ] in
6304   let functions =
6305     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
6306       all_functions in
6307   let structs =
6308     List.concat (
6309       List.map (fun (typ, _) ->
6310                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
6311         structs
6312     ) in
6313   let globals = List.sort compare (globals @ functions @ structs) in
6314
6315   pr "{\n";
6316   pr "    global:\n";
6317   List.iter (pr "        %s;\n") globals;
6318   pr "\n";
6319
6320   pr "    local:\n";
6321   pr "        *;\n";
6322   pr "};\n"
6323
6324 (* Generate the server-side stubs. *)
6325 and generate_daemon_actions () =
6326   generate_header CStyle GPLv2plus;
6327
6328   pr "#include <config.h>\n";
6329   pr "\n";
6330   pr "#include <stdio.h>\n";
6331   pr "#include <stdlib.h>\n";
6332   pr "#include <string.h>\n";
6333   pr "#include <inttypes.h>\n";
6334   pr "#include <rpc/types.h>\n";
6335   pr "#include <rpc/xdr.h>\n";
6336   pr "\n";
6337   pr "#include \"daemon.h\"\n";
6338   pr "#include \"c-ctype.h\"\n";
6339   pr "#include \"../src/guestfs_protocol.h\"\n";
6340   pr "#include \"actions.h\"\n";
6341   pr "\n";
6342
6343   List.iter (
6344     fun (name, style, _, _, _, _, _) ->
6345       (* Generate server-side stubs. *)
6346       pr "static void %s_stub (XDR *xdr_in)\n" name;
6347       pr "{\n";
6348       let error_code =
6349         match fst style with
6350         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6351         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6352         | RBool _ -> pr "  int r;\n"; "-1"
6353         | RConstString _ | RConstOptString _ ->
6354             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6355         | RString _ -> pr "  char *r;\n"; "NULL"
6356         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6357         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6358         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6359         | RBufferOut _ ->
6360             pr "  size_t size = 1;\n";
6361             pr "  char *r;\n";
6362             "NULL" in
6363
6364       (match snd style with
6365        | [] -> ()
6366        | args ->
6367            pr "  struct guestfs_%s_args args;\n" name;
6368            List.iter (
6369              function
6370              | Device n | Dev_or_Path n
6371              | Pathname n
6372              | String n -> ()
6373              | OptString n -> pr "  char *%s;\n" n
6374              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6375              | Bool n -> pr "  int %s;\n" n
6376              | Int n -> pr "  int %s;\n" n
6377              | Int64 n -> pr "  int64_t %s;\n" n
6378              | FileIn _ | FileOut _ -> ()
6379              | BufferIn n ->
6380                  pr "  const char *%s;\n" n;
6381                  pr "  size_t %s_size;\n" n
6382            ) args
6383       );
6384       pr "\n";
6385
6386       let is_filein =
6387         List.exists (function FileIn _ -> true | _ -> false) (snd style) in
6388
6389       (match snd style with
6390        | [] -> ()
6391        | args ->
6392            pr "  memset (&args, 0, sizeof args);\n";
6393            pr "\n";
6394            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6395            if is_filein then
6396              pr "    if (cancel_receive () != -2)\n";
6397            pr "      reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6398            pr "    goto done;\n";
6399            pr "  }\n";
6400            let pr_args n =
6401              pr "  char *%s = args.%s;\n" n n
6402            in
6403            let pr_list_handling_code n =
6404              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6405              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6406              pr "  if (%s == NULL) {\n" n;
6407              if is_filein then
6408                pr "    if (cancel_receive () != -2)\n";
6409              pr "      reply_with_perror (\"realloc\");\n";
6410              pr "    goto done;\n";
6411              pr "  }\n";
6412              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6413              pr "  args.%s.%s_val = %s;\n" n n n;
6414            in
6415            List.iter (
6416              function
6417              | Pathname n ->
6418                  pr_args n;
6419                  pr "  ABS_PATH (%s, %s, goto done);\n"
6420                    n (if is_filein then "cancel_receive ()" else "0");
6421              | Device n ->
6422                  pr_args n;
6423                  pr "  RESOLVE_DEVICE (%s, %s, goto done);\n"
6424                    n (if is_filein then "cancel_receive ()" else "0");
6425              | Dev_or_Path n ->
6426                  pr_args n;
6427                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, %s, goto done);\n"
6428                    n (if is_filein then "cancel_receive ()" else "0");
6429              | String n -> pr_args n
6430              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6431              | StringList n ->
6432                  pr_list_handling_code n;
6433              | DeviceList n ->
6434                  pr_list_handling_code n;
6435                  pr "  /* Ensure that each is a device,\n";
6436                  pr "   * and perform device name translation. */\n";
6437                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
6438                  pr "    RESOLVE_DEVICE (physvols[pvi], %s, goto done);\n"
6439                    (if is_filein then "cancel_receive ()" else "0");
6440                  pr "  }\n";
6441              | Bool n -> pr "  %s = args.%s;\n" n n
6442              | Int n -> pr "  %s = args.%s;\n" n n
6443              | Int64 n -> pr "  %s = args.%s;\n" n n
6444              | FileIn _ | FileOut _ -> ()
6445              | BufferIn n ->
6446                  pr "  %s = args.%s.%s_val;\n" n n n;
6447                  pr "  %s_size = args.%s.%s_len;\n" n n n
6448            ) args;
6449            pr "\n"
6450       );
6451
6452       (* this is used at least for do_equal *)
6453       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6454         (* Emit NEED_ROOT just once, even when there are two or
6455            more Pathname args *)
6456         pr "  NEED_ROOT (%s, goto done);\n"
6457           (if is_filein then "cancel_receive ()" else "0");
6458       );
6459
6460       (* Don't want to call the impl with any FileIn or FileOut
6461        * parameters, since these go "outside" the RPC protocol.
6462        *)
6463       let args' =
6464         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6465           (snd style) in
6466       pr "  r = do_%s " name;
6467       generate_c_call_args (fst style, args');
6468       pr ";\n";
6469
6470       (match fst style with
6471        | RErr | RInt _ | RInt64 _ | RBool _
6472        | RConstString _ | RConstOptString _
6473        | RString _ | RStringList _ | RHashtable _
6474        | RStruct (_, _) | RStructList (_, _) ->
6475            pr "  if (r == %s)\n" error_code;
6476            pr "    /* do_%s has already called reply_with_error */\n" name;
6477            pr "    goto done;\n";
6478            pr "\n"
6479        | RBufferOut _ ->
6480            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6481            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6482            pr "   */\n";
6483            pr "  if (size == 1 && r == %s)\n" error_code;
6484            pr "    /* do_%s has already called reply_with_error */\n" name;
6485            pr "    goto done;\n";
6486            pr "\n"
6487       );
6488
6489       (* If there are any FileOut parameters, then the impl must
6490        * send its own reply.
6491        *)
6492       let no_reply =
6493         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6494       if no_reply then
6495         pr "  /* do_%s has already sent a reply */\n" name
6496       else (
6497         match fst style with
6498         | RErr -> pr "  reply (NULL, NULL);\n"
6499         | RInt n | RInt64 n | RBool n ->
6500             pr "  struct guestfs_%s_ret ret;\n" name;
6501             pr "  ret.%s = r;\n" n;
6502             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6503               name
6504         | RConstString _ | RConstOptString _ ->
6505             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6506         | RString n ->
6507             pr "  struct guestfs_%s_ret ret;\n" name;
6508             pr "  ret.%s = r;\n" n;
6509             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6510               name;
6511             pr "  free (r);\n"
6512         | RStringList n | RHashtable n ->
6513             pr "  struct guestfs_%s_ret ret;\n" name;
6514             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6515             pr "  ret.%s.%s_val = r;\n" n n;
6516             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6517               name;
6518             pr "  free_strings (r);\n"
6519         | RStruct (n, _) ->
6520             pr "  struct guestfs_%s_ret ret;\n" name;
6521             pr "  ret.%s = *r;\n" n;
6522             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6523               name;
6524             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6525               name
6526         | RStructList (n, _) ->
6527             pr "  struct guestfs_%s_ret ret;\n" name;
6528             pr "  ret.%s = *r;\n" n;
6529             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6530               name;
6531             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6532               name
6533         | RBufferOut n ->
6534             pr "  struct guestfs_%s_ret ret;\n" name;
6535             pr "  ret.%s.%s_val = r;\n" n n;
6536             pr "  ret.%s.%s_len = size;\n" n n;
6537             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6538               name;
6539             pr "  free (r);\n"
6540       );
6541
6542       (* Free the args. *)
6543       pr "done:\n";
6544       (match snd style with
6545        | [] -> ()
6546        | _ ->
6547            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6548              name
6549       );
6550       pr "  return;\n";
6551       pr "}\n\n";
6552   ) daemon_functions;
6553
6554   (* Dispatch function. *)
6555   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6556   pr "{\n";
6557   pr "  switch (proc_nr) {\n";
6558
6559   List.iter (
6560     fun (name, style, _, _, _, _, _) ->
6561       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6562       pr "      %s_stub (xdr_in);\n" name;
6563       pr "      break;\n"
6564   ) daemon_functions;
6565
6566   pr "    default:\n";
6567   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";
6568   pr "  }\n";
6569   pr "}\n";
6570   pr "\n";
6571
6572   (* LVM columns and tokenization functions. *)
6573   (* XXX This generates crap code.  We should rethink how we
6574    * do this parsing.
6575    *)
6576   List.iter (
6577     function
6578     | typ, cols ->
6579         pr "static const char *lvm_%s_cols = \"%s\";\n"
6580           typ (String.concat "," (List.map fst cols));
6581         pr "\n";
6582
6583         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6584         pr "{\n";
6585         pr "  char *tok, *p, *next;\n";
6586         pr "  int i, j;\n";
6587         pr "\n";
6588         (*
6589           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6590           pr "\n";
6591         *)
6592         pr "  if (!str) {\n";
6593         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6594         pr "    return -1;\n";
6595         pr "  }\n";
6596         pr "  if (!*str || c_isspace (*str)) {\n";
6597         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6598         pr "    return -1;\n";
6599         pr "  }\n";
6600         pr "  tok = str;\n";
6601         List.iter (
6602           fun (name, coltype) ->
6603             pr "  if (!tok) {\n";
6604             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6605             pr "    return -1;\n";
6606             pr "  }\n";
6607             pr "  p = strchrnul (tok, ',');\n";
6608             pr "  if (*p) next = p+1; else next = NULL;\n";
6609             pr "  *p = '\\0';\n";
6610             (match coltype with
6611              | FString ->
6612                  pr "  r->%s = strdup (tok);\n" name;
6613                  pr "  if (r->%s == NULL) {\n" name;
6614                  pr "    perror (\"strdup\");\n";
6615                  pr "    return -1;\n";
6616                  pr "  }\n"
6617              | FUUID ->
6618                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6619                  pr "    if (tok[j] == '\\0') {\n";
6620                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6621                  pr "      return -1;\n";
6622                  pr "    } else if (tok[j] != '-')\n";
6623                  pr "      r->%s[i++] = tok[j];\n" name;
6624                  pr "  }\n";
6625              | FBytes ->
6626                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6627                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6628                  pr "    return -1;\n";
6629                  pr "  }\n";
6630              | FInt64 ->
6631                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6632                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6633                  pr "    return -1;\n";
6634                  pr "  }\n";
6635              | FOptPercent ->
6636                  pr "  if (tok[0] == '\\0')\n";
6637                  pr "    r->%s = -1;\n" name;
6638                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6639                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6640                  pr "    return -1;\n";
6641                  pr "  }\n";
6642              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6643                  assert false (* can never be an LVM column *)
6644             );
6645             pr "  tok = next;\n";
6646         ) cols;
6647
6648         pr "  if (tok != NULL) {\n";
6649         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6650         pr "    return -1;\n";
6651         pr "  }\n";
6652         pr "  return 0;\n";
6653         pr "}\n";
6654         pr "\n";
6655
6656         pr "guestfs_int_lvm_%s_list *\n" typ;
6657         pr "parse_command_line_%ss (void)\n" typ;
6658         pr "{\n";
6659         pr "  char *out, *err;\n";
6660         pr "  char *p, *pend;\n";
6661         pr "  int r, i;\n";
6662         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6663         pr "  void *newp;\n";
6664         pr "\n";
6665         pr "  ret = malloc (sizeof *ret);\n";
6666         pr "  if (!ret) {\n";
6667         pr "    reply_with_perror (\"malloc\");\n";
6668         pr "    return NULL;\n";
6669         pr "  }\n";
6670         pr "\n";
6671         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6672         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6673         pr "\n";
6674         pr "  r = command (&out, &err,\n";
6675         pr "           \"lvm\", \"%ss\",\n" typ;
6676         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6677         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6678         pr "  if (r == -1) {\n";
6679         pr "    reply_with_error (\"%%s\", err);\n";
6680         pr "    free (out);\n";
6681         pr "    free (err);\n";
6682         pr "    free (ret);\n";
6683         pr "    return NULL;\n";
6684         pr "  }\n";
6685         pr "\n";
6686         pr "  free (err);\n";
6687         pr "\n";
6688         pr "  /* Tokenize each line of the output. */\n";
6689         pr "  p = out;\n";
6690         pr "  i = 0;\n";
6691         pr "  while (p) {\n";
6692         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6693         pr "    if (pend) {\n";
6694         pr "      *pend = '\\0';\n";
6695         pr "      pend++;\n";
6696         pr "    }\n";
6697         pr "\n";
6698         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6699         pr "      p++;\n";
6700         pr "\n";
6701         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6702         pr "      p = pend;\n";
6703         pr "      continue;\n";
6704         pr "    }\n";
6705         pr "\n";
6706         pr "    /* Allocate some space to store this next entry. */\n";
6707         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6708         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6709         pr "    if (newp == NULL) {\n";
6710         pr "      reply_with_perror (\"realloc\");\n";
6711         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6712         pr "      free (ret);\n";
6713         pr "      free (out);\n";
6714         pr "      return NULL;\n";
6715         pr "    }\n";
6716         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6717         pr "\n";
6718         pr "    /* Tokenize the next entry. */\n";
6719         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6720         pr "    if (r == -1) {\n";
6721         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6722         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6723         pr "      free (ret);\n";
6724         pr "      free (out);\n";
6725         pr "      return NULL;\n";
6726         pr "    }\n";
6727         pr "\n";
6728         pr "    ++i;\n";
6729         pr "    p = pend;\n";
6730         pr "  }\n";
6731         pr "\n";
6732         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6733         pr "\n";
6734         pr "  free (out);\n";
6735         pr "  return ret;\n";
6736         pr "}\n"
6737
6738   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6739
6740 (* Generate a list of function names, for debugging in the daemon.. *)
6741 and generate_daemon_names () =
6742   generate_header CStyle GPLv2plus;
6743
6744   pr "#include <config.h>\n";
6745   pr "\n";
6746   pr "#include \"daemon.h\"\n";
6747   pr "\n";
6748
6749   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6750   pr "const char *function_names[] = {\n";
6751   List.iter (
6752     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6753   ) daemon_functions;
6754   pr "};\n";
6755
6756 (* Generate the optional groups for the daemon to implement
6757  * guestfs_available.
6758  *)
6759 and generate_daemon_optgroups_c () =
6760   generate_header CStyle GPLv2plus;
6761
6762   pr "#include <config.h>\n";
6763   pr "\n";
6764   pr "#include \"daemon.h\"\n";
6765   pr "#include \"optgroups.h\"\n";
6766   pr "\n";
6767
6768   pr "struct optgroup optgroups[] = {\n";
6769   List.iter (
6770     fun (group, _) ->
6771       pr "  { \"%s\", optgroup_%s_available },\n" group group
6772   ) optgroups;
6773   pr "  { NULL, NULL }\n";
6774   pr "};\n"
6775
6776 and generate_daemon_optgroups_h () =
6777   generate_header CStyle GPLv2plus;
6778
6779   List.iter (
6780     fun (group, _) ->
6781       pr "extern int optgroup_%s_available (void);\n" group
6782   ) optgroups
6783
6784 (* Generate the tests. *)
6785 and generate_tests () =
6786   generate_header CStyle GPLv2plus;
6787
6788   pr "\
6789 #include <stdio.h>
6790 #include <stdlib.h>
6791 #include <string.h>
6792 #include <unistd.h>
6793 #include <sys/types.h>
6794 #include <fcntl.h>
6795
6796 #include \"guestfs.h\"
6797 #include \"guestfs-internal.h\"
6798
6799 static guestfs_h *g;
6800 static int suppress_error = 0;
6801
6802 static void print_error (guestfs_h *g, void *data, const char *msg)
6803 {
6804   if (!suppress_error)
6805     fprintf (stderr, \"%%s\\n\", msg);
6806 }
6807
6808 /* FIXME: nearly identical code appears in fish.c */
6809 static void print_strings (char *const *argv)
6810 {
6811   int argc;
6812
6813   for (argc = 0; argv[argc] != NULL; ++argc)
6814     printf (\"\\t%%s\\n\", argv[argc]);
6815 }
6816
6817 /*
6818 static void print_table (char const *const *argv)
6819 {
6820   int i;
6821
6822   for (i = 0; argv[i] != NULL; i += 2)
6823     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6824 }
6825 */
6826
6827 ";
6828
6829   (* Generate a list of commands which are not tested anywhere. *)
6830   pr "static void no_test_warnings (void)\n";
6831   pr "{\n";
6832
6833   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6834   List.iter (
6835     fun (_, _, _, _, tests, _, _) ->
6836       let tests = filter_map (
6837         function
6838         | (_, (Always|If _|Unless _), test) -> Some test
6839         | (_, Disabled, _) -> None
6840       ) tests in
6841       let seq = List.concat (List.map seq_of_test tests) in
6842       let cmds_tested = List.map List.hd seq in
6843       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6844   ) all_functions;
6845
6846   List.iter (
6847     fun (name, _, _, _, _, _, _) ->
6848       if not (Hashtbl.mem hash name) then
6849         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6850   ) all_functions;
6851
6852   pr "}\n";
6853   pr "\n";
6854
6855   (* Generate the actual tests.  Note that we generate the tests
6856    * in reverse order, deliberately, so that (in general) the
6857    * newest tests run first.  This makes it quicker and easier to
6858    * debug them.
6859    *)
6860   let test_names =
6861     List.map (
6862       fun (name, _, _, flags, tests, _, _) ->
6863         mapi (generate_one_test name flags) tests
6864     ) (List.rev all_functions) in
6865   let test_names = List.concat test_names in
6866   let nr_tests = List.length test_names in
6867
6868   pr "\
6869 int main (int argc, char *argv[])
6870 {
6871   char c = 0;
6872   unsigned long int n_failed = 0;
6873   const char *filename;
6874   int fd;
6875   int nr_tests, test_num = 0;
6876
6877   setbuf (stdout, NULL);
6878
6879   no_test_warnings ();
6880
6881   g = guestfs_create ();
6882   if (g == NULL) {
6883     printf (\"guestfs_create FAILED\\n\");
6884     exit (EXIT_FAILURE);
6885   }
6886
6887   guestfs_set_error_handler (g, print_error, NULL);
6888
6889   guestfs_set_path (g, \"../appliance\");
6890
6891   filename = \"test1.img\";
6892   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6893   if (fd == -1) {
6894     perror (filename);
6895     exit (EXIT_FAILURE);
6896   }
6897   if (lseek (fd, %d, SEEK_SET) == -1) {
6898     perror (\"lseek\");
6899     close (fd);
6900     unlink (filename);
6901     exit (EXIT_FAILURE);
6902   }
6903   if (write (fd, &c, 1) == -1) {
6904     perror (\"write\");
6905     close (fd);
6906     unlink (filename);
6907     exit (EXIT_FAILURE);
6908   }
6909   if (close (fd) == -1) {
6910     perror (filename);
6911     unlink (filename);
6912     exit (EXIT_FAILURE);
6913   }
6914   if (guestfs_add_drive (g, filename) == -1) {
6915     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6916     exit (EXIT_FAILURE);
6917   }
6918
6919   filename = \"test2.img\";
6920   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6921   if (fd == -1) {
6922     perror (filename);
6923     exit (EXIT_FAILURE);
6924   }
6925   if (lseek (fd, %d, SEEK_SET) == -1) {
6926     perror (\"lseek\");
6927     close (fd);
6928     unlink (filename);
6929     exit (EXIT_FAILURE);
6930   }
6931   if (write (fd, &c, 1) == -1) {
6932     perror (\"write\");
6933     close (fd);
6934     unlink (filename);
6935     exit (EXIT_FAILURE);
6936   }
6937   if (close (fd) == -1) {
6938     perror (filename);
6939     unlink (filename);
6940     exit (EXIT_FAILURE);
6941   }
6942   if (guestfs_add_drive (g, filename) == -1) {
6943     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6944     exit (EXIT_FAILURE);
6945   }
6946
6947   filename = \"test3.img\";
6948   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6949   if (fd == -1) {
6950     perror (filename);
6951     exit (EXIT_FAILURE);
6952   }
6953   if (lseek (fd, %d, SEEK_SET) == -1) {
6954     perror (\"lseek\");
6955     close (fd);
6956     unlink (filename);
6957     exit (EXIT_FAILURE);
6958   }
6959   if (write (fd, &c, 1) == -1) {
6960     perror (\"write\");
6961     close (fd);
6962     unlink (filename);
6963     exit (EXIT_FAILURE);
6964   }
6965   if (close (fd) == -1) {
6966     perror (filename);
6967     unlink (filename);
6968     exit (EXIT_FAILURE);
6969   }
6970   if (guestfs_add_drive (g, filename) == -1) {
6971     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6972     exit (EXIT_FAILURE);
6973   }
6974
6975   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6976     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6977     exit (EXIT_FAILURE);
6978   }
6979
6980   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6981   alarm (600);
6982
6983   if (guestfs_launch (g) == -1) {
6984     printf (\"guestfs_launch FAILED\\n\");
6985     exit (EXIT_FAILURE);
6986   }
6987
6988   /* Cancel previous alarm. */
6989   alarm (0);
6990
6991   nr_tests = %d;
6992
6993 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6994
6995   iteri (
6996     fun i test_name ->
6997       pr "  test_num++;\n";
6998       pr "  if (guestfs_get_verbose (g))\n";
6999       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
7000       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
7001       pr "  if (%s () == -1) {\n" test_name;
7002       pr "    printf (\"%s FAILED\\n\");\n" test_name;
7003       pr "    n_failed++;\n";
7004       pr "  }\n";
7005   ) test_names;
7006   pr "\n";
7007
7008   pr "  guestfs_close (g);\n";
7009   pr "  unlink (\"test1.img\");\n";
7010   pr "  unlink (\"test2.img\");\n";
7011   pr "  unlink (\"test3.img\");\n";
7012   pr "\n";
7013
7014   pr "  if (n_failed > 0) {\n";
7015   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
7016   pr "    exit (EXIT_FAILURE);\n";
7017   pr "  }\n";
7018   pr "\n";
7019
7020   pr "  exit (EXIT_SUCCESS);\n";
7021   pr "}\n"
7022
7023 and generate_one_test name flags i (init, prereq, test) =
7024   let test_name = sprintf "test_%s_%d" name i in
7025
7026   pr "\
7027 static int %s_skip (void)
7028 {
7029   const char *str;
7030
7031   str = getenv (\"TEST_ONLY\");
7032   if (str)
7033     return strstr (str, \"%s\") == NULL;
7034   str = getenv (\"SKIP_%s\");
7035   if (str && STREQ (str, \"1\")) return 1;
7036   str = getenv (\"SKIP_TEST_%s\");
7037   if (str && STREQ (str, \"1\")) return 1;
7038   return 0;
7039 }
7040
7041 " test_name name (String.uppercase test_name) (String.uppercase name);
7042
7043   (match prereq with
7044    | Disabled | Always -> ()
7045    | If code | Unless code ->
7046        pr "static int %s_prereq (void)\n" test_name;
7047        pr "{\n";
7048        pr "  %s\n" code;
7049        pr "}\n";
7050        pr "\n";
7051   );
7052
7053   pr "\
7054 static int %s (void)
7055 {
7056   if (%s_skip ()) {
7057     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
7058     return 0;
7059   }
7060
7061 " test_name test_name test_name;
7062
7063   (* Optional functions should only be tested if the relevant
7064    * support is available in the daemon.
7065    *)
7066   List.iter (
7067     function
7068     | Optional group ->
7069         pr "  {\n";
7070         pr "    const char *groups[] = { \"%s\", NULL };\n" group;
7071         pr "    int r;\n";
7072         pr "    suppress_error = 1;\n";
7073         pr "    r = guestfs_available (g, (char **) groups);\n";
7074         pr "    suppress_error = 0;\n";
7075         pr "    if (r == -1) {\n";
7076         pr "      printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
7077         pr "      return 0;\n";
7078         pr "    }\n";
7079         pr "  }\n";
7080     | _ -> ()
7081   ) flags;
7082
7083   (match prereq with
7084    | Disabled ->
7085        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
7086    | If _ ->
7087        pr "  if (! %s_prereq ()) {\n" test_name;
7088        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
7089        pr "    return 0;\n";
7090        pr "  }\n";
7091        pr "\n";
7092        generate_one_test_body name i test_name init test;
7093    | Unless _ ->
7094        pr "  if (%s_prereq ()) {\n" test_name;
7095        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
7096        pr "    return 0;\n";
7097        pr "  }\n";
7098        pr "\n";
7099        generate_one_test_body name i test_name init test;
7100    | Always ->
7101        generate_one_test_body name i test_name init test
7102   );
7103
7104   pr "  return 0;\n";
7105   pr "}\n";
7106   pr "\n";
7107   test_name
7108
7109 and generate_one_test_body name i test_name init test =
7110   (match init with
7111    | InitNone (* XXX at some point, InitNone and InitEmpty became
7112                * folded together as the same thing.  Really we should
7113                * make InitNone do nothing at all, but the tests may
7114                * need to be checked to make sure this is OK.
7115                *)
7116    | InitEmpty ->
7117        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
7118        List.iter (generate_test_command_call test_name)
7119          [["blockdev_setrw"; "/dev/sda"];
7120           ["umount_all"];
7121           ["lvm_remove_all"]]
7122    | InitPartition ->
7123        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
7124        List.iter (generate_test_command_call test_name)
7125          [["blockdev_setrw"; "/dev/sda"];
7126           ["umount_all"];
7127           ["lvm_remove_all"];
7128           ["part_disk"; "/dev/sda"; "mbr"]]
7129    | InitBasicFS ->
7130        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
7131        List.iter (generate_test_command_call test_name)
7132          [["blockdev_setrw"; "/dev/sda"];
7133           ["umount_all"];
7134           ["lvm_remove_all"];
7135           ["part_disk"; "/dev/sda"; "mbr"];
7136           ["mkfs"; "ext2"; "/dev/sda1"];
7137           ["mount_options"; ""; "/dev/sda1"; "/"]]
7138    | InitBasicFSonLVM ->
7139        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
7140          test_name;
7141        List.iter (generate_test_command_call test_name)
7142          [["blockdev_setrw"; "/dev/sda"];
7143           ["umount_all"];
7144           ["lvm_remove_all"];
7145           ["part_disk"; "/dev/sda"; "mbr"];
7146           ["pvcreate"; "/dev/sda1"];
7147           ["vgcreate"; "VG"; "/dev/sda1"];
7148           ["lvcreate"; "LV"; "VG"; "8"];
7149           ["mkfs"; "ext2"; "/dev/VG/LV"];
7150           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
7151    | InitISOFS ->
7152        pr "  /* InitISOFS for %s */\n" test_name;
7153        List.iter (generate_test_command_call test_name)
7154          [["blockdev_setrw"; "/dev/sda"];
7155           ["umount_all"];
7156           ["lvm_remove_all"];
7157           ["mount_ro"; "/dev/sdd"; "/"]]
7158   );
7159
7160   let get_seq_last = function
7161     | [] ->
7162         failwithf "%s: you cannot use [] (empty list) when expecting a command"
7163           test_name
7164     | seq ->
7165         let seq = List.rev seq in
7166         List.rev (List.tl seq), List.hd seq
7167   in
7168
7169   match test with
7170   | TestRun seq ->
7171       pr "  /* TestRun for %s (%d) */\n" name i;
7172       List.iter (generate_test_command_call test_name) seq
7173   | TestOutput (seq, expected) ->
7174       pr "  /* TestOutput for %s (%d) */\n" name i;
7175       pr "  const char *expected = \"%s\";\n" (c_quote expected);
7176       let seq, last = get_seq_last seq in
7177       let test () =
7178         pr "    if (STRNEQ (r, expected)) {\n";
7179         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
7180         pr "      return -1;\n";
7181         pr "    }\n"
7182       in
7183       List.iter (generate_test_command_call test_name) seq;
7184       generate_test_command_call ~test test_name last
7185   | TestOutputList (seq, expected) ->
7186       pr "  /* TestOutputList for %s (%d) */\n" name i;
7187       let seq, last = get_seq_last seq in
7188       let test () =
7189         iteri (
7190           fun i str ->
7191             pr "    if (!r[%d]) {\n" i;
7192             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
7193             pr "      print_strings (r);\n";
7194             pr "      return -1;\n";
7195             pr "    }\n";
7196             pr "    {\n";
7197             pr "      const char *expected = \"%s\";\n" (c_quote str);
7198             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
7199             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
7200             pr "        return -1;\n";
7201             pr "      }\n";
7202             pr "    }\n"
7203         ) expected;
7204         pr "    if (r[%d] != NULL) {\n" (List.length expected);
7205         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
7206           test_name;
7207         pr "      print_strings (r);\n";
7208         pr "      return -1;\n";
7209         pr "    }\n"
7210       in
7211       List.iter (generate_test_command_call test_name) seq;
7212       generate_test_command_call ~test test_name last
7213   | TestOutputListOfDevices (seq, expected) ->
7214       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
7215       let seq, last = get_seq_last seq in
7216       let test () =
7217         iteri (
7218           fun i str ->
7219             pr "    if (!r[%d]) {\n" i;
7220             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
7221             pr "      print_strings (r);\n";
7222             pr "      return -1;\n";
7223             pr "    }\n";
7224             pr "    {\n";
7225             pr "      const char *expected = \"%s\";\n" (c_quote str);
7226             pr "      r[%d][5] = 's';\n" i;
7227             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
7228             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
7229             pr "        return -1;\n";
7230             pr "      }\n";
7231             pr "    }\n"
7232         ) expected;
7233         pr "    if (r[%d] != NULL) {\n" (List.length expected);
7234         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
7235           test_name;
7236         pr "      print_strings (r);\n";
7237         pr "      return -1;\n";
7238         pr "    }\n"
7239       in
7240       List.iter (generate_test_command_call test_name) seq;
7241       generate_test_command_call ~test test_name last
7242   | TestOutputInt (seq, expected) ->
7243       pr "  /* TestOutputInt for %s (%d) */\n" name i;
7244       let seq, last = get_seq_last seq in
7245       let test () =
7246         pr "    if (r != %d) {\n" expected;
7247         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
7248           test_name expected;
7249         pr "               (int) r);\n";
7250         pr "      return -1;\n";
7251         pr "    }\n"
7252       in
7253       List.iter (generate_test_command_call test_name) seq;
7254       generate_test_command_call ~test test_name last
7255   | TestOutputIntOp (seq, op, expected) ->
7256       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
7257       let seq, last = get_seq_last seq in
7258       let test () =
7259         pr "    if (! (r %s %d)) {\n" op expected;
7260         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
7261           test_name op expected;
7262         pr "               (int) r);\n";
7263         pr "      return -1;\n";
7264         pr "    }\n"
7265       in
7266       List.iter (generate_test_command_call test_name) seq;
7267       generate_test_command_call ~test test_name last
7268   | TestOutputTrue seq ->
7269       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
7270       let seq, last = get_seq_last seq in
7271       let test () =
7272         pr "    if (!r) {\n";
7273         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
7274           test_name;
7275         pr "      return -1;\n";
7276         pr "    }\n"
7277       in
7278       List.iter (generate_test_command_call test_name) seq;
7279       generate_test_command_call ~test test_name last
7280   | TestOutputFalse seq ->
7281       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
7282       let seq, last = get_seq_last seq in
7283       let test () =
7284         pr "    if (r) {\n";
7285         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
7286           test_name;
7287         pr "      return -1;\n";
7288         pr "    }\n"
7289       in
7290       List.iter (generate_test_command_call test_name) seq;
7291       generate_test_command_call ~test test_name last
7292   | TestOutputLength (seq, expected) ->
7293       pr "  /* TestOutputLength for %s (%d) */\n" name i;
7294       let seq, last = get_seq_last seq in
7295       let test () =
7296         pr "    int j;\n";
7297         pr "    for (j = 0; j < %d; ++j)\n" expected;
7298         pr "      if (r[j] == NULL) {\n";
7299         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
7300           test_name;
7301         pr "        print_strings (r);\n";
7302         pr "        return -1;\n";
7303         pr "      }\n";
7304         pr "    if (r[j] != NULL) {\n";
7305         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
7306           test_name;
7307         pr "      print_strings (r);\n";
7308         pr "      return -1;\n";
7309         pr "    }\n"
7310       in
7311       List.iter (generate_test_command_call test_name) seq;
7312       generate_test_command_call ~test test_name last
7313   | TestOutputBuffer (seq, expected) ->
7314       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
7315       pr "  const char *expected = \"%s\";\n" (c_quote expected);
7316       let seq, last = get_seq_last seq in
7317       let len = String.length expected in
7318       let test () =
7319         pr "    if (size != %d) {\n" len;
7320         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
7321         pr "      return -1;\n";
7322         pr "    }\n";
7323         pr "    if (STRNEQLEN (r, expected, size)) {\n";
7324         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
7325         pr "      return -1;\n";
7326         pr "    }\n"
7327       in
7328       List.iter (generate_test_command_call test_name) seq;
7329       generate_test_command_call ~test test_name last
7330   | TestOutputStruct (seq, checks) ->
7331       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
7332       let seq, last = get_seq_last seq in
7333       let test () =
7334         List.iter (
7335           function
7336           | CompareWithInt (field, expected) ->
7337               pr "    if (r->%s != %d) {\n" field expected;
7338               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
7339                 test_name field expected;
7340               pr "               (int) r->%s);\n" field;
7341               pr "      return -1;\n";
7342               pr "    }\n"
7343           | CompareWithIntOp (field, op, expected) ->
7344               pr "    if (!(r->%s %s %d)) {\n" field op expected;
7345               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
7346                 test_name field op expected;
7347               pr "               (int) r->%s);\n" field;
7348               pr "      return -1;\n";
7349               pr "    }\n"
7350           | CompareWithString (field, expected) ->
7351               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
7352               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
7353                 test_name field expected;
7354               pr "               r->%s);\n" field;
7355               pr "      return -1;\n";
7356               pr "    }\n"
7357           | CompareFieldsIntEq (field1, field2) ->
7358               pr "    if (r->%s != r->%s) {\n" field1 field2;
7359               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7360                 test_name field1 field2;
7361               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7362               pr "      return -1;\n";
7363               pr "    }\n"
7364           | CompareFieldsStrEq (field1, field2) ->
7365               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7366               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7367                 test_name field1 field2;
7368               pr "               r->%s, r->%s);\n" field1 field2;
7369               pr "      return -1;\n";
7370               pr "    }\n"
7371         ) checks
7372       in
7373       List.iter (generate_test_command_call test_name) seq;
7374       generate_test_command_call ~test test_name last
7375   | TestLastFail seq ->
7376       pr "  /* TestLastFail for %s (%d) */\n" name i;
7377       let seq, last = get_seq_last seq in
7378       List.iter (generate_test_command_call test_name) seq;
7379       generate_test_command_call test_name ~expect_error:true last
7380
7381 (* Generate the code to run a command, leaving the result in 'r'.
7382  * If you expect to get an error then you should set expect_error:true.
7383  *)
7384 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7385   match cmd with
7386   | [] -> assert false
7387   | name :: args ->
7388       (* Look up the command to find out what args/ret it has. *)
7389       let style =
7390         try
7391           let _, style, _, _, _, _, _ =
7392             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7393           style
7394         with Not_found ->
7395           failwithf "%s: in test, command %s was not found" test_name name in
7396
7397       if List.length (snd style) <> List.length args then
7398         failwithf "%s: in test, wrong number of args given to %s"
7399           test_name name;
7400
7401       pr "  {\n";
7402
7403       List.iter (
7404         function
7405         | OptString n, "NULL" -> ()
7406         | Pathname n, arg
7407         | Device n, arg
7408         | Dev_or_Path n, arg
7409         | String n, arg
7410         | OptString n, arg ->
7411             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7412         | BufferIn n, arg ->
7413             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7414             pr "    size_t %s_size = %d;\n" n (String.length arg)
7415         | Int _, _
7416         | Int64 _, _
7417         | Bool _, _
7418         | FileIn _, _ | FileOut _, _ -> ()
7419         | StringList n, "" | DeviceList n, "" ->
7420             pr "    const char *const %s[1] = { NULL };\n" n
7421         | StringList n, arg | DeviceList n, arg ->
7422             let strs = string_split " " arg in
7423             iteri (
7424               fun i str ->
7425                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7426             ) strs;
7427             pr "    const char *const %s[] = {\n" n;
7428             iteri (
7429               fun i _ -> pr "      %s_%d,\n" n i
7430             ) strs;
7431             pr "      NULL\n";
7432             pr "    };\n";
7433       ) (List.combine (snd style) args);
7434
7435       let error_code =
7436         match fst style with
7437         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7438         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7439         | RConstString _ | RConstOptString _ ->
7440             pr "    const char *r;\n"; "NULL"
7441         | RString _ -> pr "    char *r;\n"; "NULL"
7442         | RStringList _ | RHashtable _ ->
7443             pr "    char **r;\n";
7444             pr "    int i;\n";
7445             "NULL"
7446         | RStruct (_, typ) ->
7447             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7448         | RStructList (_, typ) ->
7449             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7450         | RBufferOut _ ->
7451             pr "    char *r;\n";
7452             pr "    size_t size;\n";
7453             "NULL" in
7454
7455       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7456       pr "    r = guestfs_%s (g" name;
7457
7458       (* Generate the parameters. *)
7459       List.iter (
7460         function
7461         | OptString _, "NULL" -> pr ", NULL"
7462         | Pathname n, _
7463         | Device n, _ | Dev_or_Path n, _
7464         | String n, _
7465         | OptString n, _ ->
7466             pr ", %s" n
7467         | BufferIn n, _ ->
7468             pr ", %s, %s_size" n n
7469         | FileIn _, arg | FileOut _, arg ->
7470             pr ", \"%s\"" (c_quote arg)
7471         | StringList n, _ | DeviceList n, _ ->
7472             pr ", (char **) %s" n
7473         | Int _, arg ->
7474             let i =
7475               try int_of_string arg
7476               with Failure "int_of_string" ->
7477                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7478             pr ", %d" i
7479         | Int64 _, arg ->
7480             let i =
7481               try Int64.of_string arg
7482               with Failure "int_of_string" ->
7483                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7484             pr ", %Ld" i
7485         | Bool _, arg ->
7486             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7487       ) (List.combine (snd style) args);
7488
7489       (match fst style with
7490        | RBufferOut _ -> pr ", &size"
7491        | _ -> ()
7492       );
7493
7494       pr ");\n";
7495
7496       if not expect_error then
7497         pr "    if (r == %s)\n" error_code
7498       else
7499         pr "    if (r != %s)\n" error_code;
7500       pr "      return -1;\n";
7501
7502       (* Insert the test code. *)
7503       (match test with
7504        | None -> ()
7505        | Some f -> f ()
7506       );
7507
7508       (match fst style with
7509        | RErr | RInt _ | RInt64 _ | RBool _
7510        | RConstString _ | RConstOptString _ -> ()
7511        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7512        | RStringList _ | RHashtable _ ->
7513            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7514            pr "      free (r[i]);\n";
7515            pr "    free (r);\n"
7516        | RStruct (_, typ) ->
7517            pr "    guestfs_free_%s (r);\n" typ
7518        | RStructList (_, typ) ->
7519            pr "    guestfs_free_%s_list (r);\n" typ
7520       );
7521
7522       pr "  }\n"
7523
7524 and c_quote str =
7525   let str = replace_str str "\r" "\\r" in
7526   let str = replace_str str "\n" "\\n" in
7527   let str = replace_str str "\t" "\\t" in
7528   let str = replace_str str "\000" "\\0" in
7529   str
7530
7531 (* Generate a lot of different functions for guestfish. *)
7532 and generate_fish_cmds () =
7533   generate_header CStyle GPLv2plus;
7534
7535   let all_functions =
7536     List.filter (
7537       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7538     ) all_functions in
7539   let all_functions_sorted =
7540     List.filter (
7541       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7542     ) all_functions_sorted in
7543
7544   pr "#include <config.h>\n";
7545   pr "\n";
7546   pr "#include <stdio.h>\n";
7547   pr "#include <stdlib.h>\n";
7548   pr "#include <string.h>\n";
7549   pr "#include <inttypes.h>\n";
7550   pr "\n";
7551   pr "#include <guestfs.h>\n";
7552   pr "#include \"c-ctype.h\"\n";
7553   pr "#include \"full-write.h\"\n";
7554   pr "#include \"xstrtol.h\"\n";
7555   pr "#include \"fish.h\"\n";
7556   pr "\n";
7557   pr "/* Valid suffixes allowed for numbers.  See Gnulib xstrtol function. */\n";
7558   pr "static const char *xstrtol_suffixes = \"0kKMGTPEZY\";\n";
7559   pr "\n";
7560
7561   (* list_commands function, which implements guestfish -h *)
7562   pr "void list_commands (void)\n";
7563   pr "{\n";
7564   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7565   pr "  list_builtin_commands ();\n";
7566   List.iter (
7567     fun (name, _, _, flags, _, shortdesc, _) ->
7568       let name = replace_char name '_' '-' in
7569       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7570         name shortdesc
7571   ) all_functions_sorted;
7572   pr "  printf (\"    %%s\\n\",";
7573   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7574   pr "}\n";
7575   pr "\n";
7576
7577   (* display_command function, which implements guestfish -h cmd *)
7578   pr "int display_command (const char *cmd)\n";
7579   pr "{\n";
7580   List.iter (
7581     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7582       let name2 = replace_char name '_' '-' in
7583       let alias =
7584         try find_map (function FishAlias n -> Some n | _ -> None) flags
7585         with Not_found -> name in
7586       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7587       let synopsis =
7588         match snd style with
7589         | [] -> name2
7590         | args ->
7591             sprintf "%s %s"
7592               name2 (String.concat " " (List.map name_of_argt args)) in
7593
7594       let warnings =
7595         if List.mem ProtocolLimitWarning flags then
7596           ("\n\n" ^ protocol_limit_warning)
7597         else "" in
7598
7599       (* For DangerWillRobinson commands, we should probably have
7600        * guestfish prompt before allowing you to use them (especially
7601        * in interactive mode). XXX
7602        *)
7603       let warnings =
7604         warnings ^
7605           if List.mem DangerWillRobinson flags then
7606             ("\n\n" ^ danger_will_robinson)
7607           else "" in
7608
7609       let warnings =
7610         warnings ^
7611           match deprecation_notice flags with
7612           | None -> ""
7613           | Some txt -> "\n\n" ^ txt in
7614
7615       let describe_alias =
7616         if name <> alias then
7617           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7618         else "" in
7619
7620       pr "  if (";
7621       pr "STRCASEEQ (cmd, \"%s\")" name;
7622       if name <> name2 then
7623         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7624       if name <> alias then
7625         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7626       pr ") {\n";
7627       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7628         name2 shortdesc
7629         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7630          "=head1 DESCRIPTION\n\n" ^
7631          longdesc ^ warnings ^ describe_alias);
7632       pr "    return 0;\n";
7633       pr "  }\n";
7634       pr "  else\n"
7635   ) all_functions;
7636   pr "    return display_builtin_command (cmd);\n";
7637   pr "}\n";
7638   pr "\n";
7639
7640   let emit_print_list_function typ =
7641     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7642       typ typ typ;
7643     pr "{\n";
7644     pr "  unsigned int i;\n";
7645     pr "\n";
7646     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7647     pr "    printf (\"[%%d] = {\\n\", i);\n";
7648     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7649     pr "    printf (\"}\\n\");\n";
7650     pr "  }\n";
7651     pr "}\n";
7652     pr "\n";
7653   in
7654
7655   (* print_* functions *)
7656   List.iter (
7657     fun (typ, cols) ->
7658       let needs_i =
7659         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7660
7661       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7662       pr "{\n";
7663       if needs_i then (
7664         pr "  unsigned int i;\n";
7665         pr "\n"
7666       );
7667       List.iter (
7668         function
7669         | name, FString ->
7670             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7671         | name, FUUID ->
7672             pr "  printf (\"%%s%s: \", indent);\n" name;
7673             pr "  for (i = 0; i < 32; ++i)\n";
7674             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7675             pr "  printf (\"\\n\");\n"
7676         | name, FBuffer ->
7677             pr "  printf (\"%%s%s: \", indent);\n" name;
7678             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7679             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7680             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7681             pr "    else\n";
7682             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7683             pr "  printf (\"\\n\");\n"
7684         | name, (FUInt64|FBytes) ->
7685             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7686               name typ name
7687         | name, FInt64 ->
7688             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7689               name typ name
7690         | name, FUInt32 ->
7691             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7692               name typ name
7693         | name, FInt32 ->
7694             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7695               name typ name
7696         | name, FChar ->
7697             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7698               name typ name
7699         | name, FOptPercent ->
7700             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7701               typ name name typ name;
7702             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7703       ) cols;
7704       pr "}\n";
7705       pr "\n";
7706   ) structs;
7707
7708   (* Emit a print_TYPE_list function definition only if that function is used. *)
7709   List.iter (
7710     function
7711     | typ, (RStructListOnly | RStructAndList) ->
7712         (* generate the function for typ *)
7713         emit_print_list_function typ
7714     | typ, _ -> () (* empty *)
7715   ) (rstructs_used_by all_functions);
7716
7717   (* Emit a print_TYPE function definition only if that function is used. *)
7718   List.iter (
7719     function
7720     | typ, (RStructOnly | RStructAndList) ->
7721         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7722         pr "{\n";
7723         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7724         pr "}\n";
7725         pr "\n";
7726     | typ, _ -> () (* empty *)
7727   ) (rstructs_used_by all_functions);
7728
7729   (* run_<action> actions *)
7730   List.iter (
7731     fun (name, style, _, flags, _, _, _) ->
7732       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7733       pr "{\n";
7734       (match fst style with
7735        | RErr
7736        | RInt _
7737        | RBool _ -> pr "  int r;\n"
7738        | RInt64 _ -> pr "  int64_t r;\n"
7739        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7740        | RString _ -> pr "  char *r;\n"
7741        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7742        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7743        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7744        | RBufferOut _ ->
7745            pr "  char *r;\n";
7746            pr "  size_t size;\n";
7747       );
7748       List.iter (
7749         function
7750         | Device n
7751         | String n
7752         | OptString n -> pr "  const char *%s;\n" n
7753         | Pathname n
7754         | Dev_or_Path n
7755         | FileIn n
7756         | FileOut n -> pr "  char *%s;\n" n
7757         | BufferIn n ->
7758             pr "  const char *%s;\n" n;
7759             pr "  size_t %s_size;\n" n
7760         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7761         | Bool n -> pr "  int %s;\n" n
7762         | Int n -> pr "  int %s;\n" n
7763         | Int64 n -> pr "  int64_t %s;\n" n
7764       ) (snd style);
7765
7766       (* Check and convert parameters. *)
7767       let argc_expected = List.length (snd style) in
7768       pr "  if (argc != %d) {\n" argc_expected;
7769       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7770         argc_expected;
7771       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7772       pr "    return -1;\n";
7773       pr "  }\n";
7774
7775       let parse_integer fn fntyp rtyp range name i =
7776         pr "  {\n";
7777         pr "    strtol_error xerr;\n";
7778         pr "    %s r;\n" fntyp;
7779         pr "\n";
7780         pr "    xerr = %s (argv[%d], NULL, 0, &r, xstrtol_suffixes);\n" fn i;
7781         pr "    if (xerr != LONGINT_OK) {\n";
7782         pr "      fprintf (stderr,\n";
7783         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7784         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7785         pr "      return -1;\n";
7786         pr "    }\n";
7787         (match range with
7788          | None -> ()
7789          | Some (min, max, comment) ->
7790              pr "    /* %s */\n" comment;
7791              pr "    if (r < %s || r > %s) {\n" min max;
7792              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7793                name;
7794              pr "      return -1;\n";
7795              pr "    }\n";
7796              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7797         );
7798         pr "    %s = r;\n" name;
7799         pr "  }\n";
7800       in
7801
7802       iteri (
7803         fun i ->
7804           function
7805           | Device name
7806           | String name ->
7807               pr "  %s = argv[%d];\n" name i
7808           | Pathname name
7809           | Dev_or_Path name ->
7810               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7811               pr "  if (%s == NULL) return -1;\n" name
7812           | OptString name ->
7813               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7814                 name i i
7815           | BufferIn name ->
7816               pr "  %s = argv[%d];\n" name i;
7817               pr "  %s_size = strlen (argv[%d]);\n" name i
7818           | FileIn name ->
7819               pr "  %s = file_in (argv[%d]);\n" name i;
7820               pr "  if (%s == NULL) return -1;\n" name
7821           | FileOut name ->
7822               pr "  %s = file_out (argv[%d]);\n" name i;
7823               pr "  if (%s == NULL) return -1;\n" name
7824           | StringList name | DeviceList name ->
7825               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7826               pr "  if (%s == NULL) return -1;\n" name;
7827           | Bool name ->
7828               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7829           | Int name ->
7830               let range =
7831                 let min = "(-(2LL<<30))"
7832                 and max = "((2LL<<30)-1)"
7833                 and comment =
7834                   "The Int type in the generator is a signed 31 bit int." in
7835                 Some (min, max, comment) in
7836               parse_integer "xstrtoll" "long long" "int" range name i
7837           | Int64 name ->
7838               parse_integer "xstrtoll" "long long" "int64_t" None name i
7839       ) (snd style);
7840
7841       (* Call C API function. *)
7842       pr "  r = guestfs_%s " name;
7843       generate_c_call_args ~handle:"g" style;
7844       pr ";\n";
7845
7846       List.iter (
7847         function
7848         | Device name | String name
7849         | OptString name | Bool name
7850         | Int name | Int64 name
7851         | BufferIn name -> ()
7852         | Pathname name | Dev_or_Path name | FileOut name ->
7853             pr "  free (%s);\n" name
7854         | FileIn name ->
7855             pr "  free_file_in (%s);\n" name
7856         | StringList name | DeviceList name ->
7857             pr "  free_strings (%s);\n" name
7858       ) (snd style);
7859
7860       (* Any output flags? *)
7861       let fish_output =
7862         let flags = filter_map (
7863           function FishOutput flag -> Some flag | _ -> None
7864         ) flags in
7865         match flags with
7866         | [] -> None
7867         | [f] -> Some f
7868         | _ ->
7869             failwithf "%s: more than one FishOutput flag is not allowed" name in
7870
7871       (* Check return value for errors and display command results. *)
7872       (match fst style with
7873        | RErr -> pr "  return r;\n"
7874        | RInt _ ->
7875            pr "  if (r == -1) return -1;\n";
7876            (match fish_output with
7877             | None ->
7878                 pr "  printf (\"%%d\\n\", r);\n";
7879             | Some FishOutputOctal ->
7880                 pr "  printf (\"%%s%%o\\n\", r != 0 ? \"0\" : \"\", r);\n";
7881             | Some FishOutputHexadecimal ->
7882                 pr "  printf (\"%%s%%x\\n\", r != 0 ? \"0x\" : \"\", r);\n");
7883            pr "  return 0;\n"
7884        | RInt64 _ ->
7885            pr "  if (r == -1) return -1;\n";
7886            (match fish_output with
7887             | None ->
7888                 pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7889             | Some FishOutputOctal ->
7890                 pr "  printf (\"%%s%%\" PRIo64 \"\\n\", r != 0 ? \"0\" : \"\", r);\n";
7891             | Some FishOutputHexadecimal ->
7892                 pr "  printf (\"%%s%%\" PRIx64 \"\\n\", r != 0 ? \"0x\" : \"\", r);\n");
7893            pr "  return 0;\n"
7894        | RBool _ ->
7895            pr "  if (r == -1) return -1;\n";
7896            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7897            pr "  return 0;\n"
7898        | RConstString _ ->
7899            pr "  if (r == NULL) return -1;\n";
7900            pr "  printf (\"%%s\\n\", r);\n";
7901            pr "  return 0;\n"
7902        | RConstOptString _ ->
7903            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7904            pr "  return 0;\n"
7905        | RString _ ->
7906            pr "  if (r == NULL) return -1;\n";
7907            pr "  printf (\"%%s\\n\", r);\n";
7908            pr "  free (r);\n";
7909            pr "  return 0;\n"
7910        | RStringList _ ->
7911            pr "  if (r == NULL) return -1;\n";
7912            pr "  print_strings (r);\n";
7913            pr "  free_strings (r);\n";
7914            pr "  return 0;\n"
7915        | RStruct (_, typ) ->
7916            pr "  if (r == NULL) return -1;\n";
7917            pr "  print_%s (r);\n" typ;
7918            pr "  guestfs_free_%s (r);\n" typ;
7919            pr "  return 0;\n"
7920        | RStructList (_, typ) ->
7921            pr "  if (r == NULL) return -1;\n";
7922            pr "  print_%s_list (r);\n" typ;
7923            pr "  guestfs_free_%s_list (r);\n" typ;
7924            pr "  return 0;\n"
7925        | RHashtable _ ->
7926            pr "  if (r == NULL) return -1;\n";
7927            pr "  print_table (r);\n";
7928            pr "  free_strings (r);\n";
7929            pr "  return 0;\n"
7930        | RBufferOut _ ->
7931            pr "  if (r == NULL) return -1;\n";
7932            pr "  if (full_write (1, r, size) != size) {\n";
7933            pr "    perror (\"write\");\n";
7934            pr "    free (r);\n";
7935            pr "    return -1;\n";
7936            pr "  }\n";
7937            pr "  free (r);\n";
7938            pr "  return 0;\n"
7939       );
7940       pr "}\n";
7941       pr "\n"
7942   ) all_functions;
7943
7944   (* run_action function *)
7945   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7946   pr "{\n";
7947   List.iter (
7948     fun (name, _, _, flags, _, _, _) ->
7949       let name2 = replace_char name '_' '-' in
7950       let alias =
7951         try find_map (function FishAlias n -> Some n | _ -> None) flags
7952         with Not_found -> name in
7953       pr "  if (";
7954       pr "STRCASEEQ (cmd, \"%s\")" name;
7955       if name <> name2 then
7956         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7957       if name <> alias then
7958         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7959       pr ")\n";
7960       pr "    return run_%s (cmd, argc, argv);\n" name;
7961       pr "  else\n";
7962   ) all_functions;
7963   pr "    {\n";
7964   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7965   pr "      if (command_num == 1)\n";
7966   pr "        extended_help_message ();\n";
7967   pr "      return -1;\n";
7968   pr "    }\n";
7969   pr "  return 0;\n";
7970   pr "}\n";
7971   pr "\n"
7972
7973 (* Readline completion for guestfish. *)
7974 and generate_fish_completion () =
7975   generate_header CStyle GPLv2plus;
7976
7977   let all_functions =
7978     List.filter (
7979       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7980     ) all_functions in
7981
7982   pr "\
7983 #include <config.h>
7984
7985 #include <stdio.h>
7986 #include <stdlib.h>
7987 #include <string.h>
7988
7989 #ifdef HAVE_LIBREADLINE
7990 #include <readline/readline.h>
7991 #endif
7992
7993 #include \"fish.h\"
7994
7995 #ifdef HAVE_LIBREADLINE
7996
7997 static const char *const commands[] = {
7998   BUILTIN_COMMANDS_FOR_COMPLETION,
7999 ";
8000
8001   (* Get the commands, including the aliases.  They don't need to be
8002    * sorted - the generator() function just does a dumb linear search.
8003    *)
8004   let commands =
8005     List.map (
8006       fun (name, _, _, flags, _, _, _) ->
8007         let name2 = replace_char name '_' '-' in
8008         let alias =
8009           try find_map (function FishAlias n -> Some n | _ -> None) flags
8010           with Not_found -> name in
8011
8012         if name <> alias then [name2; alias] else [name2]
8013     ) all_functions in
8014   let commands = List.flatten commands in
8015
8016   List.iter (pr "  \"%s\",\n") commands;
8017
8018   pr "  NULL
8019 };
8020
8021 static char *
8022 generator (const char *text, int state)
8023 {
8024   static int index, len;
8025   const char *name;
8026
8027   if (!state) {
8028     index = 0;
8029     len = strlen (text);
8030   }
8031
8032   rl_attempted_completion_over = 1;
8033
8034   while ((name = commands[index]) != NULL) {
8035     index++;
8036     if (STRCASEEQLEN (name, text, len))
8037       return strdup (name);
8038   }
8039
8040   return NULL;
8041 }
8042
8043 #endif /* HAVE_LIBREADLINE */
8044
8045 #ifdef HAVE_RL_COMPLETION_MATCHES
8046 #define RL_COMPLETION_MATCHES rl_completion_matches
8047 #else
8048 #ifdef HAVE_COMPLETION_MATCHES
8049 #define RL_COMPLETION_MATCHES completion_matches
8050 #endif
8051 #endif /* else just fail if we don't have either symbol */
8052
8053 char **
8054 do_completion (const char *text, int start, int end)
8055 {
8056   char **matches = NULL;
8057
8058 #ifdef HAVE_LIBREADLINE
8059   rl_completion_append_character = ' ';
8060
8061   if (start == 0)
8062     matches = RL_COMPLETION_MATCHES (text, generator);
8063   else if (complete_dest_paths)
8064     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
8065 #endif
8066
8067   return matches;
8068 }
8069 ";
8070
8071 (* Generate the POD documentation for guestfish. *)
8072 and generate_fish_actions_pod () =
8073   let all_functions_sorted =
8074     List.filter (
8075       fun (_, _, _, flags, _, _, _) ->
8076         not (List.mem NotInFish flags || List.mem NotInDocs flags)
8077     ) all_functions_sorted in
8078
8079   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
8080
8081   List.iter (
8082     fun (name, style, _, flags, _, _, longdesc) ->
8083       let longdesc =
8084         Str.global_substitute rex (
8085           fun s ->
8086             let sub =
8087               try Str.matched_group 1 s
8088               with Not_found ->
8089                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
8090             "C<" ^ replace_char sub '_' '-' ^ ">"
8091         ) longdesc in
8092       let name = replace_char name '_' '-' in
8093       let alias =
8094         try find_map (function FishAlias n -> Some n | _ -> None) flags
8095         with Not_found -> name in
8096
8097       pr "=head2 %s" name;
8098       if name <> alias then
8099         pr " | %s" alias;
8100       pr "\n";
8101       pr "\n";
8102       pr " %s" name;
8103       List.iter (
8104         function
8105         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
8106         | OptString n -> pr " %s" n
8107         | StringList n | DeviceList n -> pr " '%s ...'" n
8108         | Bool _ -> pr " true|false"
8109         | Int n -> pr " %s" n
8110         | Int64 n -> pr " %s" n
8111         | FileIn n | FileOut n -> pr " (%s|-)" n
8112         | BufferIn n -> pr " %s" n
8113       ) (snd style);
8114       pr "\n";
8115       pr "\n";
8116       pr "%s\n\n" longdesc;
8117
8118       if List.exists (function FileIn _ | FileOut _ -> true
8119                       | _ -> false) (snd style) then
8120         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
8121
8122       if List.mem ProtocolLimitWarning flags then
8123         pr "%s\n\n" protocol_limit_warning;
8124
8125       if List.mem DangerWillRobinson flags then
8126         pr "%s\n\n" danger_will_robinson;
8127
8128       match deprecation_notice flags with
8129       | None -> ()
8130       | Some txt -> pr "%s\n\n" txt
8131   ) all_functions_sorted
8132
8133 (* Generate a C function prototype. *)
8134 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
8135     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
8136     ?(prefix = "")
8137     ?handle name style =
8138   if extern then pr "extern ";
8139   if static then pr "static ";
8140   (match fst style with
8141    | RErr -> pr "int "
8142    | RInt _ -> pr "int "
8143    | RInt64 _ -> pr "int64_t "
8144    | RBool _ -> pr "int "
8145    | RConstString _ | RConstOptString _ -> pr "const char *"
8146    | RString _ | RBufferOut _ -> pr "char *"
8147    | RStringList _ | RHashtable _ -> pr "char **"
8148    | RStruct (_, typ) ->
8149        if not in_daemon then pr "struct guestfs_%s *" typ
8150        else pr "guestfs_int_%s *" typ
8151    | RStructList (_, typ) ->
8152        if not in_daemon then pr "struct guestfs_%s_list *" typ
8153        else pr "guestfs_int_%s_list *" typ
8154   );
8155   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
8156   pr "%s%s (" prefix name;
8157   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
8158     pr "void"
8159   else (
8160     let comma = ref false in
8161     (match handle with
8162      | None -> ()
8163      | Some handle -> pr "guestfs_h *%s" handle; comma := true
8164     );
8165     let next () =
8166       if !comma then (
8167         if single_line then pr ", " else pr ",\n\t\t"
8168       );
8169       comma := true
8170     in
8171     List.iter (
8172       function
8173       | Pathname n
8174       | Device n | Dev_or_Path n
8175       | String n
8176       | OptString n ->
8177           next ();
8178           pr "const char *%s" n
8179       | StringList n | DeviceList n ->
8180           next ();
8181           pr "char *const *%s" n
8182       | Bool n -> next (); pr "int %s" n
8183       | Int n -> next (); pr "int %s" n
8184       | Int64 n -> next (); pr "int64_t %s" n
8185       | FileIn n
8186       | FileOut n ->
8187           if not in_daemon then (next (); pr "const char *%s" n)
8188       | BufferIn n ->
8189           next ();
8190           pr "const char *%s" n;
8191           next ();
8192           pr "size_t %s_size" n
8193     ) (snd style);
8194     if is_RBufferOut then (next (); pr "size_t *size_r");
8195   );
8196   pr ")";
8197   if semicolon then pr ";";
8198   if newline then pr "\n"
8199
8200 (* Generate C call arguments, eg "(handle, foo, bar)" *)
8201 and generate_c_call_args ?handle ?(decl = false) style =
8202   pr "(";
8203   let comma = ref false in
8204   let next () =
8205     if !comma then pr ", ";
8206     comma := true
8207   in
8208   (match handle with
8209    | None -> ()
8210    | Some handle -> pr "%s" handle; comma := true
8211   );
8212   List.iter (
8213     function
8214     | BufferIn n ->
8215         next ();
8216         pr "%s, %s_size" n n
8217     | arg ->
8218         next ();
8219         pr "%s" (name_of_argt arg)
8220   ) (snd style);
8221   (* For RBufferOut calls, add implicit &size parameter. *)
8222   if not decl then (
8223     match fst style with
8224     | RBufferOut _ ->
8225         next ();
8226         pr "&size"
8227     | _ -> ()
8228   );
8229   pr ")"
8230
8231 (* Generate the OCaml bindings interface. *)
8232 and generate_ocaml_mli () =
8233   generate_header OCamlStyle LGPLv2plus;
8234
8235   pr "\
8236 (** For API documentation you should refer to the C API
8237     in the guestfs(3) manual page.  The OCaml API uses almost
8238     exactly the same calls. *)
8239
8240 type t
8241 (** A [guestfs_h] handle. *)
8242
8243 exception Error of string
8244 (** This exception is raised when there is an error. *)
8245
8246 exception Handle_closed of string
8247 (** This exception is raised if you use a {!Guestfs.t} handle
8248     after calling {!close} on it.  The string is the name of
8249     the function. *)
8250
8251 val create : unit -> t
8252 (** Create a {!Guestfs.t} handle. *)
8253
8254 val close : t -> unit
8255 (** Close the {!Guestfs.t} handle and free up all resources used
8256     by it immediately.
8257
8258     Handles are closed by the garbage collector when they become
8259     unreferenced, but callers can call this in order to provide
8260     predictable cleanup. *)
8261
8262 ";
8263   generate_ocaml_structure_decls ();
8264
8265   (* The actions. *)
8266   List.iter (
8267     fun (name, style, _, _, _, shortdesc, _) ->
8268       generate_ocaml_prototype name style;
8269       pr "(** %s *)\n" shortdesc;
8270       pr "\n"
8271   ) all_functions_sorted
8272
8273 (* Generate the OCaml bindings implementation. *)
8274 and generate_ocaml_ml () =
8275   generate_header OCamlStyle LGPLv2plus;
8276
8277   pr "\
8278 type t
8279
8280 exception Error of string
8281 exception Handle_closed of string
8282
8283 external create : unit -> t = \"ocaml_guestfs_create\"
8284 external close : t -> unit = \"ocaml_guestfs_close\"
8285
8286 (* Give the exceptions names, so they can be raised from the C code. *)
8287 let () =
8288   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
8289   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
8290
8291 ";
8292
8293   generate_ocaml_structure_decls ();
8294
8295   (* The actions. *)
8296   List.iter (
8297     fun (name, style, _, _, _, shortdesc, _) ->
8298       generate_ocaml_prototype ~is_external:true name style;
8299   ) all_functions_sorted
8300
8301 (* Generate the OCaml bindings C implementation. *)
8302 and generate_ocaml_c () =
8303   generate_header CStyle LGPLv2plus;
8304
8305   pr "\
8306 #include <stdio.h>
8307 #include <stdlib.h>
8308 #include <string.h>
8309
8310 #include <caml/config.h>
8311 #include <caml/alloc.h>
8312 #include <caml/callback.h>
8313 #include <caml/fail.h>
8314 #include <caml/memory.h>
8315 #include <caml/mlvalues.h>
8316 #include <caml/signals.h>
8317
8318 #include <guestfs.h>
8319
8320 #include \"guestfs_c.h\"
8321
8322 /* Copy a hashtable of string pairs into an assoc-list.  We return
8323  * the list in reverse order, but hashtables aren't supposed to be
8324  * ordered anyway.
8325  */
8326 static CAMLprim value
8327 copy_table (char * const * argv)
8328 {
8329   CAMLparam0 ();
8330   CAMLlocal5 (rv, pairv, kv, vv, cons);
8331   int i;
8332
8333   rv = Val_int (0);
8334   for (i = 0; argv[i] != NULL; i += 2) {
8335     kv = caml_copy_string (argv[i]);
8336     vv = caml_copy_string (argv[i+1]);
8337     pairv = caml_alloc (2, 0);
8338     Store_field (pairv, 0, kv);
8339     Store_field (pairv, 1, vv);
8340     cons = caml_alloc (2, 0);
8341     Store_field (cons, 1, rv);
8342     rv = cons;
8343     Store_field (cons, 0, pairv);
8344   }
8345
8346   CAMLreturn (rv);
8347 }
8348
8349 ";
8350
8351   (* Struct copy functions. *)
8352
8353   let emit_ocaml_copy_list_function typ =
8354     pr "static CAMLprim value\n";
8355     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
8356     pr "{\n";
8357     pr "  CAMLparam0 ();\n";
8358     pr "  CAMLlocal2 (rv, v);\n";
8359     pr "  unsigned int i;\n";
8360     pr "\n";
8361     pr "  if (%ss->len == 0)\n" typ;
8362     pr "    CAMLreturn (Atom (0));\n";
8363     pr "  else {\n";
8364     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
8365     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
8366     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
8367     pr "      caml_modify (&Field (rv, i), v);\n";
8368     pr "    }\n";
8369     pr "    CAMLreturn (rv);\n";
8370     pr "  }\n";
8371     pr "}\n";
8372     pr "\n";
8373   in
8374
8375   List.iter (
8376     fun (typ, cols) ->
8377       let has_optpercent_col =
8378         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
8379
8380       pr "static CAMLprim value\n";
8381       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
8382       pr "{\n";
8383       pr "  CAMLparam0 ();\n";
8384       if has_optpercent_col then
8385         pr "  CAMLlocal3 (rv, v, v2);\n"
8386       else
8387         pr "  CAMLlocal2 (rv, v);\n";
8388       pr "\n";
8389       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
8390       iteri (
8391         fun i col ->
8392           (match col with
8393            | name, FString ->
8394                pr "  v = caml_copy_string (%s->%s);\n" typ name
8395            | name, FBuffer ->
8396                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
8397                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
8398                  typ name typ name
8399            | name, FUUID ->
8400                pr "  v = caml_alloc_string (32);\n";
8401                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
8402            | name, (FBytes|FInt64|FUInt64) ->
8403                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
8404            | name, (FInt32|FUInt32) ->
8405                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8406            | name, FOptPercent ->
8407                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8408                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8409                pr "    v = caml_alloc (1, 0);\n";
8410                pr "    Store_field (v, 0, v2);\n";
8411                pr "  } else /* None */\n";
8412                pr "    v = Val_int (0);\n";
8413            | name, FChar ->
8414                pr "  v = Val_int (%s->%s);\n" typ name
8415           );
8416           pr "  Store_field (rv, %d, v);\n" i
8417       ) cols;
8418       pr "  CAMLreturn (rv);\n";
8419       pr "}\n";
8420       pr "\n";
8421   ) structs;
8422
8423   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8424   List.iter (
8425     function
8426     | typ, (RStructListOnly | RStructAndList) ->
8427         (* generate the function for typ *)
8428         emit_ocaml_copy_list_function typ
8429     | typ, _ -> () (* empty *)
8430   ) (rstructs_used_by all_functions);
8431
8432   (* The wrappers. *)
8433   List.iter (
8434     fun (name, style, _, _, _, _, _) ->
8435       pr "/* Automatically generated wrapper for function\n";
8436       pr " * ";
8437       generate_ocaml_prototype name style;
8438       pr " */\n";
8439       pr "\n";
8440
8441       let params =
8442         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8443
8444       let needs_extra_vs =
8445         match fst style with RConstOptString _ -> true | _ -> false in
8446
8447       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8448       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8449       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8450       pr "\n";
8451
8452       pr "CAMLprim value\n";
8453       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8454       List.iter (pr ", value %s") (List.tl params);
8455       pr ")\n";
8456       pr "{\n";
8457
8458       (match params with
8459        | [p1; p2; p3; p4; p5] ->
8460            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8461        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8462            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8463            pr "  CAMLxparam%d (%s);\n"
8464              (List.length rest) (String.concat ", " rest)
8465        | ps ->
8466            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8467       );
8468       if not needs_extra_vs then
8469         pr "  CAMLlocal1 (rv);\n"
8470       else
8471         pr "  CAMLlocal3 (rv, v, v2);\n";
8472       pr "\n";
8473
8474       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8475       pr "  if (g == NULL)\n";
8476       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8477       pr "\n";
8478
8479       List.iter (
8480         function
8481         | Pathname n
8482         | Device n | Dev_or_Path n
8483         | String n
8484         | FileIn n
8485         | FileOut n ->
8486             pr "  const char *%s = String_val (%sv);\n" n n
8487         | OptString n ->
8488             pr "  const char *%s =\n" n;
8489             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
8490               n n
8491         | BufferIn n ->
8492             pr "  const char *%s = String_val (%sv);\n" n n;
8493             pr "  size_t %s_size = caml_string_length (%sv);\n" n n
8494         | StringList n | DeviceList n ->
8495             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8496         | Bool n ->
8497             pr "  int %s = Bool_val (%sv);\n" n n
8498         | Int n ->
8499             pr "  int %s = Int_val (%sv);\n" n n
8500         | Int64 n ->
8501             pr "  int64_t %s = Int64_val (%sv);\n" n n
8502       ) (snd style);
8503       let error_code =
8504         match fst style with
8505         | RErr -> pr "  int r;\n"; "-1"
8506         | RInt _ -> pr "  int r;\n"; "-1"
8507         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8508         | RBool _ -> pr "  int r;\n"; "-1"
8509         | RConstString _ | RConstOptString _ ->
8510             pr "  const char *r;\n"; "NULL"
8511         | RString _ -> pr "  char *r;\n"; "NULL"
8512         | RStringList _ ->
8513             pr "  int i;\n";
8514             pr "  char **r;\n";
8515             "NULL"
8516         | RStruct (_, typ) ->
8517             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8518         | RStructList (_, typ) ->
8519             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8520         | RHashtable _ ->
8521             pr "  int i;\n";
8522             pr "  char **r;\n";
8523             "NULL"
8524         | RBufferOut _ ->
8525             pr "  char *r;\n";
8526             pr "  size_t size;\n";
8527             "NULL" in
8528       pr "\n";
8529
8530       pr "  caml_enter_blocking_section ();\n";
8531       pr "  r = guestfs_%s " name;
8532       generate_c_call_args ~handle:"g" style;
8533       pr ";\n";
8534       pr "  caml_leave_blocking_section ();\n";
8535
8536       List.iter (
8537         function
8538         | StringList n | DeviceList n ->
8539             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8540         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8541         | Bool _ | Int _ | Int64 _
8542         | FileIn _ | FileOut _ | BufferIn _ -> ()
8543       ) (snd style);
8544
8545       pr "  if (r == %s)\n" error_code;
8546       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8547       pr "\n";
8548
8549       (match fst style with
8550        | RErr -> pr "  rv = Val_unit;\n"
8551        | RInt _ -> pr "  rv = Val_int (r);\n"
8552        | RInt64 _ ->
8553            pr "  rv = caml_copy_int64 (r);\n"
8554        | RBool _ -> pr "  rv = Val_bool (r);\n"
8555        | RConstString _ ->
8556            pr "  rv = caml_copy_string (r);\n"
8557        | RConstOptString _ ->
8558            pr "  if (r) { /* Some string */\n";
8559            pr "    v = caml_alloc (1, 0);\n";
8560            pr "    v2 = caml_copy_string (r);\n";
8561            pr "    Store_field (v, 0, v2);\n";
8562            pr "  } else /* None */\n";
8563            pr "    v = Val_int (0);\n";
8564        | RString _ ->
8565            pr "  rv = caml_copy_string (r);\n";
8566            pr "  free (r);\n"
8567        | RStringList _ ->
8568            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8569            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8570            pr "  free (r);\n"
8571        | RStruct (_, typ) ->
8572            pr "  rv = copy_%s (r);\n" typ;
8573            pr "  guestfs_free_%s (r);\n" typ;
8574        | RStructList (_, typ) ->
8575            pr "  rv = copy_%s_list (r);\n" typ;
8576            pr "  guestfs_free_%s_list (r);\n" typ;
8577        | RHashtable _ ->
8578            pr "  rv = copy_table (r);\n";
8579            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8580            pr "  free (r);\n";
8581        | RBufferOut _ ->
8582            pr "  rv = caml_alloc_string (size);\n";
8583            pr "  memcpy (String_val (rv), r, size);\n";
8584       );
8585
8586       pr "  CAMLreturn (rv);\n";
8587       pr "}\n";
8588       pr "\n";
8589
8590       if List.length params > 5 then (
8591         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8592         pr "CAMLprim value ";
8593         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8594         pr "CAMLprim value\n";
8595         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8596         pr "{\n";
8597         pr "  return ocaml_guestfs_%s (argv[0]" name;
8598         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8599         pr ");\n";
8600         pr "}\n";
8601         pr "\n"
8602       )
8603   ) all_functions_sorted
8604
8605 and generate_ocaml_structure_decls () =
8606   List.iter (
8607     fun (typ, cols) ->
8608       pr "type %s = {\n" typ;
8609       List.iter (
8610         function
8611         | name, FString -> pr "  %s : string;\n" name
8612         | name, FBuffer -> pr "  %s : string;\n" name
8613         | name, FUUID -> pr "  %s : string;\n" name
8614         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8615         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8616         | name, FChar -> pr "  %s : char;\n" name
8617         | name, FOptPercent -> pr "  %s : float option;\n" name
8618       ) cols;
8619       pr "}\n";
8620       pr "\n"
8621   ) structs
8622
8623 and generate_ocaml_prototype ?(is_external = false) name style =
8624   if is_external then pr "external " else pr "val ";
8625   pr "%s : t -> " name;
8626   List.iter (
8627     function
8628     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _
8629     | BufferIn _ -> pr "string -> "
8630     | OptString _ -> pr "string option -> "
8631     | StringList _ | DeviceList _ -> pr "string array -> "
8632     | Bool _ -> pr "bool -> "
8633     | Int _ -> pr "int -> "
8634     | Int64 _ -> pr "int64 -> "
8635   ) (snd style);
8636   (match fst style with
8637    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8638    | RInt _ -> pr "int"
8639    | RInt64 _ -> pr "int64"
8640    | RBool _ -> pr "bool"
8641    | RConstString _ -> pr "string"
8642    | RConstOptString _ -> pr "string option"
8643    | RString _ | RBufferOut _ -> pr "string"
8644    | RStringList _ -> pr "string array"
8645    | RStruct (_, typ) -> pr "%s" typ
8646    | RStructList (_, typ) -> pr "%s array" typ
8647    | RHashtable _ -> pr "(string * string) list"
8648   );
8649   if is_external then (
8650     pr " = ";
8651     if List.length (snd style) + 1 > 5 then
8652       pr "\"ocaml_guestfs_%s_byte\" " name;
8653     pr "\"ocaml_guestfs_%s\"" name
8654   );
8655   pr "\n"
8656
8657 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8658 and generate_perl_xs () =
8659   generate_header CStyle LGPLv2plus;
8660
8661   pr "\
8662 #include \"EXTERN.h\"
8663 #include \"perl.h\"
8664 #include \"XSUB.h\"
8665
8666 #include <guestfs.h>
8667
8668 #ifndef PRId64
8669 #define PRId64 \"lld\"
8670 #endif
8671
8672 static SV *
8673 my_newSVll(long long val) {
8674 #ifdef USE_64_BIT_ALL
8675   return newSViv(val);
8676 #else
8677   char buf[100];
8678   int len;
8679   len = snprintf(buf, 100, \"%%\" PRId64, val);
8680   return newSVpv(buf, len);
8681 #endif
8682 }
8683
8684 #ifndef PRIu64
8685 #define PRIu64 \"llu\"
8686 #endif
8687
8688 static SV *
8689 my_newSVull(unsigned long long val) {
8690 #ifdef USE_64_BIT_ALL
8691   return newSVuv(val);
8692 #else
8693   char buf[100];
8694   int len;
8695   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8696   return newSVpv(buf, len);
8697 #endif
8698 }
8699
8700 /* http://www.perlmonks.org/?node_id=680842 */
8701 static char **
8702 XS_unpack_charPtrPtr (SV *arg) {
8703   char **ret;
8704   AV *av;
8705   I32 i;
8706
8707   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8708     croak (\"array reference expected\");
8709
8710   av = (AV *)SvRV (arg);
8711   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8712   if (!ret)
8713     croak (\"malloc failed\");
8714
8715   for (i = 0; i <= av_len (av); i++) {
8716     SV **elem = av_fetch (av, i, 0);
8717
8718     if (!elem || !*elem)
8719       croak (\"missing element in list\");
8720
8721     ret[i] = SvPV_nolen (*elem);
8722   }
8723
8724   ret[i] = NULL;
8725
8726   return ret;
8727 }
8728
8729 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8730
8731 PROTOTYPES: ENABLE
8732
8733 guestfs_h *
8734 _create ()
8735    CODE:
8736       RETVAL = guestfs_create ();
8737       if (!RETVAL)
8738         croak (\"could not create guestfs handle\");
8739       guestfs_set_error_handler (RETVAL, NULL, NULL);
8740  OUTPUT:
8741       RETVAL
8742
8743 void
8744 DESTROY (g)
8745       guestfs_h *g;
8746  PPCODE:
8747       guestfs_close (g);
8748
8749 ";
8750
8751   List.iter (
8752     fun (name, style, _, _, _, _, _) ->
8753       (match fst style with
8754        | RErr -> pr "void\n"
8755        | RInt _ -> pr "SV *\n"
8756        | RInt64 _ -> pr "SV *\n"
8757        | RBool _ -> pr "SV *\n"
8758        | RConstString _ -> pr "SV *\n"
8759        | RConstOptString _ -> pr "SV *\n"
8760        | RString _ -> pr "SV *\n"
8761        | RBufferOut _ -> pr "SV *\n"
8762        | RStringList _
8763        | RStruct _ | RStructList _
8764        | RHashtable _ ->
8765            pr "void\n" (* all lists returned implictly on the stack *)
8766       );
8767       (* Call and arguments. *)
8768       pr "%s (g" name;
8769       List.iter (
8770         fun arg -> pr ", %s" (name_of_argt arg)
8771       ) (snd style);
8772       pr ")\n";
8773       pr "      guestfs_h *g;\n";
8774       iteri (
8775         fun i ->
8776           function
8777           | Pathname n | Device n | Dev_or_Path n | String n
8778           | FileIn n | FileOut n ->
8779               pr "      char *%s;\n" n
8780           | BufferIn n ->
8781               pr "      char *%s;\n" n;
8782               pr "      size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
8783           | OptString n ->
8784               (* http://www.perlmonks.org/?node_id=554277
8785                * Note that the implicit handle argument means we have
8786                * to add 1 to the ST(x) operator.
8787                *)
8788               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8789           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8790           | Bool n -> pr "      int %s;\n" n
8791           | Int n -> pr "      int %s;\n" n
8792           | Int64 n -> pr "      int64_t %s;\n" n
8793       ) (snd style);
8794
8795       let do_cleanups () =
8796         List.iter (
8797           function
8798           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8799           | Bool _ | Int _ | Int64 _
8800           | FileIn _ | FileOut _
8801           | BufferIn _ -> ()
8802           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8803         ) (snd style)
8804       in
8805
8806       (* Code. *)
8807       (match fst style with
8808        | RErr ->
8809            pr "PREINIT:\n";
8810            pr "      int r;\n";
8811            pr " PPCODE:\n";
8812            pr "      r = guestfs_%s " name;
8813            generate_c_call_args ~handle:"g" style;
8814            pr ";\n";
8815            do_cleanups ();
8816            pr "      if (r == -1)\n";
8817            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8818        | RInt n
8819        | RBool n ->
8820            pr "PREINIT:\n";
8821            pr "      int %s;\n" n;
8822            pr "   CODE:\n";
8823            pr "      %s = guestfs_%s " n name;
8824            generate_c_call_args ~handle:"g" style;
8825            pr ";\n";
8826            do_cleanups ();
8827            pr "      if (%s == -1)\n" n;
8828            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8829            pr "      RETVAL = newSViv (%s);\n" n;
8830            pr " OUTPUT:\n";
8831            pr "      RETVAL\n"
8832        | RInt64 n ->
8833            pr "PREINIT:\n";
8834            pr "      int64_t %s;\n" n;
8835            pr "   CODE:\n";
8836            pr "      %s = guestfs_%s " n name;
8837            generate_c_call_args ~handle:"g" style;
8838            pr ";\n";
8839            do_cleanups ();
8840            pr "      if (%s == -1)\n" n;
8841            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8842            pr "      RETVAL = my_newSVll (%s);\n" n;
8843            pr " OUTPUT:\n";
8844            pr "      RETVAL\n"
8845        | RConstString n ->
8846            pr "PREINIT:\n";
8847            pr "      const char *%s;\n" n;
8848            pr "   CODE:\n";
8849            pr "      %s = guestfs_%s " n name;
8850            generate_c_call_args ~handle:"g" style;
8851            pr ";\n";
8852            do_cleanups ();
8853            pr "      if (%s == NULL)\n" n;
8854            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8855            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8856            pr " OUTPUT:\n";
8857            pr "      RETVAL\n"
8858        | RConstOptString n ->
8859            pr "PREINIT:\n";
8860            pr "      const char *%s;\n" n;
8861            pr "   CODE:\n";
8862            pr "      %s = guestfs_%s " n name;
8863            generate_c_call_args ~handle:"g" style;
8864            pr ";\n";
8865            do_cleanups ();
8866            pr "      if (%s == NULL)\n" n;
8867            pr "        RETVAL = &PL_sv_undef;\n";
8868            pr "      else\n";
8869            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8870            pr " OUTPUT:\n";
8871            pr "      RETVAL\n"
8872        | RString n ->
8873            pr "PREINIT:\n";
8874            pr "      char *%s;\n" n;
8875            pr "   CODE:\n";
8876            pr "      %s = guestfs_%s " n name;
8877            generate_c_call_args ~handle:"g" style;
8878            pr ";\n";
8879            do_cleanups ();
8880            pr "      if (%s == NULL)\n" n;
8881            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8882            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8883            pr "      free (%s);\n" n;
8884            pr " OUTPUT:\n";
8885            pr "      RETVAL\n"
8886        | RStringList n | RHashtable n ->
8887            pr "PREINIT:\n";
8888            pr "      char **%s;\n" n;
8889            pr "      int i, n;\n";
8890            pr " PPCODE:\n";
8891            pr "      %s = guestfs_%s " n name;
8892            generate_c_call_args ~handle:"g" style;
8893            pr ";\n";
8894            do_cleanups ();
8895            pr "      if (%s == NULL)\n" n;
8896            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8897            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8898            pr "      EXTEND (SP, n);\n";
8899            pr "      for (i = 0; i < n; ++i) {\n";
8900            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8901            pr "        free (%s[i]);\n" n;
8902            pr "      }\n";
8903            pr "      free (%s);\n" n;
8904        | RStruct (n, typ) ->
8905            let cols = cols_of_struct typ in
8906            generate_perl_struct_code typ cols name style n do_cleanups
8907        | RStructList (n, typ) ->
8908            let cols = cols_of_struct typ in
8909            generate_perl_struct_list_code typ cols name style n do_cleanups
8910        | RBufferOut n ->
8911            pr "PREINIT:\n";
8912            pr "      char *%s;\n" n;
8913            pr "      size_t size;\n";
8914            pr "   CODE:\n";
8915            pr "      %s = guestfs_%s " n name;
8916            generate_c_call_args ~handle:"g" style;
8917            pr ";\n";
8918            do_cleanups ();
8919            pr "      if (%s == NULL)\n" n;
8920            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8921            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8922            pr "      free (%s);\n" n;
8923            pr " OUTPUT:\n";
8924            pr "      RETVAL\n"
8925       );
8926
8927       pr "\n"
8928   ) all_functions
8929
8930 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8931   pr "PREINIT:\n";
8932   pr "      struct guestfs_%s_list *%s;\n" typ n;
8933   pr "      int i;\n";
8934   pr "      HV *hv;\n";
8935   pr " PPCODE:\n";
8936   pr "      %s = guestfs_%s " n name;
8937   generate_c_call_args ~handle:"g" style;
8938   pr ";\n";
8939   do_cleanups ();
8940   pr "      if (%s == NULL)\n" n;
8941   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8942   pr "      EXTEND (SP, %s->len);\n" n;
8943   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8944   pr "        hv = newHV ();\n";
8945   List.iter (
8946     function
8947     | name, FString ->
8948         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8949           name (String.length name) n name
8950     | name, FUUID ->
8951         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8952           name (String.length name) n name
8953     | name, FBuffer ->
8954         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8955           name (String.length name) n name n name
8956     | name, (FBytes|FUInt64) ->
8957         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8958           name (String.length name) n name
8959     | name, FInt64 ->
8960         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8961           name (String.length name) n name
8962     | name, (FInt32|FUInt32) ->
8963         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8964           name (String.length name) n name
8965     | name, FChar ->
8966         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8967           name (String.length name) n name
8968     | name, FOptPercent ->
8969         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8970           name (String.length name) n name
8971   ) cols;
8972   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8973   pr "      }\n";
8974   pr "      guestfs_free_%s_list (%s);\n" typ n
8975
8976 and generate_perl_struct_code typ cols name style n do_cleanups =
8977   pr "PREINIT:\n";
8978   pr "      struct guestfs_%s *%s;\n" typ n;
8979   pr " PPCODE:\n";
8980   pr "      %s = guestfs_%s " n name;
8981   generate_c_call_args ~handle:"g" style;
8982   pr ";\n";
8983   do_cleanups ();
8984   pr "      if (%s == NULL)\n" n;
8985   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8986   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8987   List.iter (
8988     fun ((name, _) as col) ->
8989       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8990
8991       match col with
8992       | name, FString ->
8993           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8994             n name
8995       | name, FBuffer ->
8996           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8997             n name n name
8998       | name, FUUID ->
8999           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
9000             n name
9001       | name, (FBytes|FUInt64) ->
9002           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
9003             n name
9004       | name, FInt64 ->
9005           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
9006             n name
9007       | name, (FInt32|FUInt32) ->
9008           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
9009             n name
9010       | name, FChar ->
9011           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
9012             n name
9013       | name, FOptPercent ->
9014           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
9015             n name
9016   ) cols;
9017   pr "      free (%s);\n" n
9018
9019 (* Generate Sys/Guestfs.pm. *)
9020 and generate_perl_pm () =
9021   generate_header HashStyle LGPLv2plus;
9022
9023   pr "\
9024 =pod
9025
9026 =head1 NAME
9027
9028 Sys::Guestfs - Perl bindings for libguestfs
9029
9030 =head1 SYNOPSIS
9031
9032  use Sys::Guestfs;
9033
9034  my $h = Sys::Guestfs->new ();
9035  $h->add_drive ('guest.img');
9036  $h->launch ();
9037  $h->mount ('/dev/sda1', '/');
9038  $h->touch ('/hello');
9039  $h->sync ();
9040
9041 =head1 DESCRIPTION
9042
9043 The C<Sys::Guestfs> module provides a Perl XS binding to the
9044 libguestfs API for examining and modifying virtual machine
9045 disk images.
9046
9047 Amongst the things this is good for: making batch configuration
9048 changes to guests, getting disk used/free statistics (see also:
9049 virt-df), migrating between virtualization systems (see also:
9050 virt-p2v), performing partial backups, performing partial guest
9051 clones, cloning guests and changing registry/UUID/hostname info, and
9052 much else besides.
9053
9054 Libguestfs uses Linux kernel and qemu code, and can access any type of
9055 guest filesystem that Linux and qemu can, including but not limited
9056 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9057 schemes, qcow, qcow2, vmdk.
9058
9059 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9060 LVs, what filesystem is in each LV, etc.).  It can also run commands
9061 in the context of the guest.  Also you can access filesystems over
9062 FUSE.
9063
9064 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
9065 functions for using libguestfs from Perl, including integration
9066 with libvirt.
9067
9068 =head1 ERRORS
9069
9070 All errors turn into calls to C<croak> (see L<Carp(3)>).
9071
9072 =head1 METHODS
9073
9074 =over 4
9075
9076 =cut
9077
9078 package Sys::Guestfs;
9079
9080 use strict;
9081 use warnings;
9082
9083 # This version number changes whenever a new function
9084 # is added to the libguestfs API.  It is not directly
9085 # related to the libguestfs version number.
9086 use vars qw($VERSION);
9087 $VERSION = '0.%d';
9088
9089 require XSLoader;
9090 XSLoader::load ('Sys::Guestfs');
9091
9092 =item $h = Sys::Guestfs->new ();
9093
9094 Create a new guestfs handle.
9095
9096 =cut
9097
9098 sub new {
9099   my $proto = shift;
9100   my $class = ref ($proto) || $proto;
9101
9102   my $self = Sys::Guestfs::_create ();
9103   bless $self, $class;
9104   return $self;
9105 }
9106
9107 " max_proc_nr;
9108
9109   (* Actions.  We only need to print documentation for these as
9110    * they are pulled in from the XS code automatically.
9111    *)
9112   List.iter (
9113     fun (name, style, _, flags, _, _, longdesc) ->
9114       if not (List.mem NotInDocs flags) then (
9115         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
9116         pr "=item ";
9117         generate_perl_prototype name style;
9118         pr "\n\n";
9119         pr "%s\n\n" longdesc;
9120         if List.mem ProtocolLimitWarning flags then
9121           pr "%s\n\n" protocol_limit_warning;
9122         if List.mem DangerWillRobinson flags then
9123           pr "%s\n\n" danger_will_robinson;
9124         match deprecation_notice flags with
9125         | None -> ()
9126         | Some txt -> pr "%s\n\n" txt
9127       )
9128   ) all_functions_sorted;
9129
9130   (* End of file. *)
9131   pr "\
9132 =cut
9133
9134 1;
9135
9136 =back
9137
9138 =head1 COPYRIGHT
9139
9140 Copyright (C) %s Red Hat Inc.
9141
9142 =head1 LICENSE
9143
9144 Please see the file COPYING.LIB for the full license.
9145
9146 =head1 SEE ALSO
9147
9148 L<guestfs(3)>,
9149 L<guestfish(1)>,
9150 L<http://libguestfs.org>,
9151 L<Sys::Guestfs::Lib(3)>.
9152
9153 =cut
9154 " copyright_years
9155
9156 and generate_perl_prototype name style =
9157   (match fst style with
9158    | RErr -> ()
9159    | RBool n
9160    | RInt n
9161    | RInt64 n
9162    | RConstString n
9163    | RConstOptString n
9164    | RString n
9165    | RBufferOut n -> pr "$%s = " n
9166    | RStruct (n,_)
9167    | RHashtable n -> pr "%%%s = " n
9168    | RStringList n
9169    | RStructList (n,_) -> pr "@%s = " n
9170   );
9171   pr "$h->%s (" name;
9172   let comma = ref false in
9173   List.iter (
9174     fun arg ->
9175       if !comma then pr ", ";
9176       comma := true;
9177       match arg with
9178       | Pathname n | Device n | Dev_or_Path n | String n
9179       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
9180       | BufferIn n ->
9181           pr "$%s" n
9182       | StringList n | DeviceList n ->
9183           pr "\\@%s" n
9184   ) (snd style);
9185   pr ");"
9186
9187 (* Generate Python C module. *)
9188 and generate_python_c () =
9189   generate_header CStyle LGPLv2plus;
9190
9191   pr "\
9192 #define PY_SSIZE_T_CLEAN 1
9193 #include <Python.h>
9194
9195 #if PY_VERSION_HEX < 0x02050000
9196 typedef int Py_ssize_t;
9197 #define PY_SSIZE_T_MAX INT_MAX
9198 #define PY_SSIZE_T_MIN INT_MIN
9199 #endif
9200
9201 #include <stdio.h>
9202 #include <stdlib.h>
9203 #include <assert.h>
9204
9205 #include \"guestfs.h\"
9206
9207 typedef struct {
9208   PyObject_HEAD
9209   guestfs_h *g;
9210 } Pyguestfs_Object;
9211
9212 static guestfs_h *
9213 get_handle (PyObject *obj)
9214 {
9215   assert (obj);
9216   assert (obj != Py_None);
9217   return ((Pyguestfs_Object *) obj)->g;
9218 }
9219
9220 static PyObject *
9221 put_handle (guestfs_h *g)
9222 {
9223   assert (g);
9224   return
9225     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
9226 }
9227
9228 /* This list should be freed (but not the strings) after use. */
9229 static char **
9230 get_string_list (PyObject *obj)
9231 {
9232   int i, len;
9233   char **r;
9234
9235   assert (obj);
9236
9237   if (!PyList_Check (obj)) {
9238     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
9239     return NULL;
9240   }
9241
9242   len = PyList_Size (obj);
9243   r = malloc (sizeof (char *) * (len+1));
9244   if (r == NULL) {
9245     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
9246     return NULL;
9247   }
9248
9249   for (i = 0; i < len; ++i)
9250     r[i] = PyString_AsString (PyList_GetItem (obj, i));
9251   r[len] = NULL;
9252
9253   return r;
9254 }
9255
9256 static PyObject *
9257 put_string_list (char * const * const argv)
9258 {
9259   PyObject *list;
9260   int argc, i;
9261
9262   for (argc = 0; argv[argc] != NULL; ++argc)
9263     ;
9264
9265   list = PyList_New (argc);
9266   for (i = 0; i < argc; ++i)
9267     PyList_SetItem (list, i, PyString_FromString (argv[i]));
9268
9269   return list;
9270 }
9271
9272 static PyObject *
9273 put_table (char * const * const argv)
9274 {
9275   PyObject *list, *item;
9276   int argc, i;
9277
9278   for (argc = 0; argv[argc] != NULL; ++argc)
9279     ;
9280
9281   list = PyList_New (argc >> 1);
9282   for (i = 0; i < argc; i += 2) {
9283     item = PyTuple_New (2);
9284     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
9285     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
9286     PyList_SetItem (list, i >> 1, item);
9287   }
9288
9289   return list;
9290 }
9291
9292 static void
9293 free_strings (char **argv)
9294 {
9295   int argc;
9296
9297   for (argc = 0; argv[argc] != NULL; ++argc)
9298     free (argv[argc]);
9299   free (argv);
9300 }
9301
9302 static PyObject *
9303 py_guestfs_create (PyObject *self, PyObject *args)
9304 {
9305   guestfs_h *g;
9306
9307   g = guestfs_create ();
9308   if (g == NULL) {
9309     PyErr_SetString (PyExc_RuntimeError,
9310                      \"guestfs.create: failed to allocate handle\");
9311     return NULL;
9312   }
9313   guestfs_set_error_handler (g, NULL, NULL);
9314   return put_handle (g);
9315 }
9316
9317 static PyObject *
9318 py_guestfs_close (PyObject *self, PyObject *args)
9319 {
9320   PyObject *py_g;
9321   guestfs_h *g;
9322
9323   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
9324     return NULL;
9325   g = get_handle (py_g);
9326
9327   guestfs_close (g);
9328
9329   Py_INCREF (Py_None);
9330   return Py_None;
9331 }
9332
9333 ";
9334
9335   let emit_put_list_function typ =
9336     pr "static PyObject *\n";
9337     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
9338     pr "{\n";
9339     pr "  PyObject *list;\n";
9340     pr "  int i;\n";
9341     pr "\n";
9342     pr "  list = PyList_New (%ss->len);\n" typ;
9343     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
9344     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
9345     pr "  return list;\n";
9346     pr "};\n";
9347     pr "\n"
9348   in
9349
9350   (* Structures, turned into Python dictionaries. *)
9351   List.iter (
9352     fun (typ, cols) ->
9353       pr "static PyObject *\n";
9354       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
9355       pr "{\n";
9356       pr "  PyObject *dict;\n";
9357       pr "\n";
9358       pr "  dict = PyDict_New ();\n";
9359       List.iter (
9360         function
9361         | name, FString ->
9362             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9363             pr "                        PyString_FromString (%s->%s));\n"
9364               typ name
9365         | name, FBuffer ->
9366             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9367             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
9368               typ name typ name
9369         | name, FUUID ->
9370             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9371             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
9372               typ name
9373         | name, (FBytes|FUInt64) ->
9374             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9375             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
9376               typ name
9377         | name, FInt64 ->
9378             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9379             pr "                        PyLong_FromLongLong (%s->%s));\n"
9380               typ name
9381         | name, FUInt32 ->
9382             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9383             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
9384               typ name
9385         | name, FInt32 ->
9386             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9387             pr "                        PyLong_FromLong (%s->%s));\n"
9388               typ name
9389         | name, FOptPercent ->
9390             pr "  if (%s->%s >= 0)\n" typ name;
9391             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
9392             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
9393               typ name;
9394             pr "  else {\n";
9395             pr "    Py_INCREF (Py_None);\n";
9396             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
9397             pr "  }\n"
9398         | name, FChar ->
9399             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
9400             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
9401       ) cols;
9402       pr "  return dict;\n";
9403       pr "};\n";
9404       pr "\n";
9405
9406   ) structs;
9407
9408   (* Emit a put_TYPE_list function definition only if that function is used. *)
9409   List.iter (
9410     function
9411     | typ, (RStructListOnly | RStructAndList) ->
9412         (* generate the function for typ *)
9413         emit_put_list_function typ
9414     | typ, _ -> () (* empty *)
9415   ) (rstructs_used_by all_functions);
9416
9417   (* Python wrapper functions. *)
9418   List.iter (
9419     fun (name, style, _, _, _, _, _) ->
9420       pr "static PyObject *\n";
9421       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
9422       pr "{\n";
9423
9424       pr "  PyObject *py_g;\n";
9425       pr "  guestfs_h *g;\n";
9426       pr "  PyObject *py_r;\n";
9427
9428       let error_code =
9429         match fst style with
9430         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9431         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9432         | RConstString _ | RConstOptString _ ->
9433             pr "  const char *r;\n"; "NULL"
9434         | RString _ -> pr "  char *r;\n"; "NULL"
9435         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9436         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9437         | RStructList (_, typ) ->
9438             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9439         | RBufferOut _ ->
9440             pr "  char *r;\n";
9441             pr "  size_t size;\n";
9442             "NULL" in
9443
9444       List.iter (
9445         function
9446         | Pathname n | Device n | Dev_or_Path n | String n
9447         | FileIn n | FileOut n ->
9448             pr "  const char *%s;\n" n
9449         | OptString n -> pr "  const char *%s;\n" n
9450         | BufferIn n ->
9451             pr "  const char *%s;\n" n;
9452             pr "  Py_ssize_t %s_size;\n" n
9453         | StringList n | DeviceList n ->
9454             pr "  PyObject *py_%s;\n" n;
9455             pr "  char **%s;\n" n
9456         | Bool n -> pr "  int %s;\n" n
9457         | Int n -> pr "  int %s;\n" n
9458         | Int64 n -> pr "  long long %s;\n" n
9459       ) (snd style);
9460
9461       pr "\n";
9462
9463       (* Convert the parameters. *)
9464       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9465       List.iter (
9466         function
9467         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9468         | OptString _ -> pr "z"
9469         | StringList _ | DeviceList _ -> pr "O"
9470         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9471         | Int _ -> pr "i"
9472         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9473                              * emulate C's int/long/long long in Python?
9474                              *)
9475         | BufferIn _ -> pr "s#"
9476       ) (snd style);
9477       pr ":guestfs_%s\",\n" name;
9478       pr "                         &py_g";
9479       List.iter (
9480         function
9481         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9482         | OptString n -> pr ", &%s" n
9483         | StringList n | DeviceList n -> pr ", &py_%s" n
9484         | Bool n -> pr ", &%s" n
9485         | Int n -> pr ", &%s" n
9486         | Int64 n -> pr ", &%s" n
9487         | BufferIn n -> pr ", &%s, &%s_size" n n
9488       ) (snd style);
9489
9490       pr "))\n";
9491       pr "    return NULL;\n";
9492
9493       pr "  g = get_handle (py_g);\n";
9494       List.iter (
9495         function
9496         | Pathname _ | Device _ | Dev_or_Path _ | String _
9497         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
9498         | BufferIn _ -> ()
9499         | StringList n | DeviceList n ->
9500             pr "  %s = get_string_list (py_%s);\n" n n;
9501             pr "  if (!%s) return NULL;\n" n
9502       ) (snd style);
9503
9504       pr "\n";
9505
9506       pr "  r = guestfs_%s " name;
9507       generate_c_call_args ~handle:"g" style;
9508       pr ";\n";
9509
9510       List.iter (
9511         function
9512         | Pathname _ | Device _ | Dev_or_Path _ | String _
9513         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
9514         | BufferIn _ -> ()
9515         | StringList n | DeviceList n ->
9516             pr "  free (%s);\n" n
9517       ) (snd style);
9518
9519       pr "  if (r == %s) {\n" error_code;
9520       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9521       pr "    return NULL;\n";
9522       pr "  }\n";
9523       pr "\n";
9524
9525       (match fst style with
9526        | RErr ->
9527            pr "  Py_INCREF (Py_None);\n";
9528            pr "  py_r = Py_None;\n"
9529        | RInt _
9530        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9531        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9532        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9533        | RConstOptString _ ->
9534            pr "  if (r)\n";
9535            pr "    py_r = PyString_FromString (r);\n";
9536            pr "  else {\n";
9537            pr "    Py_INCREF (Py_None);\n";
9538            pr "    py_r = Py_None;\n";
9539            pr "  }\n"
9540        | RString _ ->
9541            pr "  py_r = PyString_FromString (r);\n";
9542            pr "  free (r);\n"
9543        | RStringList _ ->
9544            pr "  py_r = put_string_list (r);\n";
9545            pr "  free_strings (r);\n"
9546        | RStruct (_, typ) ->
9547            pr "  py_r = put_%s (r);\n" typ;
9548            pr "  guestfs_free_%s (r);\n" typ
9549        | RStructList (_, typ) ->
9550            pr "  py_r = put_%s_list (r);\n" typ;
9551            pr "  guestfs_free_%s_list (r);\n" typ
9552        | RHashtable n ->
9553            pr "  py_r = put_table (r);\n";
9554            pr "  free_strings (r);\n"
9555        | RBufferOut _ ->
9556            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9557            pr "  free (r);\n"
9558       );
9559
9560       pr "  return py_r;\n";
9561       pr "}\n";
9562       pr "\n"
9563   ) all_functions;
9564
9565   (* Table of functions. *)
9566   pr "static PyMethodDef methods[] = {\n";
9567   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9568   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9569   List.iter (
9570     fun (name, _, _, _, _, _, _) ->
9571       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9572         name name
9573   ) all_functions;
9574   pr "  { NULL, NULL, 0, NULL }\n";
9575   pr "};\n";
9576   pr "\n";
9577
9578   (* Init function. *)
9579   pr "\
9580 void
9581 initlibguestfsmod (void)
9582 {
9583   static int initialized = 0;
9584
9585   if (initialized) return;
9586   Py_InitModule ((char *) \"libguestfsmod\", methods);
9587   initialized = 1;
9588 }
9589 "
9590
9591 (* Generate Python module. *)
9592 and generate_python_py () =
9593   generate_header HashStyle LGPLv2plus;
9594
9595   pr "\
9596 u\"\"\"Python bindings for libguestfs
9597
9598 import guestfs
9599 g = guestfs.GuestFS ()
9600 g.add_drive (\"guest.img\")
9601 g.launch ()
9602 parts = g.list_partitions ()
9603
9604 The guestfs module provides a Python binding to the libguestfs API
9605 for examining and modifying virtual machine disk images.
9606
9607 Amongst the things this is good for: making batch configuration
9608 changes to guests, getting disk used/free statistics (see also:
9609 virt-df), migrating between virtualization systems (see also:
9610 virt-p2v), performing partial backups, performing partial guest
9611 clones, cloning guests and changing registry/UUID/hostname info, and
9612 much else besides.
9613
9614 Libguestfs uses Linux kernel and qemu code, and can access any type of
9615 guest filesystem that Linux and qemu can, including but not limited
9616 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9617 schemes, qcow, qcow2, vmdk.
9618
9619 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9620 LVs, what filesystem is in each LV, etc.).  It can also run commands
9621 in the context of the guest.  Also you can access filesystems over
9622 FUSE.
9623
9624 Errors which happen while using the API are turned into Python
9625 RuntimeError exceptions.
9626
9627 To create a guestfs handle you usually have to perform the following
9628 sequence of calls:
9629
9630 # Create the handle, call add_drive at least once, and possibly
9631 # several times if the guest has multiple block devices:
9632 g = guestfs.GuestFS ()
9633 g.add_drive (\"guest.img\")
9634
9635 # Launch the qemu subprocess and wait for it to become ready:
9636 g.launch ()
9637
9638 # Now you can issue commands, for example:
9639 logvols = g.lvs ()
9640
9641 \"\"\"
9642
9643 import libguestfsmod
9644
9645 class GuestFS:
9646     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9647
9648     def __init__ (self):
9649         \"\"\"Create a new libguestfs handle.\"\"\"
9650         self._o = libguestfsmod.create ()
9651
9652     def __del__ (self):
9653         libguestfsmod.close (self._o)
9654
9655 ";
9656
9657   List.iter (
9658     fun (name, style, _, flags, _, _, longdesc) ->
9659       pr "    def %s " name;
9660       generate_py_call_args ~handle:"self" (snd style);
9661       pr ":\n";
9662
9663       if not (List.mem NotInDocs flags) then (
9664         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9665         let doc =
9666           match fst style with
9667           | RErr | RInt _ | RInt64 _ | RBool _
9668           | RConstOptString _ | RConstString _
9669           | RString _ | RBufferOut _ -> doc
9670           | RStringList _ ->
9671               doc ^ "\n\nThis function returns a list of strings."
9672           | RStruct (_, typ) ->
9673               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9674           | RStructList (_, typ) ->
9675               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9676           | RHashtable _ ->
9677               doc ^ "\n\nThis function returns a dictionary." in
9678         let doc =
9679           if List.mem ProtocolLimitWarning flags then
9680             doc ^ "\n\n" ^ protocol_limit_warning
9681           else doc in
9682         let doc =
9683           if List.mem DangerWillRobinson flags then
9684             doc ^ "\n\n" ^ danger_will_robinson
9685           else doc in
9686         let doc =
9687           match deprecation_notice flags with
9688           | None -> doc
9689           | Some txt -> doc ^ "\n\n" ^ txt in
9690         let doc = pod2text ~width:60 name doc in
9691         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9692         let doc = String.concat "\n        " doc in
9693         pr "        u\"\"\"%s\"\"\"\n" doc;
9694       );
9695       pr "        return libguestfsmod.%s " name;
9696       generate_py_call_args ~handle:"self._o" (snd style);
9697       pr "\n";
9698       pr "\n";
9699   ) all_functions
9700
9701 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9702 and generate_py_call_args ~handle args =
9703   pr "(%s" handle;
9704   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9705   pr ")"
9706
9707 (* Useful if you need the longdesc POD text as plain text.  Returns a
9708  * list of lines.
9709  *
9710  * Because this is very slow (the slowest part of autogeneration),
9711  * we memoize the results.
9712  *)
9713 and pod2text ~width name longdesc =
9714   let key = width, name, longdesc in
9715   try Hashtbl.find pod2text_memo key
9716   with Not_found ->
9717     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9718     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9719     close_out chan;
9720     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9721     let chan = open_process_in cmd in
9722     let lines = ref [] in
9723     let rec loop i =
9724       let line = input_line chan in
9725       if i = 1 then             (* discard the first line of output *)
9726         loop (i+1)
9727       else (
9728         let line = triml line in
9729         lines := line :: !lines;
9730         loop (i+1)
9731       ) in
9732     let lines = try loop 1 with End_of_file -> List.rev !lines in
9733     unlink filename;
9734     (match close_process_in chan with
9735      | WEXITED 0 -> ()
9736      | WEXITED i ->
9737          failwithf "pod2text: process exited with non-zero status (%d)" i
9738      | WSIGNALED i | WSTOPPED i ->
9739          failwithf "pod2text: process signalled or stopped by signal %d" i
9740     );
9741     Hashtbl.add pod2text_memo key lines;
9742     pod2text_memo_updated ();
9743     lines
9744
9745 (* Generate ruby bindings. *)
9746 and generate_ruby_c () =
9747   generate_header CStyle LGPLv2plus;
9748
9749   pr "\
9750 #include <stdio.h>
9751 #include <stdlib.h>
9752
9753 #include <ruby.h>
9754
9755 #include \"guestfs.h\"
9756
9757 #include \"extconf.h\"
9758
9759 /* For Ruby < 1.9 */
9760 #ifndef RARRAY_LEN
9761 #define RARRAY_LEN(r) (RARRAY((r))->len)
9762 #endif
9763
9764 static VALUE m_guestfs;                 /* guestfs module */
9765 static VALUE c_guestfs;                 /* guestfs_h handle */
9766 static VALUE e_Error;                   /* used for all errors */
9767
9768 static void ruby_guestfs_free (void *p)
9769 {
9770   if (!p) return;
9771   guestfs_close ((guestfs_h *) p);
9772 }
9773
9774 static VALUE ruby_guestfs_create (VALUE m)
9775 {
9776   guestfs_h *g;
9777
9778   g = guestfs_create ();
9779   if (!g)
9780     rb_raise (e_Error, \"failed to create guestfs handle\");
9781
9782   /* Don't print error messages to stderr by default. */
9783   guestfs_set_error_handler (g, NULL, NULL);
9784
9785   /* Wrap it, and make sure the close function is called when the
9786    * handle goes away.
9787    */
9788   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9789 }
9790
9791 static VALUE ruby_guestfs_close (VALUE gv)
9792 {
9793   guestfs_h *g;
9794   Data_Get_Struct (gv, guestfs_h, g);
9795
9796   ruby_guestfs_free (g);
9797   DATA_PTR (gv) = NULL;
9798
9799   return Qnil;
9800 }
9801
9802 ";
9803
9804   List.iter (
9805     fun (name, style, _, _, _, _, _) ->
9806       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9807       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9808       pr ")\n";
9809       pr "{\n";
9810       pr "  guestfs_h *g;\n";
9811       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9812       pr "  if (!g)\n";
9813       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9814         name;
9815       pr "\n";
9816
9817       List.iter (
9818         function
9819         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9820             pr "  Check_Type (%sv, T_STRING);\n" n;
9821             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9822             pr "  if (!%s)\n" n;
9823             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9824             pr "              \"%s\", \"%s\");\n" n name
9825         | BufferIn n ->
9826             pr "  Check_Type (%sv, T_STRING);\n" n;
9827             pr "  const char *%s = RSTRING (%sv)->ptr;\n" n n;
9828             pr "  if (!%s)\n" n;
9829             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9830             pr "              \"%s\", \"%s\");\n" n name;
9831             pr "  size_t %s_size = RSTRING (%sv)->len;\n" n n
9832         | OptString n ->
9833             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9834         | StringList n | DeviceList n ->
9835             pr "  char **%s;\n" n;
9836             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9837             pr "  {\n";
9838             pr "    int i, len;\n";
9839             pr "    len = RARRAY_LEN (%sv);\n" n;
9840             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9841               n;
9842             pr "    for (i = 0; i < len; ++i) {\n";
9843             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9844             pr "      %s[i] = StringValueCStr (v);\n" n;
9845             pr "    }\n";
9846             pr "    %s[len] = NULL;\n" n;
9847             pr "  }\n";
9848         | Bool n ->
9849             pr "  int %s = RTEST (%sv);\n" n n
9850         | Int n ->
9851             pr "  int %s = NUM2INT (%sv);\n" n n
9852         | Int64 n ->
9853             pr "  long long %s = NUM2LL (%sv);\n" n n
9854       ) (snd style);
9855       pr "\n";
9856
9857       let error_code =
9858         match fst style with
9859         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9860         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9861         | RConstString _ | RConstOptString _ ->
9862             pr "  const char *r;\n"; "NULL"
9863         | RString _ -> pr "  char *r;\n"; "NULL"
9864         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9865         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9866         | RStructList (_, typ) ->
9867             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9868         | RBufferOut _ ->
9869             pr "  char *r;\n";
9870             pr "  size_t size;\n";
9871             "NULL" in
9872       pr "\n";
9873
9874       pr "  r = guestfs_%s " name;
9875       generate_c_call_args ~handle:"g" style;
9876       pr ";\n";
9877
9878       List.iter (
9879         function
9880         | Pathname _ | Device _ | Dev_or_Path _ | String _
9881         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
9882         | BufferIn _ -> ()
9883         | StringList n | DeviceList n ->
9884             pr "  free (%s);\n" n
9885       ) (snd style);
9886
9887       pr "  if (r == %s)\n" error_code;
9888       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9889       pr "\n";
9890
9891       (match fst style with
9892        | RErr ->
9893            pr "  return Qnil;\n"
9894        | RInt _ | RBool _ ->
9895            pr "  return INT2NUM (r);\n"
9896        | RInt64 _ ->
9897            pr "  return ULL2NUM (r);\n"
9898        | RConstString _ ->
9899            pr "  return rb_str_new2 (r);\n";
9900        | RConstOptString _ ->
9901            pr "  if (r)\n";
9902            pr "    return rb_str_new2 (r);\n";
9903            pr "  else\n";
9904            pr "    return Qnil;\n";
9905        | RString _ ->
9906            pr "  VALUE rv = rb_str_new2 (r);\n";
9907            pr "  free (r);\n";
9908            pr "  return rv;\n";
9909        | RStringList _ ->
9910            pr "  int i, len = 0;\n";
9911            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9912            pr "  VALUE rv = rb_ary_new2 (len);\n";
9913            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9914            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9915            pr "    free (r[i]);\n";
9916            pr "  }\n";
9917            pr "  free (r);\n";
9918            pr "  return rv;\n"
9919        | RStruct (_, typ) ->
9920            let cols = cols_of_struct typ in
9921            generate_ruby_struct_code typ cols
9922        | RStructList (_, typ) ->
9923            let cols = cols_of_struct typ in
9924            generate_ruby_struct_list_code typ cols
9925        | RHashtable _ ->
9926            pr "  VALUE rv = rb_hash_new ();\n";
9927            pr "  int i;\n";
9928            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9929            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9930            pr "    free (r[i]);\n";
9931            pr "    free (r[i+1]);\n";
9932            pr "  }\n";
9933            pr "  free (r);\n";
9934            pr "  return rv;\n"
9935        | RBufferOut _ ->
9936            pr "  VALUE rv = rb_str_new (r, size);\n";
9937            pr "  free (r);\n";
9938            pr "  return rv;\n";
9939       );
9940
9941       pr "}\n";
9942       pr "\n"
9943   ) all_functions;
9944
9945   pr "\
9946 /* Initialize the module. */
9947 void Init__guestfs ()
9948 {
9949   m_guestfs = rb_define_module (\"Guestfs\");
9950   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9951   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9952
9953   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9954   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9955
9956 ";
9957   (* Define the rest of the methods. *)
9958   List.iter (
9959     fun (name, style, _, _, _, _, _) ->
9960       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9961       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9962   ) all_functions;
9963
9964   pr "}\n"
9965
9966 (* Ruby code to return a struct. *)
9967 and generate_ruby_struct_code typ cols =
9968   pr "  VALUE rv = rb_hash_new ();\n";
9969   List.iter (
9970     function
9971     | name, FString ->
9972         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9973     | name, FBuffer ->
9974         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9975     | name, FUUID ->
9976         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9977     | name, (FBytes|FUInt64) ->
9978         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9979     | name, FInt64 ->
9980         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9981     | name, FUInt32 ->
9982         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9983     | name, FInt32 ->
9984         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9985     | name, FOptPercent ->
9986         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9987     | name, FChar -> (* XXX wrong? *)
9988         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9989   ) cols;
9990   pr "  guestfs_free_%s (r);\n" typ;
9991   pr "  return rv;\n"
9992
9993 (* Ruby code to return a struct list. *)
9994 and generate_ruby_struct_list_code typ cols =
9995   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9996   pr "  int i;\n";
9997   pr "  for (i = 0; i < r->len; ++i) {\n";
9998   pr "    VALUE hv = rb_hash_new ();\n";
9999   List.iter (
10000     function
10001     | name, FString ->
10002         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
10003     | name, FBuffer ->
10004         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
10005     | name, FUUID ->
10006         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
10007     | name, (FBytes|FUInt64) ->
10008         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
10009     | name, FInt64 ->
10010         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
10011     | name, FUInt32 ->
10012         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
10013     | name, FInt32 ->
10014         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
10015     | name, FOptPercent ->
10016         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
10017     | name, FChar -> (* XXX wrong? *)
10018         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
10019   ) cols;
10020   pr "    rb_ary_push (rv, hv);\n";
10021   pr "  }\n";
10022   pr "  guestfs_free_%s_list (r);\n" typ;
10023   pr "  return rv;\n"
10024
10025 (* Generate Java bindings GuestFS.java file. *)
10026 and generate_java_java () =
10027   generate_header CStyle LGPLv2plus;
10028
10029   pr "\
10030 package com.redhat.et.libguestfs;
10031
10032 import java.util.HashMap;
10033 import com.redhat.et.libguestfs.LibGuestFSException;
10034 import com.redhat.et.libguestfs.PV;
10035 import com.redhat.et.libguestfs.VG;
10036 import com.redhat.et.libguestfs.LV;
10037 import com.redhat.et.libguestfs.Stat;
10038 import com.redhat.et.libguestfs.StatVFS;
10039 import com.redhat.et.libguestfs.IntBool;
10040 import com.redhat.et.libguestfs.Dirent;
10041
10042 /**
10043  * The GuestFS object is a libguestfs handle.
10044  *
10045  * @author rjones
10046  */
10047 public class GuestFS {
10048   // Load the native code.
10049   static {
10050     System.loadLibrary (\"guestfs_jni\");
10051   }
10052
10053   /**
10054    * The native guestfs_h pointer.
10055    */
10056   long g;
10057
10058   /**
10059    * Create a libguestfs handle.
10060    *
10061    * @throws LibGuestFSException
10062    */
10063   public GuestFS () throws LibGuestFSException
10064   {
10065     g = _create ();
10066   }
10067   private native long _create () throws LibGuestFSException;
10068
10069   /**
10070    * Close a libguestfs handle.
10071    *
10072    * You can also leave handles to be collected by the garbage
10073    * collector, but this method ensures that the resources used
10074    * by the handle are freed up immediately.  If you call any
10075    * other methods after closing the handle, you will get an
10076    * exception.
10077    *
10078    * @throws LibGuestFSException
10079    */
10080   public void close () throws LibGuestFSException
10081   {
10082     if (g != 0)
10083       _close (g);
10084     g = 0;
10085   }
10086   private native void _close (long g) throws LibGuestFSException;
10087
10088   public void finalize () throws LibGuestFSException
10089   {
10090     close ();
10091   }
10092
10093 ";
10094
10095   List.iter (
10096     fun (name, style, _, flags, _, shortdesc, longdesc) ->
10097       if not (List.mem NotInDocs flags); then (
10098         let doc = replace_str longdesc "C<guestfs_" "C<g." in
10099         let doc =
10100           if List.mem ProtocolLimitWarning flags then
10101             doc ^ "\n\n" ^ protocol_limit_warning
10102           else doc in
10103         let doc =
10104           if List.mem DangerWillRobinson flags then
10105             doc ^ "\n\n" ^ danger_will_robinson
10106           else doc in
10107         let doc =
10108           match deprecation_notice flags with
10109           | None -> doc
10110           | Some txt -> doc ^ "\n\n" ^ txt in
10111         let doc = pod2text ~width:60 name doc in
10112         let doc = List.map (            (* RHBZ#501883 *)
10113           function
10114           | "" -> "<p>"
10115           | nonempty -> nonempty
10116         ) doc in
10117         let doc = String.concat "\n   * " doc in
10118
10119         pr "  /**\n";
10120         pr "   * %s\n" shortdesc;
10121         pr "   * <p>\n";
10122         pr "   * %s\n" doc;
10123         pr "   * @throws LibGuestFSException\n";
10124         pr "   */\n";
10125         pr "  ";
10126       );
10127       generate_java_prototype ~public:true ~semicolon:false name style;
10128       pr "\n";
10129       pr "  {\n";
10130       pr "    if (g == 0)\n";
10131       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
10132         name;
10133       pr "    ";
10134       if fst style <> RErr then pr "return ";
10135       pr "_%s " name;
10136       generate_java_call_args ~handle:"g" (snd style);
10137       pr ";\n";
10138       pr "  }\n";
10139       pr "  ";
10140       generate_java_prototype ~privat:true ~native:true name style;
10141       pr "\n";
10142       pr "\n";
10143   ) all_functions;
10144
10145   pr "}\n"
10146
10147 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
10148 and generate_java_call_args ~handle args =
10149   pr "(%s" handle;
10150   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
10151   pr ")"
10152
10153 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
10154     ?(semicolon=true) name style =
10155   if privat then pr "private ";
10156   if public then pr "public ";
10157   if native then pr "native ";
10158
10159   (* return type *)
10160   (match fst style with
10161    | RErr -> pr "void ";
10162    | RInt _ -> pr "int ";
10163    | RInt64 _ -> pr "long ";
10164    | RBool _ -> pr "boolean ";
10165    | RConstString _ | RConstOptString _ | RString _
10166    | RBufferOut _ -> pr "String ";
10167    | RStringList _ -> pr "String[] ";
10168    | RStruct (_, typ) ->
10169        let name = java_name_of_struct typ in
10170        pr "%s " name;
10171    | RStructList (_, typ) ->
10172        let name = java_name_of_struct typ in
10173        pr "%s[] " name;
10174    | RHashtable _ -> pr "HashMap<String,String> ";
10175   );
10176
10177   if native then pr "_%s " name else pr "%s " name;
10178   pr "(";
10179   let needs_comma = ref false in
10180   if native then (
10181     pr "long g";
10182     needs_comma := true
10183   );
10184
10185   (* args *)
10186   List.iter (
10187     fun arg ->
10188       if !needs_comma then pr ", ";
10189       needs_comma := true;
10190
10191       match arg with
10192       | Pathname n
10193       | Device n | Dev_or_Path n
10194       | String n
10195       | OptString n
10196       | FileIn n
10197       | FileOut n ->
10198           pr "String %s" n
10199       | BufferIn n ->
10200           pr "byte[] %s" n
10201       | StringList n | DeviceList n ->
10202           pr "String[] %s" n
10203       | Bool n ->
10204           pr "boolean %s" n
10205       | Int n ->
10206           pr "int %s" n
10207       | Int64 n ->
10208           pr "long %s" n
10209   ) (snd style);
10210
10211   pr ")\n";
10212   pr "    throws LibGuestFSException";
10213   if semicolon then pr ";"
10214
10215 and generate_java_struct jtyp cols () =
10216   generate_header CStyle LGPLv2plus;
10217
10218   pr "\
10219 package com.redhat.et.libguestfs;
10220
10221 /**
10222  * Libguestfs %s structure.
10223  *
10224  * @author rjones
10225  * @see GuestFS
10226  */
10227 public class %s {
10228 " jtyp jtyp;
10229
10230   List.iter (
10231     function
10232     | name, FString
10233     | name, FUUID
10234     | name, FBuffer -> pr "  public String %s;\n" name
10235     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
10236     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
10237     | name, FChar -> pr "  public char %s;\n" name
10238     | name, FOptPercent ->
10239         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
10240         pr "  public float %s;\n" name
10241   ) cols;
10242
10243   pr "}\n"
10244
10245 and generate_java_c () =
10246   generate_header CStyle LGPLv2plus;
10247
10248   pr "\
10249 #include <stdio.h>
10250 #include <stdlib.h>
10251 #include <string.h>
10252
10253 #include \"com_redhat_et_libguestfs_GuestFS.h\"
10254 #include \"guestfs.h\"
10255
10256 /* Note that this function returns.  The exception is not thrown
10257  * until after the wrapper function returns.
10258  */
10259 static void
10260 throw_exception (JNIEnv *env, const char *msg)
10261 {
10262   jclass cl;
10263   cl = (*env)->FindClass (env,
10264                           \"com/redhat/et/libguestfs/LibGuestFSException\");
10265   (*env)->ThrowNew (env, cl, msg);
10266 }
10267
10268 JNIEXPORT jlong JNICALL
10269 Java_com_redhat_et_libguestfs_GuestFS__1create
10270   (JNIEnv *env, jobject obj)
10271 {
10272   guestfs_h *g;
10273
10274   g = guestfs_create ();
10275   if (g == NULL) {
10276     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
10277     return 0;
10278   }
10279   guestfs_set_error_handler (g, NULL, NULL);
10280   return (jlong) (long) g;
10281 }
10282
10283 JNIEXPORT void JNICALL
10284 Java_com_redhat_et_libguestfs_GuestFS__1close
10285   (JNIEnv *env, jobject obj, jlong jg)
10286 {
10287   guestfs_h *g = (guestfs_h *) (long) jg;
10288   guestfs_close (g);
10289 }
10290
10291 ";
10292
10293   List.iter (
10294     fun (name, style, _, _, _, _, _) ->
10295       pr "JNIEXPORT ";
10296       (match fst style with
10297        | RErr -> pr "void ";
10298        | RInt _ -> pr "jint ";
10299        | RInt64 _ -> pr "jlong ";
10300        | RBool _ -> pr "jboolean ";
10301        | RConstString _ | RConstOptString _ | RString _
10302        | RBufferOut _ -> pr "jstring ";
10303        | RStruct _ | RHashtable _ ->
10304            pr "jobject ";
10305        | RStringList _ | RStructList _ ->
10306            pr "jobjectArray ";
10307       );
10308       pr "JNICALL\n";
10309       pr "Java_com_redhat_et_libguestfs_GuestFS_";
10310       pr "%s" (replace_str ("_" ^ name) "_" "_1");
10311       pr "\n";
10312       pr "  (JNIEnv *env, jobject obj, jlong jg";
10313       List.iter (
10314         function
10315         | Pathname n
10316         | Device n | Dev_or_Path n
10317         | String n
10318         | OptString n
10319         | FileIn n
10320         | FileOut n ->
10321             pr ", jstring j%s" n
10322         | BufferIn n ->
10323             pr ", jbyteArray j%s" n
10324         | StringList n | DeviceList n ->
10325             pr ", jobjectArray j%s" n
10326         | Bool n ->
10327             pr ", jboolean j%s" n
10328         | Int n ->
10329             pr ", jint j%s" n
10330         | Int64 n ->
10331             pr ", jlong j%s" n
10332       ) (snd style);
10333       pr ")\n";
10334       pr "{\n";
10335       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
10336       let error_code, no_ret =
10337         match fst style with
10338         | RErr -> pr "  int r;\n"; "-1", ""
10339         | RBool _
10340         | RInt _ -> pr "  int r;\n"; "-1", "0"
10341         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
10342         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
10343         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
10344         | RString _ ->
10345             pr "  jstring jr;\n";
10346             pr "  char *r;\n"; "NULL", "NULL"
10347         | RStringList _ ->
10348             pr "  jobjectArray jr;\n";
10349             pr "  int r_len;\n";
10350             pr "  jclass cl;\n";
10351             pr "  jstring jstr;\n";
10352             pr "  char **r;\n"; "NULL", "NULL"
10353         | RStruct (_, typ) ->
10354             pr "  jobject jr;\n";
10355             pr "  jclass cl;\n";
10356             pr "  jfieldID fl;\n";
10357             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
10358         | RStructList (_, typ) ->
10359             pr "  jobjectArray jr;\n";
10360             pr "  jclass cl;\n";
10361             pr "  jfieldID fl;\n";
10362             pr "  jobject jfl;\n";
10363             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
10364         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
10365         | RBufferOut _ ->
10366             pr "  jstring jr;\n";
10367             pr "  char *r;\n";
10368             pr "  size_t size;\n";
10369             "NULL", "NULL" in
10370       List.iter (
10371         function
10372         | Pathname n
10373         | Device n | Dev_or_Path n
10374         | String n
10375         | OptString n
10376         | FileIn n
10377         | FileOut n ->
10378             pr "  const char *%s;\n" n
10379         | BufferIn n ->
10380             pr "  jbyte *%s;\n" n;
10381             pr "  size_t %s_size;\n" n
10382         | StringList n | DeviceList n ->
10383             pr "  int %s_len;\n" n;
10384             pr "  const char **%s;\n" n
10385         | Bool n
10386         | Int n ->
10387             pr "  int %s;\n" n
10388         | Int64 n ->
10389             pr "  int64_t %s;\n" n
10390       ) (snd style);
10391
10392       let needs_i =
10393         (match fst style with
10394          | RStringList _ | RStructList _ -> true
10395          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
10396          | RConstOptString _
10397          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
10398           List.exists (function
10399                        | StringList _ -> true
10400                        | DeviceList _ -> true
10401                        | _ -> false) (snd style) in
10402       if needs_i then
10403         pr "  int i;\n";
10404
10405       pr "\n";
10406
10407       (* Get the parameters. *)
10408       List.iter (
10409         function
10410         | Pathname n
10411         | Device n | Dev_or_Path n
10412         | String n
10413         | FileIn n
10414         | FileOut n ->
10415             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
10416         | OptString n ->
10417             (* This is completely undocumented, but Java null becomes
10418              * a NULL parameter.
10419              *)
10420             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
10421         | BufferIn n ->
10422             pr "  %s = (*env)->GetByteArrayElements (env, j%s, NULL);\n" n n;
10423             pr "  %s_size = (*env)->GetArrayLength (env, j%s);\n" n n
10424         | StringList n | DeviceList n ->
10425             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
10426             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
10427             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10428             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10429               n;
10430             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
10431             pr "  }\n";
10432             pr "  %s[%s_len] = NULL;\n" n n;
10433         | Bool n
10434         | Int n
10435         | Int64 n ->
10436             pr "  %s = j%s;\n" n n
10437       ) (snd style);
10438
10439       (* Make the call. *)
10440       pr "  r = guestfs_%s " name;
10441       generate_c_call_args ~handle:"g" style;
10442       pr ";\n";
10443
10444       (* Release the parameters. *)
10445       List.iter (
10446         function
10447         | Pathname n
10448         | Device n | Dev_or_Path n
10449         | String n
10450         | FileIn n
10451         | FileOut n ->
10452             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10453         | OptString n ->
10454             pr "  if (j%s)\n" n;
10455             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
10456         | BufferIn n ->
10457             pr "  (*env)->ReleaseByteArrayElements (env, j%s, %s, 0);\n" n n
10458         | StringList n | DeviceList n ->
10459             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10460             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10461               n;
10462             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10463             pr "  }\n";
10464             pr "  free (%s);\n" n
10465         | Bool n
10466         | Int n
10467         | Int64 n -> ()
10468       ) (snd style);
10469
10470       (* Check for errors. *)
10471       pr "  if (r == %s) {\n" error_code;
10472       pr "    throw_exception (env, guestfs_last_error (g));\n";
10473       pr "    return %s;\n" no_ret;
10474       pr "  }\n";
10475
10476       (* Return value. *)
10477       (match fst style with
10478        | RErr -> ()
10479        | RInt _ -> pr "  return (jint) r;\n"
10480        | RBool _ -> pr "  return (jboolean) r;\n"
10481        | RInt64 _ -> pr "  return (jlong) r;\n"
10482        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10483        | RConstOptString _ ->
10484            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10485        | RString _ ->
10486            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10487            pr "  free (r);\n";
10488            pr "  return jr;\n"
10489        | RStringList _ ->
10490            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10491            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10492            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10493            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10494            pr "  for (i = 0; i < r_len; ++i) {\n";
10495            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10496            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10497            pr "    free (r[i]);\n";
10498            pr "  }\n";
10499            pr "  free (r);\n";
10500            pr "  return jr;\n"
10501        | RStruct (_, typ) ->
10502            let jtyp = java_name_of_struct typ in
10503            let cols = cols_of_struct typ in
10504            generate_java_struct_return typ jtyp cols
10505        | RStructList (_, typ) ->
10506            let jtyp = java_name_of_struct typ in
10507            let cols = cols_of_struct typ in
10508            generate_java_struct_list_return typ jtyp cols
10509        | RHashtable _ ->
10510            (* XXX *)
10511            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10512            pr "  return NULL;\n"
10513        | RBufferOut _ ->
10514            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10515            pr "  free (r);\n";
10516            pr "  return jr;\n"
10517       );
10518
10519       pr "}\n";
10520       pr "\n"
10521   ) all_functions
10522
10523 and generate_java_struct_return typ jtyp cols =
10524   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10525   pr "  jr = (*env)->AllocObject (env, cl);\n";
10526   List.iter (
10527     function
10528     | name, FString ->
10529         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10530         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10531     | name, FUUID ->
10532         pr "  {\n";
10533         pr "    char s[33];\n";
10534         pr "    memcpy (s, r->%s, 32);\n" name;
10535         pr "    s[32] = 0;\n";
10536         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10537         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10538         pr "  }\n";
10539     | name, FBuffer ->
10540         pr "  {\n";
10541         pr "    int len = r->%s_len;\n" name;
10542         pr "    char s[len+1];\n";
10543         pr "    memcpy (s, r->%s, len);\n" name;
10544         pr "    s[len] = 0;\n";
10545         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10546         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10547         pr "  }\n";
10548     | name, (FBytes|FUInt64|FInt64) ->
10549         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10550         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10551     | name, (FUInt32|FInt32) ->
10552         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10553         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10554     | name, FOptPercent ->
10555         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10556         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10557     | name, FChar ->
10558         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10559         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10560   ) cols;
10561   pr "  free (r);\n";
10562   pr "  return jr;\n"
10563
10564 and generate_java_struct_list_return typ jtyp cols =
10565   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10566   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10567   pr "  for (i = 0; i < r->len; ++i) {\n";
10568   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10569   List.iter (
10570     function
10571     | name, FString ->
10572         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10573         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10574     | name, FUUID ->
10575         pr "    {\n";
10576         pr "      char s[33];\n";
10577         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10578         pr "      s[32] = 0;\n";
10579         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10580         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10581         pr "    }\n";
10582     | name, FBuffer ->
10583         pr "    {\n";
10584         pr "      int len = r->val[i].%s_len;\n" name;
10585         pr "      char s[len+1];\n";
10586         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10587         pr "      s[len] = 0;\n";
10588         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10589         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10590         pr "    }\n";
10591     | name, (FBytes|FUInt64|FInt64) ->
10592         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10593         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10594     | name, (FUInt32|FInt32) ->
10595         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10596         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10597     | name, FOptPercent ->
10598         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10599         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10600     | name, FChar ->
10601         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10602         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10603   ) cols;
10604   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10605   pr "  }\n";
10606   pr "  guestfs_free_%s_list (r);\n" typ;
10607   pr "  return jr;\n"
10608
10609 and generate_java_makefile_inc () =
10610   generate_header HashStyle GPLv2plus;
10611
10612   pr "java_built_sources = \\\n";
10613   List.iter (
10614     fun (typ, jtyp) ->
10615         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10616   ) java_structs;
10617   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10618
10619 and generate_haskell_hs () =
10620   generate_header HaskellStyle LGPLv2plus;
10621
10622   (* XXX We only know how to generate partial FFI for Haskell
10623    * at the moment.  Please help out!
10624    *)
10625   let can_generate style =
10626     match style with
10627     | RErr, _
10628     | RInt _, _
10629     | RInt64 _, _ -> true
10630     | RBool _, _
10631     | RConstString _, _
10632     | RConstOptString _, _
10633     | RString _, _
10634     | RStringList _, _
10635     | RStruct _, _
10636     | RStructList _, _
10637     | RHashtable _, _
10638     | RBufferOut _, _ -> false in
10639
10640   pr "\
10641 {-# INCLUDE <guestfs.h> #-}
10642 {-# LANGUAGE ForeignFunctionInterface #-}
10643
10644 module Guestfs (
10645   create";
10646
10647   (* List out the names of the actions we want to export. *)
10648   List.iter (
10649     fun (name, style, _, _, _, _, _) ->
10650       if can_generate style then pr ",\n  %s" name
10651   ) all_functions;
10652
10653   pr "
10654   ) where
10655
10656 -- Unfortunately some symbols duplicate ones already present
10657 -- in Prelude.  We don't know which, so we hard-code a list
10658 -- here.
10659 import Prelude hiding (truncate)
10660
10661 import Foreign
10662 import Foreign.C
10663 import Foreign.C.Types
10664 import IO
10665 import Control.Exception
10666 import Data.Typeable
10667
10668 data GuestfsS = GuestfsS            -- represents the opaque C struct
10669 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10670 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10671
10672 -- XXX define properly later XXX
10673 data PV = PV
10674 data VG = VG
10675 data LV = LV
10676 data IntBool = IntBool
10677 data Stat = Stat
10678 data StatVFS = StatVFS
10679 data Hashtable = Hashtable
10680
10681 foreign import ccall unsafe \"guestfs_create\" c_create
10682   :: IO GuestfsP
10683 foreign import ccall unsafe \"&guestfs_close\" c_close
10684   :: FunPtr (GuestfsP -> IO ())
10685 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10686   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10687
10688 create :: IO GuestfsH
10689 create = do
10690   p <- c_create
10691   c_set_error_handler p nullPtr nullPtr
10692   h <- newForeignPtr c_close p
10693   return h
10694
10695 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10696   :: GuestfsP -> IO CString
10697
10698 -- last_error :: GuestfsH -> IO (Maybe String)
10699 -- last_error h = do
10700 --   str <- withForeignPtr h (\\p -> c_last_error p)
10701 --   maybePeek peekCString str
10702
10703 last_error :: GuestfsH -> IO (String)
10704 last_error h = do
10705   str <- withForeignPtr h (\\p -> c_last_error p)
10706   if (str == nullPtr)
10707     then return \"no error\"
10708     else peekCString str
10709
10710 ";
10711
10712   (* Generate wrappers for each foreign function. *)
10713   List.iter (
10714     fun (name, style, _, _, _, _, _) ->
10715       if can_generate style then (
10716         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10717         pr "  :: ";
10718         generate_haskell_prototype ~handle:"GuestfsP" style;
10719         pr "\n";
10720         pr "\n";
10721         pr "%s :: " name;
10722         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10723         pr "\n";
10724         pr "%s %s = do\n" name
10725           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10726         pr "  r <- ";
10727         (* Convert pointer arguments using with* functions. *)
10728         List.iter (
10729           function
10730           | FileIn n
10731           | FileOut n
10732           | Pathname n | Device n | Dev_or_Path n | String n ->
10733               pr "withCString %s $ \\%s -> " n n
10734           | BufferIn n ->
10735               pr "withCStringLen %s $ \\(%s, %s_size) -> " n n n
10736           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10737           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10738           | Bool _ | Int _ | Int64 _ -> ()
10739         ) (snd style);
10740         (* Convert integer arguments. *)
10741         let args =
10742           List.map (
10743             function
10744             | Bool n -> sprintf "(fromBool %s)" n
10745             | Int n -> sprintf "(fromIntegral %s)" n
10746             | Int64 n -> sprintf "(fromIntegral %s)" n
10747             | FileIn n | FileOut n
10748             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10749             | BufferIn n -> sprintf "%s (fromIntegral %s_size)" n n
10750           ) (snd style) in
10751         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10752           (String.concat " " ("p" :: args));
10753         (match fst style with
10754          | RErr | RInt _ | RInt64 _ | RBool _ ->
10755              pr "  if (r == -1)\n";
10756              pr "    then do\n";
10757              pr "      err <- last_error h\n";
10758              pr "      fail err\n";
10759          | RConstString _ | RConstOptString _ | RString _
10760          | RStringList _ | RStruct _
10761          | RStructList _ | RHashtable _ | RBufferOut _ ->
10762              pr "  if (r == nullPtr)\n";
10763              pr "    then do\n";
10764              pr "      err <- last_error h\n";
10765              pr "      fail err\n";
10766         );
10767         (match fst style with
10768          | RErr ->
10769              pr "    else return ()\n"
10770          | RInt _ ->
10771              pr "    else return (fromIntegral r)\n"
10772          | RInt64 _ ->
10773              pr "    else return (fromIntegral r)\n"
10774          | RBool _ ->
10775              pr "    else return (toBool r)\n"
10776          | RConstString _
10777          | RConstOptString _
10778          | RString _
10779          | RStringList _
10780          | RStruct _
10781          | RStructList _
10782          | RHashtable _
10783          | RBufferOut _ ->
10784              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10785         );
10786         pr "\n";
10787       )
10788   ) all_functions
10789
10790 and generate_haskell_prototype ~handle ?(hs = false) style =
10791   pr "%s -> " handle;
10792   let string = if hs then "String" else "CString" in
10793   let int = if hs then "Int" else "CInt" in
10794   let bool = if hs then "Bool" else "CInt" in
10795   let int64 = if hs then "Integer" else "Int64" in
10796   List.iter (
10797     fun arg ->
10798       (match arg with
10799        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10800        | BufferIn _ ->
10801            if hs then pr "String"
10802            else pr "CString -> CInt"
10803        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10804        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10805        | Bool _ -> pr "%s" bool
10806        | Int _ -> pr "%s" int
10807        | Int64 _ -> pr "%s" int
10808        | FileIn _ -> pr "%s" string
10809        | FileOut _ -> pr "%s" string
10810       );
10811       pr " -> ";
10812   ) (snd style);
10813   pr "IO (";
10814   (match fst style with
10815    | RErr -> if not hs then pr "CInt"
10816    | RInt _ -> pr "%s" int
10817    | RInt64 _ -> pr "%s" int64
10818    | RBool _ -> pr "%s" bool
10819    | RConstString _ -> pr "%s" string
10820    | RConstOptString _ -> pr "Maybe %s" string
10821    | RString _ -> pr "%s" string
10822    | RStringList _ -> pr "[%s]" string
10823    | RStruct (_, typ) ->
10824        let name = java_name_of_struct typ in
10825        pr "%s" name
10826    | RStructList (_, typ) ->
10827        let name = java_name_of_struct typ in
10828        pr "[%s]" name
10829    | RHashtable _ -> pr "Hashtable"
10830    | RBufferOut _ -> pr "%s" string
10831   );
10832   pr ")"
10833
10834 and generate_csharp () =
10835   generate_header CPlusPlusStyle LGPLv2plus;
10836
10837   (* XXX Make this configurable by the C# assembly users. *)
10838   let library = "libguestfs.so.0" in
10839
10840   pr "\
10841 // These C# bindings are highly experimental at present.
10842 //
10843 // Firstly they only work on Linux (ie. Mono).  In order to get them
10844 // to work on Windows (ie. .Net) you would need to port the library
10845 // itself to Windows first.
10846 //
10847 // The second issue is that some calls are known to be incorrect and
10848 // can cause Mono to segfault.  Particularly: calls which pass or
10849 // return string[], or return any structure value.  This is because
10850 // we haven't worked out the correct way to do this from C#.
10851 //
10852 // The third issue is that when compiling you get a lot of warnings.
10853 // We are not sure whether the warnings are important or not.
10854 //
10855 // Fourthly we do not routinely build or test these bindings as part
10856 // of the make && make check cycle, which means that regressions might
10857 // go unnoticed.
10858 //
10859 // Suggestions and patches are welcome.
10860
10861 // To compile:
10862 //
10863 // gmcs Libguestfs.cs
10864 // mono Libguestfs.exe
10865 //
10866 // (You'll probably want to add a Test class / static main function
10867 // otherwise this won't do anything useful).
10868
10869 using System;
10870 using System.IO;
10871 using System.Runtime.InteropServices;
10872 using System.Runtime.Serialization;
10873 using System.Collections;
10874
10875 namespace Guestfs
10876 {
10877   class Error : System.ApplicationException
10878   {
10879     public Error (string message) : base (message) {}
10880     protected Error (SerializationInfo info, StreamingContext context) {}
10881   }
10882
10883   class Guestfs
10884   {
10885     IntPtr _handle;
10886
10887     [DllImport (\"%s\")]
10888     static extern IntPtr guestfs_create ();
10889
10890     public Guestfs ()
10891     {
10892       _handle = guestfs_create ();
10893       if (_handle == IntPtr.Zero)
10894         throw new Error (\"could not create guestfs handle\");
10895     }
10896
10897     [DllImport (\"%s\")]
10898     static extern void guestfs_close (IntPtr h);
10899
10900     ~Guestfs ()
10901     {
10902       guestfs_close (_handle);
10903     }
10904
10905     [DllImport (\"%s\")]
10906     static extern string guestfs_last_error (IntPtr h);
10907
10908 " library library library;
10909
10910   (* Generate C# structure bindings.  We prefix struct names with
10911    * underscore because C# cannot have conflicting struct names and
10912    * method names (eg. "class stat" and "stat").
10913    *)
10914   List.iter (
10915     fun (typ, cols) ->
10916       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10917       pr "    public class _%s {\n" typ;
10918       List.iter (
10919         function
10920         | name, FChar -> pr "      char %s;\n" name
10921         | name, FString -> pr "      string %s;\n" name
10922         | name, FBuffer ->
10923             pr "      uint %s_len;\n" name;
10924             pr "      string %s;\n" name
10925         | name, FUUID ->
10926             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10927             pr "      string %s;\n" name
10928         | name, FUInt32 -> pr "      uint %s;\n" name
10929         | name, FInt32 -> pr "      int %s;\n" name
10930         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10931         | name, FInt64 -> pr "      long %s;\n" name
10932         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10933       ) cols;
10934       pr "    }\n";
10935       pr "\n"
10936   ) structs;
10937
10938   (* Generate C# function bindings. *)
10939   List.iter (
10940     fun (name, style, _, _, _, shortdesc, _) ->
10941       let rec csharp_return_type () =
10942         match fst style with
10943         | RErr -> "void"
10944         | RBool n -> "bool"
10945         | RInt n -> "int"
10946         | RInt64 n -> "long"
10947         | RConstString n
10948         | RConstOptString n
10949         | RString n
10950         | RBufferOut n -> "string"
10951         | RStruct (_,n) -> "_" ^ n
10952         | RHashtable n -> "Hashtable"
10953         | RStringList n -> "string[]"
10954         | RStructList (_,n) -> sprintf "_%s[]" n
10955
10956       and c_return_type () =
10957         match fst style with
10958         | RErr
10959         | RBool _
10960         | RInt _ -> "int"
10961         | RInt64 _ -> "long"
10962         | RConstString _
10963         | RConstOptString _
10964         | RString _
10965         | RBufferOut _ -> "string"
10966         | RStruct (_,n) -> "_" ^ n
10967         | RHashtable _
10968         | RStringList _ -> "string[]"
10969         | RStructList (_,n) -> sprintf "_%s[]" n
10970
10971       and c_error_comparison () =
10972         match fst style with
10973         | RErr
10974         | RBool _
10975         | RInt _
10976         | RInt64 _ -> "== -1"
10977         | RConstString _
10978         | RConstOptString _
10979         | RString _
10980         | RBufferOut _
10981         | RStruct (_,_)
10982         | RHashtable _
10983         | RStringList _
10984         | RStructList (_,_) -> "== null"
10985
10986       and generate_extern_prototype () =
10987         pr "    static extern %s guestfs_%s (IntPtr h"
10988           (c_return_type ()) name;
10989         List.iter (
10990           function
10991           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10992           | FileIn n | FileOut n
10993           | BufferIn n ->
10994               pr ", [In] string %s" n
10995           | StringList n | DeviceList n ->
10996               pr ", [In] string[] %s" n
10997           | Bool n ->
10998               pr ", bool %s" n
10999           | Int n ->
11000               pr ", int %s" n
11001           | Int64 n ->
11002               pr ", long %s" n
11003         ) (snd style);
11004         pr ");\n"
11005
11006       and generate_public_prototype () =
11007         pr "    public %s %s (" (csharp_return_type ()) name;
11008         let comma = ref false in
11009         let next () =
11010           if !comma then pr ", ";
11011           comma := true
11012         in
11013         List.iter (
11014           function
11015           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
11016           | FileIn n | FileOut n
11017           | BufferIn n ->
11018               next (); pr "string %s" n
11019           | StringList n | DeviceList n ->
11020               next (); pr "string[] %s" n
11021           | Bool n ->
11022               next (); pr "bool %s" n
11023           | Int n ->
11024               next (); pr "int %s" n
11025           | Int64 n ->
11026               next (); pr "long %s" n
11027         ) (snd style);
11028         pr ")\n"
11029
11030       and generate_call () =
11031         pr "guestfs_%s (_handle" name;
11032         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
11033         pr ");\n";
11034       in
11035
11036       pr "    [DllImport (\"%s\")]\n" library;
11037       generate_extern_prototype ();
11038       pr "\n";
11039       pr "    /// <summary>\n";
11040       pr "    /// %s\n" shortdesc;
11041       pr "    /// </summary>\n";
11042       generate_public_prototype ();
11043       pr "    {\n";
11044       pr "      %s r;\n" (c_return_type ());
11045       pr "      r = ";
11046       generate_call ();
11047       pr "      if (r %s)\n" (c_error_comparison ());
11048       pr "        throw new Error (guestfs_last_error (_handle));\n";
11049       (match fst style with
11050        | RErr -> ()
11051        | RBool _ ->
11052            pr "      return r != 0 ? true : false;\n"
11053        | RHashtable _ ->
11054            pr "      Hashtable rr = new Hashtable ();\n";
11055            pr "      for (int i = 0; i < r.Length; i += 2)\n";
11056            pr "        rr.Add (r[i], r[i+1]);\n";
11057            pr "      return rr;\n"
11058        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
11059        | RString _ | RBufferOut _ | RStruct _ | RStringList _
11060        | RStructList _ ->
11061            pr "      return r;\n"
11062       );
11063       pr "    }\n";
11064       pr "\n";
11065   ) all_functions_sorted;
11066
11067   pr "  }
11068 }
11069 "
11070
11071 and generate_bindtests () =
11072   generate_header CStyle LGPLv2plus;
11073
11074   pr "\
11075 #include <stdio.h>
11076 #include <stdlib.h>
11077 #include <inttypes.h>
11078 #include <string.h>
11079
11080 #include \"guestfs.h\"
11081 #include \"guestfs-internal.h\"
11082 #include \"guestfs-internal-actions.h\"
11083 #include \"guestfs_protocol.h\"
11084
11085 #define error guestfs_error
11086 #define safe_calloc guestfs_safe_calloc
11087 #define safe_malloc guestfs_safe_malloc
11088
11089 static void
11090 print_strings (char *const *argv)
11091 {
11092   int argc;
11093
11094   printf (\"[\");
11095   for (argc = 0; argv[argc] != NULL; ++argc) {
11096     if (argc > 0) printf (\", \");
11097     printf (\"\\\"%%s\\\"\", argv[argc]);
11098   }
11099   printf (\"]\\n\");
11100 }
11101
11102 /* The test0 function prints its parameters to stdout. */
11103 ";
11104
11105   let test0, tests =
11106     match test_functions with
11107     | [] -> assert false
11108     | test0 :: tests -> test0, tests in
11109
11110   let () =
11111     let (name, style, _, _, _, _, _) = test0 in
11112     generate_prototype ~extern:false ~semicolon:false ~newline:true
11113       ~handle:"g" ~prefix:"guestfs__" name style;
11114     pr "{\n";
11115     List.iter (
11116       function
11117       | Pathname n
11118       | Device n | Dev_or_Path n
11119       | String n
11120       | FileIn n
11121       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
11122       | BufferIn n ->
11123           pr "  {\n";
11124           pr "    size_t i;\n";
11125           pr "    for (i = 0; i < %s_size; ++i)\n" n;
11126           pr "      printf (\"<%%02x>\", %s[i]);\n" n;
11127           pr "    printf (\"\\n\");\n";
11128           pr "  }\n";
11129       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
11130       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
11131       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
11132       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
11133       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
11134     ) (snd style);
11135     pr "  /* Java changes stdout line buffering so we need this: */\n";
11136     pr "  fflush (stdout);\n";
11137     pr "  return 0;\n";
11138     pr "}\n";
11139     pr "\n" in
11140
11141   List.iter (
11142     fun (name, style, _, _, _, _, _) ->
11143       if String.sub name (String.length name - 3) 3 <> "err" then (
11144         pr "/* Test normal return. */\n";
11145         generate_prototype ~extern:false ~semicolon:false ~newline:true
11146           ~handle:"g" ~prefix:"guestfs__" name style;
11147         pr "{\n";
11148         (match fst style with
11149          | RErr ->
11150              pr "  return 0;\n"
11151          | RInt _ ->
11152              pr "  int r;\n";
11153              pr "  sscanf (val, \"%%d\", &r);\n";
11154              pr "  return r;\n"
11155          | RInt64 _ ->
11156              pr "  int64_t r;\n";
11157              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
11158              pr "  return r;\n"
11159          | RBool _ ->
11160              pr "  return STREQ (val, \"true\");\n"
11161          | RConstString _
11162          | RConstOptString _ ->
11163              (* Can't return the input string here.  Return a static
11164               * string so we ensure we get a segfault if the caller
11165               * tries to free it.
11166               *)
11167              pr "  return \"static string\";\n"
11168          | RString _ ->
11169              pr "  return strdup (val);\n"
11170          | RStringList _ ->
11171              pr "  char **strs;\n";
11172              pr "  int n, i;\n";
11173              pr "  sscanf (val, \"%%d\", &n);\n";
11174              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
11175              pr "  for (i = 0; i < n; ++i) {\n";
11176              pr "    strs[i] = safe_malloc (g, 16);\n";
11177              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
11178              pr "  }\n";
11179              pr "  strs[n] = NULL;\n";
11180              pr "  return strs;\n"
11181          | RStruct (_, typ) ->
11182              pr "  struct guestfs_%s *r;\n" typ;
11183              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
11184              pr "  return r;\n"
11185          | RStructList (_, typ) ->
11186              pr "  struct guestfs_%s_list *r;\n" typ;
11187              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
11188              pr "  sscanf (val, \"%%d\", &r->len);\n";
11189              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
11190              pr "  return r;\n"
11191          | RHashtable _ ->
11192              pr "  char **strs;\n";
11193              pr "  int n, i;\n";
11194              pr "  sscanf (val, \"%%d\", &n);\n";
11195              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
11196              pr "  for (i = 0; i < n; ++i) {\n";
11197              pr "    strs[i*2] = safe_malloc (g, 16);\n";
11198              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
11199              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
11200              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
11201              pr "  }\n";
11202              pr "  strs[n*2] = NULL;\n";
11203              pr "  return strs;\n"
11204          | RBufferOut _ ->
11205              pr "  return strdup (val);\n"
11206         );
11207         pr "}\n";
11208         pr "\n"
11209       ) else (
11210         pr "/* Test error return. */\n";
11211         generate_prototype ~extern:false ~semicolon:false ~newline:true
11212           ~handle:"g" ~prefix:"guestfs__" name style;
11213         pr "{\n";
11214         pr "  error (g, \"error\");\n";
11215         (match fst style with
11216          | RErr | RInt _ | RInt64 _ | RBool _ ->
11217              pr "  return -1;\n"
11218          | RConstString _ | RConstOptString _
11219          | RString _ | RStringList _ | RStruct _
11220          | RStructList _
11221          | RHashtable _
11222          | RBufferOut _ ->
11223              pr "  return NULL;\n"
11224         );
11225         pr "}\n";
11226         pr "\n"
11227       )
11228   ) tests
11229
11230 and generate_ocaml_bindtests () =
11231   generate_header OCamlStyle GPLv2plus;
11232
11233   pr "\
11234 let () =
11235   let g = Guestfs.create () in
11236 ";
11237
11238   let mkargs args =
11239     String.concat " " (
11240       List.map (
11241         function
11242         | CallString s -> "\"" ^ s ^ "\""
11243         | CallOptString None -> "None"
11244         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
11245         | CallStringList xs ->
11246             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
11247         | CallInt i when i >= 0 -> string_of_int i
11248         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
11249         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
11250         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
11251         | CallBool b -> string_of_bool b
11252         | CallBuffer s -> sprintf "%S" s
11253       ) args
11254     )
11255   in
11256
11257   generate_lang_bindtests (
11258     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
11259   );
11260
11261   pr "print_endline \"EOF\"\n"
11262
11263 and generate_perl_bindtests () =
11264   pr "#!/usr/bin/perl -w\n";
11265   generate_header HashStyle GPLv2plus;
11266
11267   pr "\
11268 use strict;
11269
11270 use Sys::Guestfs;
11271
11272 my $g = Sys::Guestfs->new ();
11273 ";
11274
11275   let mkargs args =
11276     String.concat ", " (
11277       List.map (
11278         function
11279         | CallString s -> "\"" ^ s ^ "\""
11280         | CallOptString None -> "undef"
11281         | CallOptString (Some s) -> sprintf "\"%s\"" s
11282         | CallStringList xs ->
11283             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11284         | CallInt i -> string_of_int i
11285         | CallInt64 i -> Int64.to_string i
11286         | CallBool b -> if b then "1" else "0"
11287         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11288       ) args
11289     )
11290   in
11291
11292   generate_lang_bindtests (
11293     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
11294   );
11295
11296   pr "print \"EOF\\n\"\n"
11297
11298 and generate_python_bindtests () =
11299   generate_header HashStyle GPLv2plus;
11300
11301   pr "\
11302 import guestfs
11303
11304 g = guestfs.GuestFS ()
11305 ";
11306
11307   let mkargs args =
11308     String.concat ", " (
11309       List.map (
11310         function
11311         | CallString s -> "\"" ^ s ^ "\""
11312         | CallOptString None -> "None"
11313         | CallOptString (Some s) -> sprintf "\"%s\"" s
11314         | CallStringList xs ->
11315             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11316         | CallInt i -> string_of_int i
11317         | CallInt64 i -> Int64.to_string i
11318         | CallBool b -> if b then "1" else "0"
11319         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11320       ) args
11321     )
11322   in
11323
11324   generate_lang_bindtests (
11325     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
11326   );
11327
11328   pr "print \"EOF\"\n"
11329
11330 and generate_ruby_bindtests () =
11331   generate_header HashStyle GPLv2plus;
11332
11333   pr "\
11334 require 'guestfs'
11335
11336 g = Guestfs::create()
11337 ";
11338
11339   let mkargs args =
11340     String.concat ", " (
11341       List.map (
11342         function
11343         | CallString s -> "\"" ^ s ^ "\""
11344         | CallOptString None -> "nil"
11345         | CallOptString (Some s) -> sprintf "\"%s\"" s
11346         | CallStringList xs ->
11347             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11348         | CallInt i -> string_of_int i
11349         | CallInt64 i -> Int64.to_string i
11350         | CallBool b -> string_of_bool b
11351         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11352       ) args
11353     )
11354   in
11355
11356   generate_lang_bindtests (
11357     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
11358   );
11359
11360   pr "print \"EOF\\n\"\n"
11361
11362 and generate_java_bindtests () =
11363   generate_header CStyle GPLv2plus;
11364
11365   pr "\
11366 import com.redhat.et.libguestfs.*;
11367
11368 public class Bindtests {
11369     public static void main (String[] argv)
11370     {
11371         try {
11372             GuestFS g = new GuestFS ();
11373 ";
11374
11375   let mkargs args =
11376     String.concat ", " (
11377       List.map (
11378         function
11379         | CallString s -> "\"" ^ s ^ "\""
11380         | CallOptString None -> "null"
11381         | CallOptString (Some s) -> sprintf "\"%s\"" s
11382         | CallStringList xs ->
11383             "new String[]{" ^
11384               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
11385         | CallInt i -> string_of_int i
11386         | CallInt64 i -> Int64.to_string i
11387         | CallBool b -> string_of_bool b
11388         | CallBuffer s ->
11389             "new byte[] { " ^ String.concat "," (
11390               map_chars (fun c -> string_of_int (Char.code c)) s
11391             ) ^ " }"
11392       ) args
11393     )
11394   in
11395
11396   generate_lang_bindtests (
11397     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
11398   );
11399
11400   pr "
11401             System.out.println (\"EOF\");
11402         }
11403         catch (Exception exn) {
11404             System.err.println (exn);
11405             System.exit (1);
11406         }
11407     }
11408 }
11409 "
11410
11411 and generate_haskell_bindtests () =
11412   generate_header HaskellStyle GPLv2plus;
11413
11414   pr "\
11415 module Bindtests where
11416 import qualified Guestfs
11417
11418 main = do
11419   g <- Guestfs.create
11420 ";
11421
11422   let mkargs args =
11423     String.concat " " (
11424       List.map (
11425         function
11426         | CallString s -> "\"" ^ s ^ "\""
11427         | CallOptString None -> "Nothing"
11428         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
11429         | CallStringList xs ->
11430             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
11431         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
11432         | CallInt i -> string_of_int i
11433         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
11434         | CallInt64 i -> Int64.to_string i
11435         | CallBool true -> "True"
11436         | CallBool false -> "False"
11437         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
11438       ) args
11439     )
11440   in
11441
11442   generate_lang_bindtests (
11443     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
11444   );
11445
11446   pr "  putStrLn \"EOF\"\n"
11447
11448 (* Language-independent bindings tests - we do it this way to
11449  * ensure there is parity in testing bindings across all languages.
11450  *)
11451 and generate_lang_bindtests call =
11452   call "test0" [CallString "abc"; CallOptString (Some "def");
11453                 CallStringList []; CallBool false;
11454                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11455                 CallBuffer "abc\000abc"];
11456   call "test0" [CallString "abc"; CallOptString None;
11457                 CallStringList []; CallBool false;
11458                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11459                 CallBuffer "abc\000abc"];
11460   call "test0" [CallString ""; CallOptString (Some "def");
11461                 CallStringList []; CallBool false;
11462                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11463                 CallBuffer "abc\000abc"];
11464   call "test0" [CallString ""; CallOptString (Some "");
11465                 CallStringList []; CallBool false;
11466                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11467                 CallBuffer "abc\000abc"];
11468   call "test0" [CallString "abc"; CallOptString (Some "def");
11469                 CallStringList ["1"]; CallBool false;
11470                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11471                 CallBuffer "abc\000abc"];
11472   call "test0" [CallString "abc"; CallOptString (Some "def");
11473                 CallStringList ["1"; "2"]; CallBool false;
11474                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11475                 CallBuffer "abc\000abc"];
11476   call "test0" [CallString "abc"; CallOptString (Some "def");
11477                 CallStringList ["1"]; CallBool true;
11478                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
11479                 CallBuffer "abc\000abc"];
11480   call "test0" [CallString "abc"; CallOptString (Some "def");
11481                 CallStringList ["1"]; CallBool false;
11482                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
11483                 CallBuffer "abc\000abc"];
11484   call "test0" [CallString "abc"; CallOptString (Some "def");
11485                 CallStringList ["1"]; CallBool false;
11486                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
11487                 CallBuffer "abc\000abc"];
11488   call "test0" [CallString "abc"; CallOptString (Some "def");
11489                 CallStringList ["1"]; CallBool false;
11490                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
11491                 CallBuffer "abc\000abc"];
11492   call "test0" [CallString "abc"; CallOptString (Some "def");
11493                 CallStringList ["1"]; CallBool false;
11494                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
11495                 CallBuffer "abc\000abc"];
11496   call "test0" [CallString "abc"; CallOptString (Some "def");
11497                 CallStringList ["1"]; CallBool false;
11498                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
11499                 CallBuffer "abc\000abc"];
11500   call "test0" [CallString "abc"; CallOptString (Some "def");
11501                 CallStringList ["1"]; CallBool false;
11502                 CallInt 0; CallInt64 0L; CallString ""; CallString "";
11503                 CallBuffer "abc\000abc"]
11504
11505 (* XXX Add here tests of the return and error functions. *)
11506
11507 (* Code to generator bindings for virt-inspector.  Currently only
11508  * implemented for OCaml code (for virt-p2v 2.0).
11509  *)
11510 let rng_input = "inspector/virt-inspector.rng"
11511
11512 (* Read the input file and parse it into internal structures.  This is
11513  * by no means a complete RELAX NG parser, but is just enough to be
11514  * able to parse the specific input file.
11515  *)
11516 type rng =
11517   | Element of string * rng list        (* <element name=name/> *)
11518   | Attribute of string * rng list        (* <attribute name=name/> *)
11519   | Interleave of rng list                (* <interleave/> *)
11520   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11521   | OneOrMore of rng                        (* <oneOrMore/> *)
11522   | Optional of rng                        (* <optional/> *)
11523   | Choice of string list                (* <choice><value/>*</choice> *)
11524   | Value of string                        (* <value>str</value> *)
11525   | Text                                (* <text/> *)
11526
11527 let rec string_of_rng = function
11528   | Element (name, xs) ->
11529       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11530   | Attribute (name, xs) ->
11531       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11532   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11533   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11534   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11535   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11536   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11537   | Value value -> "Value \"" ^ value ^ "\""
11538   | Text -> "Text"
11539
11540 and string_of_rng_list xs =
11541   String.concat ", " (List.map string_of_rng xs)
11542
11543 let rec parse_rng ?defines context = function
11544   | [] -> []
11545   | Xml.Element ("element", ["name", name], children) :: rest ->
11546       Element (name, parse_rng ?defines context children)
11547       :: parse_rng ?defines context rest
11548   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11549       Attribute (name, parse_rng ?defines context children)
11550       :: parse_rng ?defines context rest
11551   | Xml.Element ("interleave", [], children) :: rest ->
11552       Interleave (parse_rng ?defines context children)
11553       :: parse_rng ?defines context rest
11554   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11555       let rng = parse_rng ?defines context [child] in
11556       (match rng with
11557        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11558        | _ ->
11559            failwithf "%s: <zeroOrMore> contains more than one child element"
11560              context
11561       )
11562   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11563       let rng = parse_rng ?defines context [child] in
11564       (match rng with
11565        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11566        | _ ->
11567            failwithf "%s: <oneOrMore> contains more than one child element"
11568              context
11569       )
11570   | Xml.Element ("optional", [], [child]) :: rest ->
11571       let rng = parse_rng ?defines context [child] in
11572       (match rng with
11573        | [child] -> Optional child :: parse_rng ?defines context rest
11574        | _ ->
11575            failwithf "%s: <optional> contains more than one child element"
11576              context
11577       )
11578   | Xml.Element ("choice", [], children) :: rest ->
11579       let values = List.map (
11580         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11581         | _ ->
11582             failwithf "%s: can't handle anything except <value> in <choice>"
11583               context
11584       ) children in
11585       Choice values
11586       :: parse_rng ?defines context rest
11587   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11588       Value value :: parse_rng ?defines context rest
11589   | Xml.Element ("text", [], []) :: rest ->
11590       Text :: parse_rng ?defines context rest
11591   | Xml.Element ("ref", ["name", name], []) :: rest ->
11592       (* Look up the reference.  Because of limitations in this parser,
11593        * we can't handle arbitrarily nested <ref> yet.  You can only
11594        * use <ref> from inside <start>.
11595        *)
11596       (match defines with
11597        | None ->
11598            failwithf "%s: contains <ref>, but no refs are defined yet" context
11599        | Some map ->
11600            let rng = StringMap.find name map in
11601            rng @ parse_rng ?defines context rest
11602       )
11603   | x :: _ ->
11604       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11605
11606 let grammar =
11607   let xml = Xml.parse_file rng_input in
11608   match xml with
11609   | Xml.Element ("grammar", _,
11610                  Xml.Element ("start", _, gram) :: defines) ->
11611       (* The <define/> elements are referenced in the <start> section,
11612        * so build a map of those first.
11613        *)
11614       let defines = List.fold_left (
11615         fun map ->
11616           function Xml.Element ("define", ["name", name], defn) ->
11617             StringMap.add name defn map
11618           | _ ->
11619               failwithf "%s: expected <define name=name/>" rng_input
11620       ) StringMap.empty defines in
11621       let defines = StringMap.mapi parse_rng defines in
11622
11623       (* Parse the <start> clause, passing the defines. *)
11624       parse_rng ~defines "<start>" gram
11625   | _ ->
11626       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11627         rng_input
11628
11629 let name_of_field = function
11630   | Element (name, _) | Attribute (name, _)
11631   | ZeroOrMore (Element (name, _))
11632   | OneOrMore (Element (name, _))
11633   | Optional (Element (name, _)) -> name
11634   | Optional (Attribute (name, _)) -> name
11635   | Text -> (* an unnamed field in an element *)
11636       "data"
11637   | rng ->
11638       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11639
11640 (* At the moment this function only generates OCaml types.  However we
11641  * should parameterize it later so it can generate types/structs in a
11642  * variety of languages.
11643  *)
11644 let generate_types xs =
11645   (* A simple type is one that can be printed out directly, eg.
11646    * "string option".  A complex type is one which has a name and has
11647    * to be defined via another toplevel definition, eg. a struct.
11648    *
11649    * generate_type generates code for either simple or complex types.
11650    * In the simple case, it returns the string ("string option").  In
11651    * the complex case, it returns the name ("mountpoint").  In the
11652    * complex case it has to print out the definition before returning,
11653    * so it should only be called when we are at the beginning of a
11654    * new line (BOL context).
11655    *)
11656   let rec generate_type = function
11657     | Text ->                                (* string *)
11658         "string", true
11659     | Choice values ->                        (* [`val1|`val2|...] *)
11660         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11661     | ZeroOrMore rng ->                        (* <rng> list *)
11662         let t, is_simple = generate_type rng in
11663         t ^ " list (* 0 or more *)", is_simple
11664     | OneOrMore rng ->                        (* <rng> list *)
11665         let t, is_simple = generate_type rng in
11666         t ^ " list (* 1 or more *)", is_simple
11667                                         (* virt-inspector hack: bool *)
11668     | Optional (Attribute (name, [Value "1"])) ->
11669         "bool", true
11670     | Optional rng ->                        (* <rng> list *)
11671         let t, is_simple = generate_type rng in
11672         t ^ " option", is_simple
11673                                         (* type name = { fields ... } *)
11674     | Element (name, fields) when is_attrs_interleave fields ->
11675         generate_type_struct name (get_attrs_interleave fields)
11676     | Element (name, [field])                (* type name = field *)
11677     | Attribute (name, [field]) ->
11678         let t, is_simple = generate_type field in
11679         if is_simple then (t, true)
11680         else (
11681           pr "type %s = %s\n" name t;
11682           name, false
11683         )
11684     | Element (name, fields) ->              (* type name = { fields ... } *)
11685         generate_type_struct name fields
11686     | rng ->
11687         failwithf "generate_type failed at: %s" (string_of_rng rng)
11688
11689   and is_attrs_interleave = function
11690     | [Interleave _] -> true
11691     | Attribute _ :: fields -> is_attrs_interleave fields
11692     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11693     | _ -> false
11694
11695   and get_attrs_interleave = function
11696     | [Interleave fields] -> fields
11697     | ((Attribute _) as field) :: fields
11698     | ((Optional (Attribute _)) as field) :: fields ->
11699         field :: get_attrs_interleave fields
11700     | _ -> assert false
11701
11702   and generate_types xs =
11703     List.iter (fun x -> ignore (generate_type x)) xs
11704
11705   and generate_type_struct name fields =
11706     (* Calculate the types of the fields first.  We have to do this
11707      * before printing anything so we are still in BOL context.
11708      *)
11709     let types = List.map fst (List.map generate_type fields) in
11710
11711     (* Special case of a struct containing just a string and another
11712      * field.  Turn it into an assoc list.
11713      *)
11714     match types with
11715     | ["string"; other] ->
11716         let fname1, fname2 =
11717           match fields with
11718           | [f1; f2] -> name_of_field f1, name_of_field f2
11719           | _ -> assert false in
11720         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11721         name, false
11722
11723     | types ->
11724         pr "type %s = {\n" name;
11725         List.iter (
11726           fun (field, ftype) ->
11727             let fname = name_of_field field in
11728             pr "  %s_%s : %s;\n" name fname ftype
11729         ) (List.combine fields types);
11730         pr "}\n";
11731         (* Return the name of this type, and
11732          * false because it's not a simple type.
11733          *)
11734         name, false
11735   in
11736
11737   generate_types xs
11738
11739 let generate_parsers xs =
11740   (* As for generate_type above, generate_parser makes a parser for
11741    * some type, and returns the name of the parser it has generated.
11742    * Because it (may) need to print something, it should always be
11743    * called in BOL context.
11744    *)
11745   let rec generate_parser = function
11746     | Text ->                                (* string *)
11747         "string_child_or_empty"
11748     | Choice values ->                        (* [`val1|`val2|...] *)
11749         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11750           (String.concat "|"
11751              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11752     | ZeroOrMore rng ->                        (* <rng> list *)
11753         let pa = generate_parser rng in
11754         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11755     | OneOrMore rng ->                        (* <rng> list *)
11756         let pa = generate_parser rng in
11757         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11758                                         (* virt-inspector hack: bool *)
11759     | Optional (Attribute (name, [Value "1"])) ->
11760         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11761     | Optional rng ->                        (* <rng> list *)
11762         let pa = generate_parser rng in
11763         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11764                                         (* type name = { fields ... } *)
11765     | Element (name, fields) when is_attrs_interleave fields ->
11766         generate_parser_struct name (get_attrs_interleave fields)
11767     | Element (name, [field]) ->        (* type name = field *)
11768         let pa = generate_parser field in
11769         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11770         pr "let %s =\n" parser_name;
11771         pr "  %s\n" pa;
11772         pr "let parse_%s = %s\n" name parser_name;
11773         parser_name
11774     | Attribute (name, [field]) ->
11775         let pa = generate_parser field in
11776         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11777         pr "let %s =\n" parser_name;
11778         pr "  %s\n" pa;
11779         pr "let parse_%s = %s\n" name parser_name;
11780         parser_name
11781     | Element (name, fields) ->              (* type name = { fields ... } *)
11782         generate_parser_struct name ([], fields)
11783     | rng ->
11784         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11785
11786   and is_attrs_interleave = function
11787     | [Interleave _] -> true
11788     | Attribute _ :: fields -> is_attrs_interleave fields
11789     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11790     | _ -> false
11791
11792   and get_attrs_interleave = function
11793     | [Interleave fields] -> [], fields
11794     | ((Attribute _) as field) :: fields
11795     | ((Optional (Attribute _)) as field) :: fields ->
11796         let attrs, interleaves = get_attrs_interleave fields in
11797         (field :: attrs), interleaves
11798     | _ -> assert false
11799
11800   and generate_parsers xs =
11801     List.iter (fun x -> ignore (generate_parser x)) xs
11802
11803   and generate_parser_struct name (attrs, interleaves) =
11804     (* Generate parsers for the fields first.  We have to do this
11805      * before printing anything so we are still in BOL context.
11806      *)
11807     let fields = attrs @ interleaves in
11808     let pas = List.map generate_parser fields in
11809
11810     (* Generate an intermediate tuple from all the fields first.
11811      * If the type is just a string + another field, then we will
11812      * return this directly, otherwise it is turned into a record.
11813      *
11814      * RELAX NG note: This code treats <interleave> and plain lists of
11815      * fields the same.  In other words, it doesn't bother enforcing
11816      * any ordering of fields in the XML.
11817      *)
11818     pr "let parse_%s x =\n" name;
11819     pr "  let t = (\n    ";
11820     let comma = ref false in
11821     List.iter (
11822       fun x ->
11823         if !comma then pr ",\n    ";
11824         comma := true;
11825         match x with
11826         | Optional (Attribute (fname, [field])), pa ->
11827             pr "%s x" pa
11828         | Optional (Element (fname, [field])), pa ->
11829             pr "%s (optional_child %S x)" pa fname
11830         | Attribute (fname, [Text]), _ ->
11831             pr "attribute %S x" fname
11832         | (ZeroOrMore _ | OneOrMore _), pa ->
11833             pr "%s x" pa
11834         | Text, pa ->
11835             pr "%s x" pa
11836         | (field, pa) ->
11837             let fname = name_of_field field in
11838             pr "%s (child %S x)" pa fname
11839     ) (List.combine fields pas);
11840     pr "\n  ) in\n";
11841
11842     (match fields with
11843      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11844          pr "  t\n"
11845
11846      | _ ->
11847          pr "  (Obj.magic t : %s)\n" name
11848 (*
11849          List.iter (
11850            function
11851            | (Optional (Attribute (fname, [field])), pa) ->
11852                pr "  %s_%s =\n" name fname;
11853                pr "    %s x;\n" pa
11854            | (Optional (Element (fname, [field])), pa) ->
11855                pr "  %s_%s =\n" name fname;
11856                pr "    (let x = optional_child %S x in\n" fname;
11857                pr "     %s x);\n" pa
11858            | (field, pa) ->
11859                let fname = name_of_field field in
11860                pr "  %s_%s =\n" name fname;
11861                pr "    (let x = child %S x in\n" fname;
11862                pr "     %s x);\n" pa
11863          ) (List.combine fields pas);
11864          pr "}\n"
11865 *)
11866     );
11867     sprintf "parse_%s" name
11868   in
11869
11870   generate_parsers xs
11871
11872 (* Generate ocaml/guestfs_inspector.mli. *)
11873 let generate_ocaml_inspector_mli () =
11874   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11875
11876   pr "\
11877 (** This is an OCaml language binding to the external [virt-inspector]
11878     program.
11879
11880     For more information, please read the man page [virt-inspector(1)].
11881 *)
11882
11883 ";
11884
11885   generate_types grammar;
11886   pr "(** The nested information returned from the {!inspect} function. *)\n";
11887   pr "\n";
11888
11889   pr "\
11890 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11891 (** To inspect a libvirt domain called [name], pass a singleton
11892     list: [inspect [name]].  When using libvirt only, you may
11893     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11894
11895     To inspect a disk image or images, pass a list of the filenames
11896     of the disk images: [inspect filenames]
11897
11898     This function inspects the given guest or disk images and
11899     returns a list of operating system(s) found and a large amount
11900     of information about them.  In the vast majority of cases,
11901     a virtual machine only contains a single operating system.
11902
11903     If the optional [~xml] parameter is given, then this function
11904     skips running the external virt-inspector program and just
11905     parses the given XML directly (which is expected to be XML
11906     produced from a previous run of virt-inspector).  The list of
11907     names and connect URI are ignored in this case.
11908
11909     This function can throw a wide variety of exceptions, for example
11910     if the external virt-inspector program cannot be found, or if
11911     it doesn't generate valid XML.
11912 *)
11913 "
11914
11915 (* Generate ocaml/guestfs_inspector.ml. *)
11916 let generate_ocaml_inspector_ml () =
11917   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11918
11919   pr "open Unix\n";
11920   pr "\n";
11921
11922   generate_types grammar;
11923   pr "\n";
11924
11925   pr "\
11926 (* Misc functions which are used by the parser code below. *)
11927 let first_child = function
11928   | Xml.Element (_, _, c::_) -> c
11929   | Xml.Element (name, _, []) ->
11930       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11931   | Xml.PCData str ->
11932       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11933
11934 let string_child_or_empty = function
11935   | Xml.Element (_, _, [Xml.PCData s]) -> s
11936   | Xml.Element (_, _, []) -> \"\"
11937   | Xml.Element (x, _, _) ->
11938       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11939                 x ^ \" instead\")
11940   | Xml.PCData str ->
11941       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11942
11943 let optional_child name xml =
11944   let children = Xml.children xml in
11945   try
11946     Some (List.find (function
11947                      | Xml.Element (n, _, _) when n = name -> true
11948                      | _ -> false) children)
11949   with
11950     Not_found -> None
11951
11952 let child name xml =
11953   match optional_child name xml with
11954   | Some c -> c
11955   | None ->
11956       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11957
11958 let attribute name xml =
11959   try Xml.attrib xml name
11960   with Xml.No_attribute _ ->
11961     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11962
11963 ";
11964
11965   generate_parsers grammar;
11966   pr "\n";
11967
11968   pr "\
11969 (* Run external virt-inspector, then use parser to parse the XML. *)
11970 let inspect ?connect ?xml names =
11971   let xml =
11972     match xml with
11973     | None ->
11974         if names = [] then invalid_arg \"inspect: no names given\";
11975         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11976           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11977           names in
11978         let cmd = List.map Filename.quote cmd in
11979         let cmd = String.concat \" \" cmd in
11980         let chan = open_process_in cmd in
11981         let xml = Xml.parse_in chan in
11982         (match close_process_in chan with
11983          | WEXITED 0 -> ()
11984          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11985          | WSIGNALED i | WSTOPPED i ->
11986              failwith (\"external virt-inspector command died or stopped on sig \" ^
11987                        string_of_int i)
11988         );
11989         xml
11990     | Some doc ->
11991         Xml.parse_string doc in
11992   parse_operatingsystems xml
11993 "
11994
11995 and generate_max_proc_nr () =
11996   pr "%d\n" max_proc_nr
11997
11998 let output_to filename k =
11999   let filename_new = filename ^ ".new" in
12000   chan := open_out filename_new;
12001   k ();
12002   close_out !chan;
12003   chan := Pervasives.stdout;
12004
12005   (* Is the new file different from the current file? *)
12006   if Sys.file_exists filename && files_equal filename filename_new then
12007     unlink filename_new                 (* same, so skip it *)
12008   else (
12009     (* different, overwrite old one *)
12010     (try chmod filename 0o644 with Unix_error _ -> ());
12011     rename filename_new filename;
12012     chmod filename 0o444;
12013     printf "written %s\n%!" filename;
12014   )
12015
12016 let perror msg = function
12017   | Unix_error (err, _, _) ->
12018       eprintf "%s: %s\n" msg (error_message err)
12019   | exn ->
12020       eprintf "%s: %s\n" msg (Printexc.to_string exn)
12021
12022 (* Main program. *)
12023 let () =
12024   let lock_fd =
12025     try openfile "HACKING" [O_RDWR] 0
12026     with
12027     | Unix_error (ENOENT, _, _) ->
12028         eprintf "\
12029 You are probably running this from the wrong directory.
12030 Run it from the top source directory using the command
12031   src/generator.ml
12032 ";
12033         exit 1
12034     | exn ->
12035         perror "open: HACKING" exn;
12036         exit 1 in
12037
12038   (* Acquire a lock so parallel builds won't try to run the generator
12039    * twice at the same time.  Subsequent builds will wait for the first
12040    * one to finish.  Note the lock is released implicitly when the
12041    * program exits.
12042    *)
12043   (try lockf lock_fd F_LOCK 1
12044    with exn ->
12045      perror "lock: HACKING" exn;
12046      exit 1);
12047
12048   check_functions ();
12049
12050   output_to "src/guestfs_protocol.x" generate_xdr;
12051   output_to "src/guestfs-structs.h" generate_structs_h;
12052   output_to "src/guestfs-actions.h" generate_actions_h;
12053   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
12054   output_to "src/guestfs-actions.c" generate_client_actions;
12055   output_to "src/guestfs-bindtests.c" generate_bindtests;
12056   output_to "src/guestfs-structs.pod" generate_structs_pod;
12057   output_to "src/guestfs-actions.pod" generate_actions_pod;
12058   output_to "src/guestfs-availability.pod" generate_availability_pod;
12059   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
12060   output_to "src/libguestfs.syms" generate_linker_script;
12061   output_to "daemon/actions.h" generate_daemon_actions_h;
12062   output_to "daemon/stubs.c" generate_daemon_actions;
12063   output_to "daemon/names.c" generate_daemon_names;
12064   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
12065   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
12066   output_to "capitests/tests.c" generate_tests;
12067   output_to "fish/cmds.c" generate_fish_cmds;
12068   output_to "fish/completion.c" generate_fish_completion;
12069   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
12070   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
12071   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
12072   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
12073   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
12074   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
12075   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
12076   output_to "perl/Guestfs.xs" generate_perl_xs;
12077   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
12078   output_to "perl/bindtests.pl" generate_perl_bindtests;
12079   output_to "python/guestfs-py.c" generate_python_c;
12080   output_to "python/guestfs.py" generate_python_py;
12081   output_to "python/bindtests.py" generate_python_bindtests;
12082   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
12083   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
12084   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
12085
12086   List.iter (
12087     fun (typ, jtyp) ->
12088       let cols = cols_of_struct typ in
12089       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
12090       output_to filename (generate_java_struct jtyp cols);
12091   ) java_structs;
12092
12093   output_to "java/Makefile.inc" generate_java_makefile_inc;
12094   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
12095   output_to "java/Bindtests.java" generate_java_bindtests;
12096   output_to "haskell/Guestfs.hs" generate_haskell_hs;
12097   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
12098   output_to "csharp/Libguestfs.cs" generate_csharp;
12099
12100   (* Always generate this file last, and unconditionally.  It's used
12101    * by the Makefile to know when we must re-run the generator.
12102    *)
12103   let chan = open_out "src/stamp-generator" in
12104   fprintf chan "1\n";
12105   close_out chan;
12106
12107   printf "generated %d lines of code\n" !lines