tests: Factor out common code into 'is_available' function.
[libguestfs.git] / src / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009-2010 Red Hat Inc.
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18  *)
19
20 (* This script generates a large amount of code and documentation for
21  * all the daemon actions.
22  *
23  * To add a new action there are only two files you need to change,
24  * this one to describe the interface (see the big table of
25  * 'daemon_functions' below), and daemon/<somefile>.c to write the
26  * implementation.
27  *
28  * After editing this file, run it (./src/generator.ml) to regenerate
29  * all the output files.  'make' will rerun this automatically when
30  * necessary.  Note that if you are using a separate build directory
31  * you must run generator.ml from the _source_ directory.
32  *
33  * IMPORTANT: This script should NOT print any warnings.  If it prints
34  * warnings, you should treat them as errors.
35  *
36  * OCaml tips:
37  * (1) In emacs, install tuareg-mode to display and format OCaml code
38  * correctly.  'vim' comes with a good OCaml editing mode by default.
39  * (2) Read the resources at http://ocaml-tutorial.org/
40  *)
41
42 #load "unix.cma";;
43 #load "str.cma";;
44 #directory "+xml-light";;
45 #directory "+../pkg-lib/xml-light";; (* for GODI users *)
46 #load "xml-light.cma";;
47
48 open Unix
49 open Printf
50
51 type style = ret * args
52 and ret =
53     (* "RErr" as a return value means an int used as a simple error
54      * indication, ie. 0 or -1.
55      *)
56   | RErr
57
58     (* "RInt" as a return value means an int which is -1 for error
59      * or any value >= 0 on success.  Only use this for smallish
60      * positive ints (0 <= i < 2^30).
61      *)
62   | RInt of string
63
64     (* "RInt64" is the same as RInt, but is guaranteed to be able
65      * to return a full 64 bit value, _except_ that -1 means error
66      * (so -1 cannot be a valid, non-error return value).
67      *)
68   | RInt64 of string
69
70     (* "RBool" is a bool return value which can be true/false or
71      * -1 for error.
72      *)
73   | RBool of string
74
75     (* "RConstString" is a string that refers to a constant value.
76      * The return value must NOT be NULL (since NULL indicates
77      * an error).
78      *
79      * Try to avoid using this.  In particular you cannot use this
80      * for values returned from the daemon, because there is no
81      * thread-safe way to return them in the C API.
82      *)
83   | RConstString of string
84
85     (* "RConstOptString" is an even more broken version of
86      * "RConstString".  The returned string may be NULL and there
87      * is no way to return an error indication.  Avoid using this!
88      *)
89   | RConstOptString of string
90
91     (* "RString" is a returned string.  It must NOT be NULL, since
92      * a NULL return indicates an error.  The caller frees this.
93      *)
94   | RString of string
95
96     (* "RStringList" is a list of strings.  No string in the list
97      * can be NULL.  The caller frees the strings and the array.
98      *)
99   | RStringList of string
100
101     (* "RStruct" is a function which returns a single named structure
102      * or an error indication (in C, a struct, and in other languages
103      * with varying representations, but usually very efficient).  See
104      * after the function list below for the structures.
105      *)
106   | RStruct of string * string          (* name of retval, name of struct *)
107
108     (* "RStructList" is a function which returns either a list/array
109      * of structures (could be zero-length), or an error indication.
110      *)
111   | RStructList of string * string      (* name of retval, name of struct *)
112
113     (* Key-value pairs of untyped strings.  Turns into a hashtable or
114      * dictionary in languages which support it.  DON'T use this as a
115      * general "bucket" for results.  Prefer a stronger typed return
116      * value if one is available, or write a custom struct.  Don't use
117      * this if the list could potentially be very long, since it is
118      * inefficient.  Keys should be unique.  NULLs are not permitted.
119      *)
120   | RHashtable of string
121
122     (* "RBufferOut" is handled almost exactly like RString, but
123      * it allows the string to contain arbitrary 8 bit data including
124      * ASCII NUL.  In the C API this causes an implicit extra parameter
125      * to be added of type <size_t *size_r>.  The extra parameter
126      * returns the actual size of the return buffer in bytes.
127      *
128      * Other programming languages support strings with arbitrary 8 bit
129      * data.
130      *
131      * At the RPC layer we have to use the opaque<> type instead of
132      * string<>.  Returned data is still limited to the max message
133      * size (ie. ~ 2 MB).
134      *)
135   | RBufferOut of string
136
137 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
138
139     (* Note in future we should allow a "variable args" parameter as
140      * the final parameter, to allow commands like
141      *   chmod mode file [file(s)...]
142      * This is not implemented yet, but many commands (such as chmod)
143      * are currently defined with the argument order keeping this future
144      * possibility in mind.
145      *)
146 and argt =
147   | String of string    (* const char *name, cannot be NULL *)
148   | Device of string    (* /dev device name, cannot be NULL *)
149   | Pathname of string  (* file name, cannot be NULL *)
150   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
151   | OptString of string (* const char *name, may be NULL *)
152   | StringList of string(* list of strings (each string cannot be NULL) *)
153   | DeviceList of string(* list of Device names (each cannot be NULL) *)
154   | Bool of string      (* boolean *)
155   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
156   | Int64 of string     (* any 64 bit int *)
157     (* These are treated as filenames (simple string parameters) in
158      * the C API and bindings.  But in the RPC protocol, we transfer
159      * the actual file content up to or down from the daemon.
160      * FileIn: local machine -> daemon (in request)
161      * FileOut: daemon -> local machine (in reply)
162      * In guestfish (only), the special name "-" means read from
163      * stdin or write to stdout.
164      *)
165   | FileIn of string
166   | FileOut of string
167 (* Not implemented:
168     (* Opaque buffer which can contain arbitrary 8 bit data.
169      * In the C API, this is expressed as <char *, int> pair.
170      * Most other languages have a string type which can contain
171      * ASCII NUL.  We use whatever type is appropriate for each
172      * language.
173      * Buffers are limited by the total message size.  To transfer
174      * large blocks of data, use FileIn/FileOut parameters instead.
175      * To return an arbitrary buffer, use RBufferOut.
176      *)
177   | BufferIn of string
178 *)
179
180 type flags =
181   | ProtocolLimitWarning  (* display warning about protocol size limits *)
182   | DangerWillRobinson    (* flags particularly dangerous commands *)
183   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
184   | FishAction of string  (* call this function in guestfish *)
185   | NotInFish             (* do not export via guestfish *)
186   | NotInDocs             (* do not add this function to documentation *)
187   | DeprecatedBy of string (* function is deprecated, use .. instead *)
188   | Optional of string    (* function is part of an optional group *)
189
190 (* You can supply zero or as many tests as you want per API call.
191  *
192  * Note that the test environment has 3 block devices, of size 500MB,
193  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
194  * a fourth ISO block device with some known files on it (/dev/sdd).
195  *
196  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
197  * Number of cylinders was 63 for IDE emulated disks with precisely
198  * the same size.  How exactly this is calculated is a mystery.
199  *
200  * The ISO block device (/dev/sdd) comes from images/test.iso.
201  *
202  * To be able to run the tests in a reasonable amount of time,
203  * the virtual machine and block devices are reused between tests.
204  * So don't try testing kill_subprocess :-x
205  *
206  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
207  *
208  * Don't assume anything about the previous contents of the block
209  * devices.  Use 'Init*' to create some initial scenarios.
210  *
211  * You can add a prerequisite clause to any individual test.  This
212  * is a run-time check, which, if it fails, causes the test to be
213  * skipped.  Useful if testing a command which might not work on
214  * all variations of libguestfs builds.  A test that has prerequisite
215  * of 'Always' is run unconditionally.
216  *
217  * In addition, packagers can skip individual tests by setting the
218  * environment variables:     eg:
219  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
220  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
221  *)
222 type tests = (test_init * test_prereq * test) list
223 and test =
224     (* Run the command sequence and just expect nothing to fail. *)
225   | TestRun of seq
226
227     (* Run the command sequence and expect the output of the final
228      * command to be the string.
229      *)
230   | TestOutput of seq * string
231
232     (* Run the command sequence and expect the output of the final
233      * command to be the list of strings.
234      *)
235   | TestOutputList of seq * string list
236
237     (* Run the command sequence and expect the output of the final
238      * command to be the list of block devices (could be either
239      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
240      * character of each string).
241      *)
242   | TestOutputListOfDevices of seq * string list
243
244     (* Run the command sequence and expect the output of the final
245      * command to be the integer.
246      *)
247   | TestOutputInt of seq * int
248
249     (* Run the command sequence and expect the output of the final
250      * command to be <op> <int>, eg. ">=", "1".
251      *)
252   | TestOutputIntOp of seq * string * int
253
254     (* Run the command sequence and expect the output of the final
255      * command to be a true value (!= 0 or != NULL).
256      *)
257   | TestOutputTrue of seq
258
259     (* Run the command sequence and expect the output of the final
260      * command to be a false value (== 0 or == NULL, but not an error).
261      *)
262   | TestOutputFalse of seq
263
264     (* Run the command sequence and expect the output of the final
265      * command to be a list of the given length (but don't care about
266      * content).
267      *)
268   | TestOutputLength of seq * int
269
270     (* Run the command sequence and expect the output of the final
271      * command to be a buffer (RBufferOut), ie. string + size.
272      *)
273   | TestOutputBuffer of seq * string
274
275     (* Run the command sequence and expect the output of the final
276      * command to be a structure.
277      *)
278   | TestOutputStruct of seq * test_field_compare list
279
280     (* Run the command sequence and expect the final command (only)
281      * to fail.
282      *)
283   | TestLastFail of seq
284
285 and test_field_compare =
286   | CompareWithInt of string * int
287   | CompareWithIntOp of string * string * int
288   | CompareWithString of string * string
289   | CompareFieldsIntEq of string * string
290   | CompareFieldsStrEq of string * string
291
292 (* Test prerequisites. *)
293 and test_prereq =
294     (* Test always runs. *)
295   | Always
296
297     (* Test is currently disabled - eg. it fails, or it tests some
298      * unimplemented feature.
299      *)
300   | Disabled
301
302     (* 'string' is some C code (a function body) that should return
303      * true or false.  The test will run if the code returns true.
304      *)
305   | If of string
306
307     (* As for 'If' but the test runs _unless_ the code returns true. *)
308   | Unless of string
309
310 (* Some initial scenarios for testing. *)
311 and test_init =
312     (* Do nothing, block devices could contain random stuff including
313      * LVM PVs, and some filesystems might be mounted.  This is usually
314      * a bad idea.
315      *)
316   | InitNone
317
318     (* Block devices are empty and no filesystems are mounted. *)
319   | InitEmpty
320
321     (* /dev/sda contains a single partition /dev/sda1, with random
322      * content.  /dev/sdb and /dev/sdc may have random content.
323      * No LVM.
324      *)
325   | InitPartition
326
327     (* /dev/sda contains a single partition /dev/sda1, which is formatted
328      * as ext2, empty [except for lost+found] and mounted on /.
329      * /dev/sdb and /dev/sdc may have random content.
330      * No LVM.
331      *)
332   | InitBasicFS
333
334     (* /dev/sda:
335      *   /dev/sda1 (is a PV):
336      *     /dev/VG/LV (size 8MB):
337      *       formatted as ext2, empty [except for lost+found], mounted on /
338      * /dev/sdb and /dev/sdc may have random content.
339      *)
340   | InitBasicFSonLVM
341
342     (* /dev/sdd (the ISO, see images/ directory in source)
343      * is mounted on /
344      *)
345   | InitISOFS
346
347 (* Sequence of commands for testing. *)
348 and seq = cmd list
349 and cmd = string list
350
351 (* Note about long descriptions: When referring to another
352  * action, use the format C<guestfs_other> (ie. the full name of
353  * the C function).  This will be replaced as appropriate in other
354  * language bindings.
355  *
356  * Apart from that, long descriptions are just perldoc paragraphs.
357  *)
358
359 (* Generate a random UUID (used in tests). *)
360 let uuidgen () =
361   let chan = open_process_in "uuidgen" in
362   let uuid = input_line chan in
363   (match close_process_in chan with
364    | WEXITED 0 -> ()
365    | WEXITED _ ->
366        failwith "uuidgen: process exited with non-zero status"
367    | WSIGNALED _ | WSTOPPED _ ->
368        failwith "uuidgen: process signalled or stopped by signal"
369   );
370   uuid
371
372 (* These test functions are used in the language binding tests. *)
373
374 let test_all_args = [
375   String "str";
376   OptString "optstr";
377   StringList "strlist";
378   Bool "b";
379   Int "integer";
380   Int64 "integer64";
381   FileIn "filein";
382   FileOut "fileout";
383 ]
384
385 let test_all_rets = [
386   (* except for RErr, which is tested thoroughly elsewhere *)
387   "test0rint",         RInt "valout";
388   "test0rint64",       RInt64 "valout";
389   "test0rbool",        RBool "valout";
390   "test0rconststring", RConstString "valout";
391   "test0rconstoptstring", RConstOptString "valout";
392   "test0rstring",      RString "valout";
393   "test0rstringlist",  RStringList "valout";
394   "test0rstruct",      RStruct ("valout", "lvm_pv");
395   "test0rstructlist",  RStructList ("valout", "lvm_pv");
396   "test0rhashtable",   RHashtable "valout";
397 ]
398
399 let test_functions = [
400   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
401    [],
402    "internal test function - do not use",
403    "\
404 This is an internal test function which is used to test whether
405 the automatically generated bindings can handle every possible
406 parameter type correctly.
407
408 It echos the contents of each parameter to stdout.
409
410 You probably don't want to call this function.");
411 ] @ List.flatten (
412   List.map (
413     fun (name, ret) ->
414       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
415         [],
416         "internal test function - do not use",
417         "\
418 This is an internal test function which is used to test whether
419 the automatically generated bindings can handle every possible
420 return type correctly.
421
422 It converts string C<val> to the return type.
423
424 You probably don't want to call this function.");
425        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
426         [],
427         "internal test function - do not use",
428         "\
429 This is an internal test function which is used to test whether
430 the automatically generated bindings can handle every possible
431 return type correctly.
432
433 This function always returns an error.
434
435 You probably don't want to call this function.")]
436   ) test_all_rets
437 )
438
439 (* non_daemon_functions are any functions which don't get processed
440  * in the daemon, eg. functions for setting and getting local
441  * configuration values.
442  *)
443
444 let non_daemon_functions = test_functions @ [
445   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
446    [],
447    "launch the qemu subprocess",
448    "\
449 Internally libguestfs is implemented by running a virtual machine
450 using L<qemu(1)>.
451
452 You should call this after configuring the handle
453 (eg. adding drives) but before performing any actions.");
454
455   ("wait_ready", (RErr, []), -1, [NotInFish],
456    [],
457    "wait until the qemu subprocess launches (no op)",
458    "\
459 This function is a no op.
460
461 In versions of the API E<lt> 1.0.71 you had to call this function
462 just after calling C<guestfs_launch> to wait for the launch
463 to complete.  However this is no longer necessary because
464 C<guestfs_launch> now does the waiting.
465
466 If you see any calls to this function in code then you can just
467 remove them, unless you want to retain compatibility with older
468 versions of the API.");
469
470   ("kill_subprocess", (RErr, []), -1, [],
471    [],
472    "kill the qemu subprocess",
473    "\
474 This kills the qemu subprocess.  You should never need to call this.");
475
476   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
477    [],
478    "add an image to examine or modify",
479    "\
480 This function adds a virtual machine disk image C<filename> to the
481 guest.  The first time you call this function, the disk appears as IDE
482 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
483 so on.
484
485 You don't necessarily need to be root when using libguestfs.  However
486 you obviously do need sufficient permissions to access the filename
487 for whatever operations you want to perform (ie. read access if you
488 just want to read the image or write access if you want to modify the
489 image).
490
491 This is equivalent to the qemu parameter
492 C<-drive file=filename,cache=off,if=...>.
493
494 C<cache=off> is omitted in cases where it is not supported by
495 the underlying filesystem.
496
497 C<if=...> is set at compile time by the configuration option
498 C<./configure --with-drive-if=...>.  In the rare case where you
499 might need to change this at run time, use C<guestfs_add_drive_with_if>
500 or C<guestfs_add_drive_ro_with_if>.
501
502 Note that this call checks for the existence of C<filename>.  This
503 stops you from specifying other types of drive which are supported
504 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
505 the general C<guestfs_config> call instead.");
506
507   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
508    [],
509    "add a CD-ROM disk image to examine",
510    "\
511 This function adds a virtual CD-ROM disk image to the guest.
512
513 This is equivalent to the qemu parameter C<-cdrom filename>.
514
515 Notes:
516
517 =over 4
518
519 =item *
520
521 This call checks for the existence of C<filename>.  This
522 stops you from specifying other types of drive which are supported
523 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
524 the general C<guestfs_config> call instead.
525
526 =item *
527
528 If you just want to add an ISO file (often you use this as an
529 efficient way to transfer large files into the guest), then you
530 should probably use C<guestfs_add_drive_ro> instead.
531
532 =back");
533
534   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
535    [],
536    "add a drive in snapshot mode (read-only)",
537    "\
538 This adds a drive in snapshot mode, making it effectively
539 read-only.
540
541 Note that writes to the device are allowed, and will be seen for
542 the duration of the guestfs handle, but they are written
543 to a temporary file which is discarded as soon as the guestfs
544 handle is closed.  We don't currently have any method to enable
545 changes to be committed, although qemu can support this.
546
547 This is equivalent to the qemu parameter
548 C<-drive file=filename,snapshot=on,readonly=on,if=...>.
549
550 C<if=...> is set at compile time by the configuration option
551 C<./configure --with-drive-if=...>.  In the rare case where you
552 might need to change this at run time, use C<guestfs_add_drive_with_if>
553 or C<guestfs_add_drive_ro_with_if>.
554
555 C<readonly=on> is only added where qemu supports this option.
556
557 Note that this call checks for the existence of C<filename>.  This
558 stops you from specifying other types of drive which are supported
559 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
560 the general C<guestfs_config> call instead.");
561
562   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
563    [],
564    "add qemu parameters",
565    "\
566 This can be used to add arbitrary qemu command line parameters
567 of the form C<-param value>.  Actually it's not quite arbitrary - we
568 prevent you from setting some parameters which would interfere with
569 parameters that we use.
570
571 The first character of C<param> string must be a C<-> (dash).
572
573 C<value> can be NULL.");
574
575   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
576    [],
577    "set the qemu binary",
578    "\
579 Set the qemu binary that we will use.
580
581 The default is chosen when the library was compiled by the
582 configure script.
583
584 You can also override this by setting the C<LIBGUESTFS_QEMU>
585 environment variable.
586
587 Setting C<qemu> to C<NULL> restores the default qemu binary.
588
589 Note that you should call this function as early as possible
590 after creating the handle.  This is because some pre-launch
591 operations depend on testing qemu features (by running C<qemu -help>).
592 If the qemu binary changes, we don't retest features, and
593 so you might see inconsistent results.  Using the environment
594 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
595 the qemu binary at the same time as the handle is created.");
596
597   ("get_qemu", (RConstString "qemu", []), -1, [],
598    [InitNone, Always, TestRun (
599       [["get_qemu"]])],
600    "get the qemu binary",
601    "\
602 Return the current qemu binary.
603
604 This is always non-NULL.  If it wasn't set already, then this will
605 return the default qemu binary name.");
606
607   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
608    [],
609    "set the search path",
610    "\
611 Set the path that libguestfs searches for kernel and initrd.img.
612
613 The default is C<$libdir/guestfs> unless overridden by setting
614 C<LIBGUESTFS_PATH> environment variable.
615
616 Setting C<path> to C<NULL> restores the default path.");
617
618   ("get_path", (RConstString "path", []), -1, [],
619    [InitNone, Always, TestRun (
620       [["get_path"]])],
621    "get the search path",
622    "\
623 Return the current search path.
624
625 This is always non-NULL.  If it wasn't set already, then this will
626 return the default path.");
627
628   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
629    [],
630    "add options to kernel command line",
631    "\
632 This function is used to add additional options to the
633 guest kernel command line.
634
635 The default is C<NULL> unless overridden by setting
636 C<LIBGUESTFS_APPEND> environment variable.
637
638 Setting C<append> to C<NULL> means I<no> additional options
639 are passed (libguestfs always adds a few of its own).");
640
641   ("get_append", (RConstOptString "append", []), -1, [],
642    (* This cannot be tested with the current framework.  The
643     * function can return NULL in normal operations, which the
644     * test framework interprets as an error.
645     *)
646    [],
647    "get the additional kernel options",
648    "\
649 Return the additional kernel options which are added to the
650 guest kernel command line.
651
652 If C<NULL> then no options are added.");
653
654   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
655    [],
656    "set autosync mode",
657    "\
658 If C<autosync> is true, this enables autosync.  Libguestfs will make a
659 best effort attempt to run C<guestfs_umount_all> followed by
660 C<guestfs_sync> when the handle is closed
661 (also if the program exits without closing handles).
662
663 This is disabled by default (except in guestfish where it is
664 enabled by default).");
665
666   ("get_autosync", (RBool "autosync", []), -1, [],
667    [InitNone, Always, TestRun (
668       [["get_autosync"]])],
669    "get autosync mode",
670    "\
671 Get the autosync flag.");
672
673   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
674    [],
675    "set verbose mode",
676    "\
677 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
678
679 Verbose messages are disabled unless the environment variable
680 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
681
682   ("get_verbose", (RBool "verbose", []), -1, [],
683    [],
684    "get verbose mode",
685    "\
686 This returns the verbose messages flag.");
687
688   ("is_ready", (RBool "ready", []), -1, [],
689    [InitNone, Always, TestOutputTrue (
690       [["is_ready"]])],
691    "is ready to accept commands",
692    "\
693 This returns true iff this handle is ready to accept commands
694 (in the C<READY> state).
695
696 For more information on states, see L<guestfs(3)>.");
697
698   ("is_config", (RBool "config", []), -1, [],
699    [InitNone, Always, TestOutputFalse (
700       [["is_config"]])],
701    "is in configuration state",
702    "\
703 This returns true iff this handle is being configured
704 (in the C<CONFIG> state).
705
706 For more information on states, see L<guestfs(3)>.");
707
708   ("is_launching", (RBool "launching", []), -1, [],
709    [InitNone, Always, TestOutputFalse (
710       [["is_launching"]])],
711    "is launching subprocess",
712    "\
713 This returns true iff this handle is launching the subprocess
714 (in the C<LAUNCHING> state).
715
716 For more information on states, see L<guestfs(3)>.");
717
718   ("is_busy", (RBool "busy", []), -1, [],
719    [InitNone, Always, TestOutputFalse (
720       [["is_busy"]])],
721    "is busy processing a command",
722    "\
723 This returns true iff this handle is busy processing a command
724 (in the C<BUSY> state).
725
726 For more information on states, see L<guestfs(3)>.");
727
728   ("get_state", (RInt "state", []), -1, [],
729    [],
730    "get the current state",
731    "\
732 This returns the current state as an opaque integer.  This is
733 only useful for printing debug and internal error messages.
734
735 For more information on states, see L<guestfs(3)>.");
736
737   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
738    [InitNone, Always, TestOutputInt (
739       [["set_memsize"; "500"];
740        ["get_memsize"]], 500)],
741    "set memory allocated to the qemu subprocess",
742    "\
743 This sets the memory size in megabytes allocated to the
744 qemu subprocess.  This only has any effect if called before
745 C<guestfs_launch>.
746
747 You can also change this by setting the environment
748 variable C<LIBGUESTFS_MEMSIZE> before the handle is
749 created.
750
751 For more information on the architecture of libguestfs,
752 see L<guestfs(3)>.");
753
754   ("get_memsize", (RInt "memsize", []), -1, [],
755    [InitNone, Always, TestOutputIntOp (
756       [["get_memsize"]], ">=", 256)],
757    "get memory allocated to the qemu subprocess",
758    "\
759 This gets the memory size in megabytes allocated to the
760 qemu subprocess.
761
762 If C<guestfs_set_memsize> was not called
763 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
764 then this returns the compiled-in default value for memsize.
765
766 For more information on the architecture of libguestfs,
767 see L<guestfs(3)>.");
768
769   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
770    [InitNone, Always, TestOutputIntOp (
771       [["get_pid"]], ">=", 1)],
772    "get PID of qemu subprocess",
773    "\
774 Return the process ID of the qemu subprocess.  If there is no
775 qemu subprocess, then this will return an error.
776
777 This is an internal call used for debugging and testing.");
778
779   ("version", (RStruct ("version", "version"), []), -1, [],
780    [InitNone, Always, TestOutputStruct (
781       [["version"]], [CompareWithInt ("major", 1)])],
782    "get the library version number",
783    "\
784 Return the libguestfs version number that the program is linked
785 against.
786
787 Note that because of dynamic linking this is not necessarily
788 the version of libguestfs that you compiled against.  You can
789 compile the program, and then at runtime dynamically link
790 against a completely different C<libguestfs.so> library.
791
792 This call was added in version C<1.0.58>.  In previous
793 versions of libguestfs there was no way to get the version
794 number.  From C code you can use dynamic linker functions
795 to find out if this symbol exists (if it doesn't, then
796 it's an earlier version).
797
798 The call returns a structure with four elements.  The first
799 three (C<major>, C<minor> and C<release>) are numbers and
800 correspond to the usual version triplet.  The fourth element
801 (C<extra>) is a string and is normally empty, but may be
802 used for distro-specific information.
803
804 To construct the original version string:
805 C<$major.$minor.$release$extra>
806
807 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
808
809 I<Note:> Don't use this call to test for availability
810 of features.  In enterprise distributions we backport
811 features from later versions into earlier versions,
812 making this an unreliable way to test for features.
813 Use C<guestfs_available> instead.");
814
815   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
816    [InitNone, Always, TestOutputTrue (
817       [["set_selinux"; "true"];
818        ["get_selinux"]])],
819    "set SELinux enabled or disabled at appliance boot",
820    "\
821 This sets the selinux flag that is passed to the appliance
822 at boot time.  The default is C<selinux=0> (disabled).
823
824 Note that if SELinux is enabled, it is always in
825 Permissive mode (C<enforcing=0>).
826
827 For more information on the architecture of libguestfs,
828 see L<guestfs(3)>.");
829
830   ("get_selinux", (RBool "selinux", []), -1, [],
831    [],
832    "get SELinux enabled flag",
833    "\
834 This returns the current setting of the selinux flag which
835 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
836
837 For more information on the architecture of libguestfs,
838 see L<guestfs(3)>.");
839
840   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
841    [InitNone, Always, TestOutputFalse (
842       [["set_trace"; "false"];
843        ["get_trace"]])],
844    "enable or disable command traces",
845    "\
846 If the command trace flag is set to 1, then commands are
847 printed on stdout before they are executed in a format
848 which is very similar to the one used by guestfish.  In
849 other words, you can run a program with this enabled, and
850 you will get out a script which you can feed to guestfish
851 to perform the same set of actions.
852
853 If you want to trace C API calls into libguestfs (and
854 other libraries) then possibly a better way is to use
855 the external ltrace(1) command.
856
857 Command traces are disabled unless the environment variable
858 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
859
860   ("get_trace", (RBool "trace", []), -1, [],
861    [],
862    "get command trace enabled flag",
863    "\
864 Return the command trace flag.");
865
866   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
867    [InitNone, Always, TestOutputFalse (
868       [["set_direct"; "false"];
869        ["get_direct"]])],
870    "enable or disable direct appliance mode",
871    "\
872 If the direct appliance mode flag is enabled, then stdin and
873 stdout are passed directly through to the appliance once it
874 is launched.
875
876 One consequence of this is that log messages aren't caught
877 by the library and handled by C<guestfs_set_log_message_callback>,
878 but go straight to stdout.
879
880 You probably don't want to use this unless you know what you
881 are doing.
882
883 The default is disabled.");
884
885   ("get_direct", (RBool "direct", []), -1, [],
886    [],
887    "get direct appliance mode flag",
888    "\
889 Return the direct appliance mode flag.");
890
891   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
892    [InitNone, Always, TestOutputTrue (
893       [["set_recovery_proc"; "true"];
894        ["get_recovery_proc"]])],
895    "enable or disable the recovery process",
896    "\
897 If this is called with the parameter C<false> then
898 C<guestfs_launch> does not create a recovery process.  The
899 purpose of the recovery process is to stop runaway qemu
900 processes in the case where the main program aborts abruptly.
901
902 This only has any effect if called before C<guestfs_launch>,
903 and the default is true.
904
905 About the only time when you would want to disable this is
906 if the main process will fork itself into the background
907 (\"daemonize\" itself).  In this case the recovery process
908 thinks that the main program has disappeared and so kills
909 qemu, which is not very helpful.");
910
911   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
912    [],
913    "get recovery process enabled flag",
914    "\
915 Return the recovery process enabled flag.");
916
917   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
918    [],
919    "add a drive specifying the QEMU block emulation to use",
920    "\
921 This is the same as C<guestfs_add_drive> but it allows you
922 to specify the QEMU interface emulation to use at run time.");
923
924   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
925    [],
926    "add a drive read-only specifying the QEMU block emulation to use",
927    "\
928 This is the same as C<guestfs_add_drive_ro> but it allows you
929 to specify the QEMU interface emulation to use at run time.");
930
931 ]
932
933 (* daemon_functions are any functions which cause some action
934  * to take place in the daemon.
935  *)
936
937 let daemon_functions = [
938   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
939    [InitEmpty, Always, TestOutput (
940       [["part_disk"; "/dev/sda"; "mbr"];
941        ["mkfs"; "ext2"; "/dev/sda1"];
942        ["mount"; "/dev/sda1"; "/"];
943        ["write_file"; "/new"; "new file contents"; "0"];
944        ["cat"; "/new"]], "new file contents")],
945    "mount a guest disk at a position in the filesystem",
946    "\
947 Mount a guest disk at a position in the filesystem.  Block devices
948 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
949 the guest.  If those block devices contain partitions, they will have
950 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
951 names can be used.
952
953 The rules are the same as for L<mount(2)>:  A filesystem must
954 first be mounted on C</> before others can be mounted.  Other
955 filesystems can only be mounted on directories which already
956 exist.
957
958 The mounted filesystem is writable, if we have sufficient permissions
959 on the underlying device.
960
961 B<Important note:>
962 When you use this call, the filesystem options C<sync> and C<noatime>
963 are set implicitly.  This was originally done because we thought it
964 would improve reliability, but it turns out that I<-o sync> has a
965 very large negative performance impact and negligible effect on
966 reliability.  Therefore we recommend that you avoid using
967 C<guestfs_mount> in any code that needs performance, and instead
968 use C<guestfs_mount_options> (use an empty string for the first
969 parameter if you don't want any options).");
970
971   ("sync", (RErr, []), 2, [],
972    [ InitEmpty, Always, TestRun [["sync"]]],
973    "sync disks, writes are flushed through to the disk image",
974    "\
975 This syncs the disk, so that any writes are flushed through to the
976 underlying disk image.
977
978 You should always call this if you have modified a disk image, before
979 closing the handle.");
980
981   ("touch", (RErr, [Pathname "path"]), 3, [],
982    [InitBasicFS, Always, TestOutputTrue (
983       [["touch"; "/new"];
984        ["exists"; "/new"]])],
985    "update file timestamps or create a new file",
986    "\
987 Touch acts like the L<touch(1)> command.  It can be used to
988 update the timestamps on a file, or, if the file does not exist,
989 to create a new zero-length file.");
990
991   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
992    [InitISOFS, Always, TestOutput (
993       [["cat"; "/known-2"]], "abcdef\n")],
994    "list the contents of a file",
995    "\
996 Return the contents of the file named C<path>.
997
998 Note that this function cannot correctly handle binary files
999 (specifically, files containing C<\\0> character which is treated
1000 as end of string).  For those you need to use the C<guestfs_read_file>
1001 or C<guestfs_download> functions which have a more complex interface.");
1002
1003   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1004    [], (* XXX Tricky to test because it depends on the exact format
1005         * of the 'ls -l' command, which changes between F10 and F11.
1006         *)
1007    "list the files in a directory (long format)",
1008    "\
1009 List the files in C<directory> (relative to the root directory,
1010 there is no cwd) in the format of 'ls -la'.
1011
1012 This command is mostly useful for interactive sessions.  It
1013 is I<not> intended that you try to parse the output string.");
1014
1015   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1016    [InitBasicFS, Always, TestOutputList (
1017       [["touch"; "/new"];
1018        ["touch"; "/newer"];
1019        ["touch"; "/newest"];
1020        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1021    "list the files in a directory",
1022    "\
1023 List the files in C<directory> (relative to the root directory,
1024 there is no cwd).  The '.' and '..' entries are not returned, but
1025 hidden files are shown.
1026
1027 This command is mostly useful for interactive sessions.  Programs
1028 should probably use C<guestfs_readdir> instead.");
1029
1030   ("list_devices", (RStringList "devices", []), 7, [],
1031    [InitEmpty, Always, TestOutputListOfDevices (
1032       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1033    "list the block devices",
1034    "\
1035 List all the block devices.
1036
1037 The full block device names are returned, eg. C</dev/sda>");
1038
1039   ("list_partitions", (RStringList "partitions", []), 8, [],
1040    [InitBasicFS, Always, TestOutputListOfDevices (
1041       [["list_partitions"]], ["/dev/sda1"]);
1042     InitEmpty, Always, TestOutputListOfDevices (
1043       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1044        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1045    "list the partitions",
1046    "\
1047 List all the partitions detected on all block devices.
1048
1049 The full partition device names are returned, eg. C</dev/sda1>
1050
1051 This does not return logical volumes.  For that you will need to
1052 call C<guestfs_lvs>.");
1053
1054   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1055    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1056       [["pvs"]], ["/dev/sda1"]);
1057     InitEmpty, Always, TestOutputListOfDevices (
1058       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1059        ["pvcreate"; "/dev/sda1"];
1060        ["pvcreate"; "/dev/sda2"];
1061        ["pvcreate"; "/dev/sda3"];
1062        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1063    "list the LVM physical volumes (PVs)",
1064    "\
1065 List all the physical volumes detected.  This is the equivalent
1066 of the L<pvs(8)> command.
1067
1068 This returns a list of just the device names that contain
1069 PVs (eg. C</dev/sda2>).
1070
1071 See also C<guestfs_pvs_full>.");
1072
1073   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1074    [InitBasicFSonLVM, Always, TestOutputList (
1075       [["vgs"]], ["VG"]);
1076     InitEmpty, Always, TestOutputList (
1077       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1078        ["pvcreate"; "/dev/sda1"];
1079        ["pvcreate"; "/dev/sda2"];
1080        ["pvcreate"; "/dev/sda3"];
1081        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1082        ["vgcreate"; "VG2"; "/dev/sda3"];
1083        ["vgs"]], ["VG1"; "VG2"])],
1084    "list the LVM volume groups (VGs)",
1085    "\
1086 List all the volumes groups detected.  This is the equivalent
1087 of the L<vgs(8)> command.
1088
1089 This returns a list of just the volume group names that were
1090 detected (eg. C<VolGroup00>).
1091
1092 See also C<guestfs_vgs_full>.");
1093
1094   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1095    [InitBasicFSonLVM, Always, TestOutputList (
1096       [["lvs"]], ["/dev/VG/LV"]);
1097     InitEmpty, Always, TestOutputList (
1098       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1099        ["pvcreate"; "/dev/sda1"];
1100        ["pvcreate"; "/dev/sda2"];
1101        ["pvcreate"; "/dev/sda3"];
1102        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1103        ["vgcreate"; "VG2"; "/dev/sda3"];
1104        ["lvcreate"; "LV1"; "VG1"; "50"];
1105        ["lvcreate"; "LV2"; "VG1"; "50"];
1106        ["lvcreate"; "LV3"; "VG2"; "50"];
1107        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1108    "list the LVM logical volumes (LVs)",
1109    "\
1110 List all the logical volumes detected.  This is the equivalent
1111 of the L<lvs(8)> command.
1112
1113 This returns a list of the logical volume device names
1114 (eg. C</dev/VolGroup00/LogVol00>).
1115
1116 See also C<guestfs_lvs_full>.");
1117
1118   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1119    [], (* XXX how to test? *)
1120    "list the LVM physical volumes (PVs)",
1121    "\
1122 List all the physical volumes detected.  This is the equivalent
1123 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1124
1125   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1126    [], (* XXX how to test? *)
1127    "list the LVM volume groups (VGs)",
1128    "\
1129 List all the volumes groups detected.  This is the equivalent
1130 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1131
1132   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1133    [], (* XXX how to test? *)
1134    "list the LVM logical volumes (LVs)",
1135    "\
1136 List all the logical volumes detected.  This is the equivalent
1137 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1138
1139   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1140    [InitISOFS, Always, TestOutputList (
1141       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1142     InitISOFS, Always, TestOutputList (
1143       [["read_lines"; "/empty"]], [])],
1144    "read file as lines",
1145    "\
1146 Return the contents of the file named C<path>.
1147
1148 The file contents are returned as a list of lines.  Trailing
1149 C<LF> and C<CRLF> character sequences are I<not> returned.
1150
1151 Note that this function cannot correctly handle binary files
1152 (specifically, files containing C<\\0> character which is treated
1153 as end of line).  For those you need to use the C<guestfs_read_file>
1154 function which has a more complex interface.");
1155
1156   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1157    [], (* XXX Augeas code needs tests. *)
1158    "create a new Augeas handle",
1159    "\
1160 Create a new Augeas handle for editing configuration files.
1161 If there was any previous Augeas handle associated with this
1162 guestfs session, then it is closed.
1163
1164 You must call this before using any other C<guestfs_aug_*>
1165 commands.
1166
1167 C<root> is the filesystem root.  C<root> must not be NULL,
1168 use C</> instead.
1169
1170 The flags are the same as the flags defined in
1171 E<lt>augeas.hE<gt>, the logical I<or> of the following
1172 integers:
1173
1174 =over 4
1175
1176 =item C<AUG_SAVE_BACKUP> = 1
1177
1178 Keep the original file with a C<.augsave> extension.
1179
1180 =item C<AUG_SAVE_NEWFILE> = 2
1181
1182 Save changes into a file with extension C<.augnew>, and
1183 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1184
1185 =item C<AUG_TYPE_CHECK> = 4
1186
1187 Typecheck lenses (can be expensive).
1188
1189 =item C<AUG_NO_STDINC> = 8
1190
1191 Do not use standard load path for modules.
1192
1193 =item C<AUG_SAVE_NOOP> = 16
1194
1195 Make save a no-op, just record what would have been changed.
1196
1197 =item C<AUG_NO_LOAD> = 32
1198
1199 Do not load the tree in C<guestfs_aug_init>.
1200
1201 =back
1202
1203 To close the handle, you can call C<guestfs_aug_close>.
1204
1205 To find out more about Augeas, see L<http://augeas.net/>.");
1206
1207   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1208    [], (* XXX Augeas code needs tests. *)
1209    "close the current Augeas handle",
1210    "\
1211 Close the current Augeas handle and free up any resources
1212 used by it.  After calling this, you have to call
1213 C<guestfs_aug_init> again before you can use any other
1214 Augeas functions.");
1215
1216   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1217    [], (* XXX Augeas code needs tests. *)
1218    "define an Augeas variable",
1219    "\
1220 Defines an Augeas variable C<name> whose value is the result
1221 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1222 undefined.
1223
1224 On success this returns the number of nodes in C<expr>, or
1225 C<0> if C<expr> evaluates to something which is not a nodeset.");
1226
1227   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1228    [], (* XXX Augeas code needs tests. *)
1229    "define an Augeas node",
1230    "\
1231 Defines a variable C<name> whose value is the result of
1232 evaluating C<expr>.
1233
1234 If C<expr> evaluates to an empty nodeset, a node is created,
1235 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1236 C<name> will be the nodeset containing that single node.
1237
1238 On success this returns a pair containing the
1239 number of nodes in the nodeset, and a boolean flag
1240 if a node was created.");
1241
1242   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1243    [], (* XXX Augeas code needs tests. *)
1244    "look up the value of an Augeas path",
1245    "\
1246 Look up the value associated with C<path>.  If C<path>
1247 matches exactly one node, the C<value> is returned.");
1248
1249   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1250    [], (* XXX Augeas code needs tests. *)
1251    "set Augeas path to value",
1252    "\
1253 Set the value associated with C<path> to C<value>.");
1254
1255   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1256    [], (* XXX Augeas code needs tests. *)
1257    "insert a sibling Augeas node",
1258    "\
1259 Create a new sibling C<label> for C<path>, inserting it into
1260 the tree before or after C<path> (depending on the boolean
1261 flag C<before>).
1262
1263 C<path> must match exactly one existing node in the tree, and
1264 C<label> must be a label, ie. not contain C</>, C<*> or end
1265 with a bracketed index C<[N]>.");
1266
1267   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1268    [], (* XXX Augeas code needs tests. *)
1269    "remove an Augeas path",
1270    "\
1271 Remove C<path> and all of its children.
1272
1273 On success this returns the number of entries which were removed.");
1274
1275   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1276    [], (* XXX Augeas code needs tests. *)
1277    "move Augeas node",
1278    "\
1279 Move the node C<src> to C<dest>.  C<src> must match exactly
1280 one node.  C<dest> is overwritten if it exists.");
1281
1282   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1283    [], (* XXX Augeas code needs tests. *)
1284    "return Augeas nodes which match augpath",
1285    "\
1286 Returns a list of paths which match the path expression C<path>.
1287 The returned paths are sufficiently qualified so that they match
1288 exactly one node in the current tree.");
1289
1290   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1291    [], (* XXX Augeas code needs tests. *)
1292    "write all pending Augeas changes to disk",
1293    "\
1294 This writes all pending changes to disk.
1295
1296 The flags which were passed to C<guestfs_aug_init> affect exactly
1297 how files are saved.");
1298
1299   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1300    [], (* XXX Augeas code needs tests. *)
1301    "load files into the tree",
1302    "\
1303 Load files into the tree.
1304
1305 See C<aug_load> in the Augeas documentation for the full gory
1306 details.");
1307
1308   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1309    [], (* XXX Augeas code needs tests. *)
1310    "list Augeas nodes under augpath",
1311    "\
1312 This is just a shortcut for listing C<guestfs_aug_match>
1313 C<path/*> and sorting the resulting nodes into alphabetical order.");
1314
1315   ("rm", (RErr, [Pathname "path"]), 29, [],
1316    [InitBasicFS, Always, TestRun
1317       [["touch"; "/new"];
1318        ["rm"; "/new"]];
1319     InitBasicFS, Always, TestLastFail
1320       [["rm"; "/new"]];
1321     InitBasicFS, Always, TestLastFail
1322       [["mkdir"; "/new"];
1323        ["rm"; "/new"]]],
1324    "remove a file",
1325    "\
1326 Remove the single file C<path>.");
1327
1328   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1329    [InitBasicFS, Always, TestRun
1330       [["mkdir"; "/new"];
1331        ["rmdir"; "/new"]];
1332     InitBasicFS, Always, TestLastFail
1333       [["rmdir"; "/new"]];
1334     InitBasicFS, Always, TestLastFail
1335       [["touch"; "/new"];
1336        ["rmdir"; "/new"]]],
1337    "remove a directory",
1338    "\
1339 Remove the single directory C<path>.");
1340
1341   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1342    [InitBasicFS, Always, TestOutputFalse
1343       [["mkdir"; "/new"];
1344        ["mkdir"; "/new/foo"];
1345        ["touch"; "/new/foo/bar"];
1346        ["rm_rf"; "/new"];
1347        ["exists"; "/new"]]],
1348    "remove a file or directory recursively",
1349    "\
1350 Remove the file or directory C<path>, recursively removing the
1351 contents if its a directory.  This is like the C<rm -rf> shell
1352 command.");
1353
1354   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1355    [InitBasicFS, Always, TestOutputTrue
1356       [["mkdir"; "/new"];
1357        ["is_dir"; "/new"]];
1358     InitBasicFS, Always, TestLastFail
1359       [["mkdir"; "/new/foo/bar"]]],
1360    "create a directory",
1361    "\
1362 Create a directory named C<path>.");
1363
1364   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1365    [InitBasicFS, Always, TestOutputTrue
1366       [["mkdir_p"; "/new/foo/bar"];
1367        ["is_dir"; "/new/foo/bar"]];
1368     InitBasicFS, Always, TestOutputTrue
1369       [["mkdir_p"; "/new/foo/bar"];
1370        ["is_dir"; "/new/foo"]];
1371     InitBasicFS, Always, TestOutputTrue
1372       [["mkdir_p"; "/new/foo/bar"];
1373        ["is_dir"; "/new"]];
1374     (* Regression tests for RHBZ#503133: *)
1375     InitBasicFS, Always, TestRun
1376       [["mkdir"; "/new"];
1377        ["mkdir_p"; "/new"]];
1378     InitBasicFS, Always, TestLastFail
1379       [["touch"; "/new"];
1380        ["mkdir_p"; "/new"]]],
1381    "create a directory and parents",
1382    "\
1383 Create a directory named C<path>, creating any parent directories
1384 as necessary.  This is like the C<mkdir -p> shell command.");
1385
1386   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1387    [], (* XXX Need stat command to test *)
1388    "change file mode",
1389    "\
1390 Change the mode (permissions) of C<path> to C<mode>.  Only
1391 numeric modes are supported.
1392
1393 I<Note>: When using this command from guestfish, C<mode>
1394 by default would be decimal, unless you prefix it with
1395 C<0> to get octal, ie. use C<0700> not C<700>.
1396
1397 The mode actually set is affected by the umask.");
1398
1399   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1400    [], (* XXX Need stat command to test *)
1401    "change file owner and group",
1402    "\
1403 Change the file owner to C<owner> and group to C<group>.
1404
1405 Only numeric uid and gid are supported.  If you want to use
1406 names, you will need to locate and parse the password file
1407 yourself (Augeas support makes this relatively easy).");
1408
1409   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1410    [InitISOFS, Always, TestOutputTrue (
1411       [["exists"; "/empty"]]);
1412     InitISOFS, Always, TestOutputTrue (
1413       [["exists"; "/directory"]])],
1414    "test if file or directory exists",
1415    "\
1416 This returns C<true> if and only if there is a file, directory
1417 (or anything) with the given C<path> name.
1418
1419 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1420
1421   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1422    [InitISOFS, Always, TestOutputTrue (
1423       [["is_file"; "/known-1"]]);
1424     InitISOFS, Always, TestOutputFalse (
1425       [["is_file"; "/directory"]])],
1426    "test if file exists",
1427    "\
1428 This returns C<true> if and only if there is a file
1429 with the given C<path> name.  Note that it returns false for
1430 other objects like directories.
1431
1432 See also C<guestfs_stat>.");
1433
1434   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1435    [InitISOFS, Always, TestOutputFalse (
1436       [["is_dir"; "/known-3"]]);
1437     InitISOFS, Always, TestOutputTrue (
1438       [["is_dir"; "/directory"]])],
1439    "test if file exists",
1440    "\
1441 This returns C<true> if and only if there is a directory
1442 with the given C<path> name.  Note that it returns false for
1443 other objects like files.
1444
1445 See also C<guestfs_stat>.");
1446
1447   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1448    [InitEmpty, Always, TestOutputListOfDevices (
1449       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1450        ["pvcreate"; "/dev/sda1"];
1451        ["pvcreate"; "/dev/sda2"];
1452        ["pvcreate"; "/dev/sda3"];
1453        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1454    "create an LVM physical volume",
1455    "\
1456 This creates an LVM physical volume on the named C<device>,
1457 where C<device> should usually be a partition name such
1458 as C</dev/sda1>.");
1459
1460   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1461    [InitEmpty, Always, TestOutputList (
1462       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1463        ["pvcreate"; "/dev/sda1"];
1464        ["pvcreate"; "/dev/sda2"];
1465        ["pvcreate"; "/dev/sda3"];
1466        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1467        ["vgcreate"; "VG2"; "/dev/sda3"];
1468        ["vgs"]], ["VG1"; "VG2"])],
1469    "create an LVM volume group",
1470    "\
1471 This creates an LVM volume group called C<volgroup>
1472 from the non-empty list of physical volumes C<physvols>.");
1473
1474   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1475    [InitEmpty, Always, TestOutputList (
1476       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1477        ["pvcreate"; "/dev/sda1"];
1478        ["pvcreate"; "/dev/sda2"];
1479        ["pvcreate"; "/dev/sda3"];
1480        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1481        ["vgcreate"; "VG2"; "/dev/sda3"];
1482        ["lvcreate"; "LV1"; "VG1"; "50"];
1483        ["lvcreate"; "LV2"; "VG1"; "50"];
1484        ["lvcreate"; "LV3"; "VG2"; "50"];
1485        ["lvcreate"; "LV4"; "VG2"; "50"];
1486        ["lvcreate"; "LV5"; "VG2"; "50"];
1487        ["lvs"]],
1488       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1489        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1490    "create an LVM logical volume",
1491    "\
1492 This creates an LVM logical volume called C<logvol>
1493 on the volume group C<volgroup>, with C<size> megabytes.");
1494
1495   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1496    [InitEmpty, Always, TestOutput (
1497       [["part_disk"; "/dev/sda"; "mbr"];
1498        ["mkfs"; "ext2"; "/dev/sda1"];
1499        ["mount_options"; ""; "/dev/sda1"; "/"];
1500        ["write_file"; "/new"; "new file contents"; "0"];
1501        ["cat"; "/new"]], "new file contents")],
1502    "make a filesystem",
1503    "\
1504 This creates a filesystem on C<device> (usually a partition
1505 or LVM logical volume).  The filesystem type is C<fstype>, for
1506 example C<ext3>.");
1507
1508   ("sfdisk", (RErr, [Device "device";
1509                      Int "cyls"; Int "heads"; Int "sectors";
1510                      StringList "lines"]), 43, [DangerWillRobinson],
1511    [],
1512    "create partitions on a block device",
1513    "\
1514 This is a direct interface to the L<sfdisk(8)> program for creating
1515 partitions on block devices.
1516
1517 C<device> should be a block device, for example C</dev/sda>.
1518
1519 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1520 and sectors on the device, which are passed directly to sfdisk as
1521 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1522 of these, then the corresponding parameter is omitted.  Usually for
1523 'large' disks, you can just pass C<0> for these, but for small
1524 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1525 out the right geometry and you will need to tell it.
1526
1527 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1528 information refer to the L<sfdisk(8)> manpage.
1529
1530 To create a single partition occupying the whole disk, you would
1531 pass C<lines> as a single element list, when the single element being
1532 the string C<,> (comma).
1533
1534 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1535 C<guestfs_part_init>");
1536
1537   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1538    [InitBasicFS, Always, TestOutput (
1539       [["write_file"; "/new"; "new file contents"; "0"];
1540        ["cat"; "/new"]], "new file contents");
1541     InitBasicFS, Always, TestOutput (
1542       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1543        ["cat"; "/new"]], "\nnew file contents\n");
1544     InitBasicFS, Always, TestOutput (
1545       [["write_file"; "/new"; "\n\n"; "0"];
1546        ["cat"; "/new"]], "\n\n");
1547     InitBasicFS, Always, TestOutput (
1548       [["write_file"; "/new"; ""; "0"];
1549        ["cat"; "/new"]], "");
1550     InitBasicFS, Always, TestOutput (
1551       [["write_file"; "/new"; "\n\n\n"; "0"];
1552        ["cat"; "/new"]], "\n\n\n");
1553     InitBasicFS, Always, TestOutput (
1554       [["write_file"; "/new"; "\n"; "0"];
1555        ["cat"; "/new"]], "\n");
1556     (* Regression test for RHBZ#597135. *)
1557     InitBasicFS, Always, TestLastFail
1558       [["write_file"; "/new"; "abc"; "10000"]]],
1559    "create a file",
1560    "\
1561 This call creates a file called C<path>.  The contents of the
1562 file is the string C<content> (which can contain any 8 bit data),
1563 with length C<size>.
1564
1565 As a special case, if C<size> is C<0>
1566 then the length is calculated using C<strlen> (so in this case
1567 the content cannot contain embedded ASCII NULs).
1568
1569 I<NB.> Owing to a bug, writing content containing ASCII NUL
1570 characters does I<not> work, even if the length is specified.
1571 We hope to resolve this bug in a future version.  In the meantime
1572 use C<guestfs_upload>.");
1573
1574   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1575    [InitEmpty, Always, TestOutputListOfDevices (
1576       [["part_disk"; "/dev/sda"; "mbr"];
1577        ["mkfs"; "ext2"; "/dev/sda1"];
1578        ["mount_options"; ""; "/dev/sda1"; "/"];
1579        ["mounts"]], ["/dev/sda1"]);
1580     InitEmpty, Always, TestOutputList (
1581       [["part_disk"; "/dev/sda"; "mbr"];
1582        ["mkfs"; "ext2"; "/dev/sda1"];
1583        ["mount_options"; ""; "/dev/sda1"; "/"];
1584        ["umount"; "/"];
1585        ["mounts"]], [])],
1586    "unmount a filesystem",
1587    "\
1588 This unmounts the given filesystem.  The filesystem may be
1589 specified either by its mountpoint (path) or the device which
1590 contains the filesystem.");
1591
1592   ("mounts", (RStringList "devices", []), 46, [],
1593    [InitBasicFS, Always, TestOutputListOfDevices (
1594       [["mounts"]], ["/dev/sda1"])],
1595    "show mounted filesystems",
1596    "\
1597 This returns the list of currently mounted filesystems.  It returns
1598 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1599
1600 Some internal mounts are not shown.
1601
1602 See also: C<guestfs_mountpoints>");
1603
1604   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1605    [InitBasicFS, Always, TestOutputList (
1606       [["umount_all"];
1607        ["mounts"]], []);
1608     (* check that umount_all can unmount nested mounts correctly: *)
1609     InitEmpty, Always, TestOutputList (
1610       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1611        ["mkfs"; "ext2"; "/dev/sda1"];
1612        ["mkfs"; "ext2"; "/dev/sda2"];
1613        ["mkfs"; "ext2"; "/dev/sda3"];
1614        ["mount_options"; ""; "/dev/sda1"; "/"];
1615        ["mkdir"; "/mp1"];
1616        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1617        ["mkdir"; "/mp1/mp2"];
1618        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1619        ["mkdir"; "/mp1/mp2/mp3"];
1620        ["umount_all"];
1621        ["mounts"]], [])],
1622    "unmount all filesystems",
1623    "\
1624 This unmounts all mounted filesystems.
1625
1626 Some internal mounts are not unmounted by this call.");
1627
1628   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1629    [],
1630    "remove all LVM LVs, VGs and PVs",
1631    "\
1632 This command removes all LVM logical volumes, volume groups
1633 and physical volumes.");
1634
1635   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1636    [InitISOFS, Always, TestOutput (
1637       [["file"; "/empty"]], "empty");
1638     InitISOFS, Always, TestOutput (
1639       [["file"; "/known-1"]], "ASCII text");
1640     InitISOFS, Always, TestLastFail (
1641       [["file"; "/notexists"]])],
1642    "determine file type",
1643    "\
1644 This call uses the standard L<file(1)> command to determine
1645 the type or contents of the file.  This also works on devices,
1646 for example to find out whether a partition contains a filesystem.
1647
1648 This call will also transparently look inside various types
1649 of compressed file.
1650
1651 The exact command which runs is C<file -zbsL path>.  Note in
1652 particular that the filename is not prepended to the output
1653 (the C<-b> option).");
1654
1655   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1656    [InitBasicFS, Always, TestOutput (
1657       [["upload"; "test-command"; "/test-command"];
1658        ["chmod"; "0o755"; "/test-command"];
1659        ["command"; "/test-command 1"]], "Result1");
1660     InitBasicFS, Always, TestOutput (
1661       [["upload"; "test-command"; "/test-command"];
1662        ["chmod"; "0o755"; "/test-command"];
1663        ["command"; "/test-command 2"]], "Result2\n");
1664     InitBasicFS, Always, TestOutput (
1665       [["upload"; "test-command"; "/test-command"];
1666        ["chmod"; "0o755"; "/test-command"];
1667        ["command"; "/test-command 3"]], "\nResult3");
1668     InitBasicFS, Always, TestOutput (
1669       [["upload"; "test-command"; "/test-command"];
1670        ["chmod"; "0o755"; "/test-command"];
1671        ["command"; "/test-command 4"]], "\nResult4\n");
1672     InitBasicFS, Always, TestOutput (
1673       [["upload"; "test-command"; "/test-command"];
1674        ["chmod"; "0o755"; "/test-command"];
1675        ["command"; "/test-command 5"]], "\nResult5\n\n");
1676     InitBasicFS, Always, TestOutput (
1677       [["upload"; "test-command"; "/test-command"];
1678        ["chmod"; "0o755"; "/test-command"];
1679        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1680     InitBasicFS, Always, TestOutput (
1681       [["upload"; "test-command"; "/test-command"];
1682        ["chmod"; "0o755"; "/test-command"];
1683        ["command"; "/test-command 7"]], "");
1684     InitBasicFS, Always, TestOutput (
1685       [["upload"; "test-command"; "/test-command"];
1686        ["chmod"; "0o755"; "/test-command"];
1687        ["command"; "/test-command 8"]], "\n");
1688     InitBasicFS, Always, TestOutput (
1689       [["upload"; "test-command"; "/test-command"];
1690        ["chmod"; "0o755"; "/test-command"];
1691        ["command"; "/test-command 9"]], "\n\n");
1692     InitBasicFS, Always, TestOutput (
1693       [["upload"; "test-command"; "/test-command"];
1694        ["chmod"; "0o755"; "/test-command"];
1695        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1696     InitBasicFS, Always, TestOutput (
1697       [["upload"; "test-command"; "/test-command"];
1698        ["chmod"; "0o755"; "/test-command"];
1699        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1700     InitBasicFS, Always, TestLastFail (
1701       [["upload"; "test-command"; "/test-command"];
1702        ["chmod"; "0o755"; "/test-command"];
1703        ["command"; "/test-command"]])],
1704    "run a command from the guest filesystem",
1705    "\
1706 This call runs a command from the guest filesystem.  The
1707 filesystem must be mounted, and must contain a compatible
1708 operating system (ie. something Linux, with the same
1709 or compatible processor architecture).
1710
1711 The single parameter is an argv-style list of arguments.
1712 The first element is the name of the program to run.
1713 Subsequent elements are parameters.  The list must be
1714 non-empty (ie. must contain a program name).  Note that
1715 the command runs directly, and is I<not> invoked via
1716 the shell (see C<guestfs_sh>).
1717
1718 The return value is anything printed to I<stdout> by
1719 the command.
1720
1721 If the command returns a non-zero exit status, then
1722 this function returns an error message.  The error message
1723 string is the content of I<stderr> from the command.
1724
1725 The C<$PATH> environment variable will contain at least
1726 C</usr/bin> and C</bin>.  If you require a program from
1727 another location, you should provide the full path in the
1728 first parameter.
1729
1730 Shared libraries and data files required by the program
1731 must be available on filesystems which are mounted in the
1732 correct places.  It is the caller's responsibility to ensure
1733 all filesystems that are needed are mounted at the right
1734 locations.");
1735
1736   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1737    [InitBasicFS, Always, TestOutputList (
1738       [["upload"; "test-command"; "/test-command"];
1739        ["chmod"; "0o755"; "/test-command"];
1740        ["command_lines"; "/test-command 1"]], ["Result1"]);
1741     InitBasicFS, Always, TestOutputList (
1742       [["upload"; "test-command"; "/test-command"];
1743        ["chmod"; "0o755"; "/test-command"];
1744        ["command_lines"; "/test-command 2"]], ["Result2"]);
1745     InitBasicFS, Always, TestOutputList (
1746       [["upload"; "test-command"; "/test-command"];
1747        ["chmod"; "0o755"; "/test-command"];
1748        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1749     InitBasicFS, Always, TestOutputList (
1750       [["upload"; "test-command"; "/test-command"];
1751        ["chmod"; "0o755"; "/test-command"];
1752        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1753     InitBasicFS, Always, TestOutputList (
1754       [["upload"; "test-command"; "/test-command"];
1755        ["chmod"; "0o755"; "/test-command"];
1756        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1757     InitBasicFS, Always, TestOutputList (
1758       [["upload"; "test-command"; "/test-command"];
1759        ["chmod"; "0o755"; "/test-command"];
1760        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1761     InitBasicFS, Always, TestOutputList (
1762       [["upload"; "test-command"; "/test-command"];
1763        ["chmod"; "0o755"; "/test-command"];
1764        ["command_lines"; "/test-command 7"]], []);
1765     InitBasicFS, Always, TestOutputList (
1766       [["upload"; "test-command"; "/test-command"];
1767        ["chmod"; "0o755"; "/test-command"];
1768        ["command_lines"; "/test-command 8"]], [""]);
1769     InitBasicFS, Always, TestOutputList (
1770       [["upload"; "test-command"; "/test-command"];
1771        ["chmod"; "0o755"; "/test-command"];
1772        ["command_lines"; "/test-command 9"]], ["";""]);
1773     InitBasicFS, Always, TestOutputList (
1774       [["upload"; "test-command"; "/test-command"];
1775        ["chmod"; "0o755"; "/test-command"];
1776        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1777     InitBasicFS, Always, TestOutputList (
1778       [["upload"; "test-command"; "/test-command"];
1779        ["chmod"; "0o755"; "/test-command"];
1780        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1781    "run a command, returning lines",
1782    "\
1783 This is the same as C<guestfs_command>, but splits the
1784 result into a list of lines.
1785
1786 See also: C<guestfs_sh_lines>");
1787
1788   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1789    [InitISOFS, Always, TestOutputStruct (
1790       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1791    "get file information",
1792    "\
1793 Returns file information for the given C<path>.
1794
1795 This is the same as the C<stat(2)> system call.");
1796
1797   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1798    [InitISOFS, Always, TestOutputStruct (
1799       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1800    "get file information for a symbolic link",
1801    "\
1802 Returns file information for the given C<path>.
1803
1804 This is the same as C<guestfs_stat> except that if C<path>
1805 is a symbolic link, then the link is stat-ed, not the file it
1806 refers to.
1807
1808 This is the same as the C<lstat(2)> system call.");
1809
1810   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1811    [InitISOFS, Always, TestOutputStruct (
1812       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1813    "get file system statistics",
1814    "\
1815 Returns file system statistics for any mounted file system.
1816 C<path> should be a file or directory in the mounted file system
1817 (typically it is the mount point itself, but it doesn't need to be).
1818
1819 This is the same as the C<statvfs(2)> system call.");
1820
1821   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1822    [], (* XXX test *)
1823    "get ext2/ext3/ext4 superblock details",
1824    "\
1825 This returns the contents of the ext2, ext3 or ext4 filesystem
1826 superblock on C<device>.
1827
1828 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1829 manpage for more details.  The list of fields returned isn't
1830 clearly defined, and depends on both the version of C<tune2fs>
1831 that libguestfs was built against, and the filesystem itself.");
1832
1833   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1834    [InitEmpty, Always, TestOutputTrue (
1835       [["blockdev_setro"; "/dev/sda"];
1836        ["blockdev_getro"; "/dev/sda"]])],
1837    "set block device to read-only",
1838    "\
1839 Sets the block device named C<device> to read-only.
1840
1841 This uses the L<blockdev(8)> command.");
1842
1843   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1844    [InitEmpty, Always, TestOutputFalse (
1845       [["blockdev_setrw"; "/dev/sda"];
1846        ["blockdev_getro"; "/dev/sda"]])],
1847    "set block device to read-write",
1848    "\
1849 Sets the block device named C<device> to read-write.
1850
1851 This uses the L<blockdev(8)> command.");
1852
1853   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1854    [InitEmpty, Always, TestOutputTrue (
1855       [["blockdev_setro"; "/dev/sda"];
1856        ["blockdev_getro"; "/dev/sda"]])],
1857    "is block device set to read-only",
1858    "\
1859 Returns a boolean indicating if the block device is read-only
1860 (true if read-only, false if not).
1861
1862 This uses the L<blockdev(8)> command.");
1863
1864   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1865    [InitEmpty, Always, TestOutputInt (
1866       [["blockdev_getss"; "/dev/sda"]], 512)],
1867    "get sectorsize of block device",
1868    "\
1869 This returns the size of sectors on a block device.
1870 Usually 512, but can be larger for modern devices.
1871
1872 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1873 for that).
1874
1875 This uses the L<blockdev(8)> command.");
1876
1877   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1878    [InitEmpty, Always, TestOutputInt (
1879       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1880    "get blocksize of block device",
1881    "\
1882 This returns the block size of a device.
1883
1884 (Note this is different from both I<size in blocks> and
1885 I<filesystem block size>).
1886
1887 This uses the L<blockdev(8)> command.");
1888
1889   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1890    [], (* XXX test *)
1891    "set blocksize of block device",
1892    "\
1893 This sets the block size of a device.
1894
1895 (Note this is different from both I<size in blocks> and
1896 I<filesystem block size>).
1897
1898 This uses the L<blockdev(8)> command.");
1899
1900   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1901    [InitEmpty, Always, TestOutputInt (
1902       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1903    "get total size of device in 512-byte sectors",
1904    "\
1905 This returns the size of the device in units of 512-byte sectors
1906 (even if the sectorsize isn't 512 bytes ... weird).
1907
1908 See also C<guestfs_blockdev_getss> for the real sector size of
1909 the device, and C<guestfs_blockdev_getsize64> for the more
1910 useful I<size in bytes>.
1911
1912 This uses the L<blockdev(8)> command.");
1913
1914   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1915    [InitEmpty, Always, TestOutputInt (
1916       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1917    "get total size of device in bytes",
1918    "\
1919 This returns the size of the device in bytes.
1920
1921 See also C<guestfs_blockdev_getsz>.
1922
1923 This uses the L<blockdev(8)> command.");
1924
1925   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1926    [InitEmpty, Always, TestRun
1927       [["blockdev_flushbufs"; "/dev/sda"]]],
1928    "flush device buffers",
1929    "\
1930 This tells the kernel to flush internal buffers associated
1931 with C<device>.
1932
1933 This uses the L<blockdev(8)> command.");
1934
1935   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1936    [InitEmpty, Always, TestRun
1937       [["blockdev_rereadpt"; "/dev/sda"]]],
1938    "reread partition table",
1939    "\
1940 Reread the partition table on C<device>.
1941
1942 This uses the L<blockdev(8)> command.");
1943
1944   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1945    [InitBasicFS, Always, TestOutput (
1946       (* Pick a file from cwd which isn't likely to change. *)
1947       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1948        ["checksum"; "md5"; "/COPYING.LIB"]],
1949       Digest.to_hex (Digest.file "COPYING.LIB"))],
1950    "upload a file from the local machine",
1951    "\
1952 Upload local file C<filename> to C<remotefilename> on the
1953 filesystem.
1954
1955 C<filename> can also be a named pipe.
1956
1957 See also C<guestfs_download>.");
1958
1959   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1960    [InitBasicFS, Always, TestOutput (
1961       (* Pick a file from cwd which isn't likely to change. *)
1962       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1963        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1964        ["upload"; "testdownload.tmp"; "/upload"];
1965        ["checksum"; "md5"; "/upload"]],
1966       Digest.to_hex (Digest.file "COPYING.LIB"))],
1967    "download a file to the local machine",
1968    "\
1969 Download file C<remotefilename> and save it as C<filename>
1970 on the local machine.
1971
1972 C<filename> can also be a named pipe.
1973
1974 See also C<guestfs_upload>, C<guestfs_cat>.");
1975
1976   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1977    [InitISOFS, Always, TestOutput (
1978       [["checksum"; "crc"; "/known-3"]], "2891671662");
1979     InitISOFS, Always, TestLastFail (
1980       [["checksum"; "crc"; "/notexists"]]);
1981     InitISOFS, Always, TestOutput (
1982       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1983     InitISOFS, Always, TestOutput (
1984       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1985     InitISOFS, Always, TestOutput (
1986       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1987     InitISOFS, Always, TestOutput (
1988       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1989     InitISOFS, Always, TestOutput (
1990       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1991     InitISOFS, Always, TestOutput (
1992       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1993    "compute MD5, SHAx or CRC checksum of file",
1994    "\
1995 This call computes the MD5, SHAx or CRC checksum of the
1996 file named C<path>.
1997
1998 The type of checksum to compute is given by the C<csumtype>
1999 parameter which must have one of the following values:
2000
2001 =over 4
2002
2003 =item C<crc>
2004
2005 Compute the cyclic redundancy check (CRC) specified by POSIX
2006 for the C<cksum> command.
2007
2008 =item C<md5>
2009
2010 Compute the MD5 hash (using the C<md5sum> program).
2011
2012 =item C<sha1>
2013
2014 Compute the SHA1 hash (using the C<sha1sum> program).
2015
2016 =item C<sha224>
2017
2018 Compute the SHA224 hash (using the C<sha224sum> program).
2019
2020 =item C<sha256>
2021
2022 Compute the SHA256 hash (using the C<sha256sum> program).
2023
2024 =item C<sha384>
2025
2026 Compute the SHA384 hash (using the C<sha384sum> program).
2027
2028 =item C<sha512>
2029
2030 Compute the SHA512 hash (using the C<sha512sum> program).
2031
2032 =back
2033
2034 The checksum is returned as a printable string.");
2035
2036   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2037    [InitBasicFS, Always, TestOutput (
2038       [["tar_in"; "../images/helloworld.tar"; "/"];
2039        ["cat"; "/hello"]], "hello\n")],
2040    "unpack tarfile to directory",
2041    "\
2042 This command uploads and unpacks local file C<tarfile> (an
2043 I<uncompressed> tar file) into C<directory>.
2044
2045 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2046
2047   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2048    [],
2049    "pack directory into tarfile",
2050    "\
2051 This command packs the contents of C<directory> and downloads
2052 it to local file C<tarfile>.
2053
2054 To download a compressed tarball, use C<guestfs_tgz_out>.");
2055
2056   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2057    [InitBasicFS, Always, TestOutput (
2058       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2059        ["cat"; "/hello"]], "hello\n")],
2060    "unpack compressed tarball to directory",
2061    "\
2062 This command uploads and unpacks local file C<tarball> (a
2063 I<gzip compressed> tar file) into C<directory>.
2064
2065 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2066
2067   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2068    [],
2069    "pack directory into compressed tarball",
2070    "\
2071 This command packs the contents of C<directory> and downloads
2072 it to local file C<tarball>.
2073
2074 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2075
2076   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2077    [InitBasicFS, Always, TestLastFail (
2078       [["umount"; "/"];
2079        ["mount_ro"; "/dev/sda1"; "/"];
2080        ["touch"; "/new"]]);
2081     InitBasicFS, Always, TestOutput (
2082       [["write_file"; "/new"; "data"; "0"];
2083        ["umount"; "/"];
2084        ["mount_ro"; "/dev/sda1"; "/"];
2085        ["cat"; "/new"]], "data")],
2086    "mount a guest disk, read-only",
2087    "\
2088 This is the same as the C<guestfs_mount> command, but it
2089 mounts the filesystem with the read-only (I<-o ro>) flag.");
2090
2091   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2092    [],
2093    "mount a guest disk with mount options",
2094    "\
2095 This is the same as the C<guestfs_mount> command, but it
2096 allows you to set the mount options as for the
2097 L<mount(8)> I<-o> flag.
2098
2099 If the C<options> parameter is an empty string, then
2100 no options are passed (all options default to whatever
2101 the filesystem uses).");
2102
2103   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2104    [],
2105    "mount a guest disk with mount options and vfstype",
2106    "\
2107 This is the same as the C<guestfs_mount> command, but it
2108 allows you to set both the mount options and the vfstype
2109 as for the L<mount(8)> I<-o> and I<-t> flags.");
2110
2111   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2112    [],
2113    "debugging and internals",
2114    "\
2115 The C<guestfs_debug> command exposes some internals of
2116 C<guestfsd> (the guestfs daemon) that runs inside the
2117 qemu subprocess.
2118
2119 There is no comprehensive help for this command.  You have
2120 to look at the file C<daemon/debug.c> in the libguestfs source
2121 to find out what you can do.");
2122
2123   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2124    [InitEmpty, Always, TestOutputList (
2125       [["part_disk"; "/dev/sda"; "mbr"];
2126        ["pvcreate"; "/dev/sda1"];
2127        ["vgcreate"; "VG"; "/dev/sda1"];
2128        ["lvcreate"; "LV1"; "VG"; "50"];
2129        ["lvcreate"; "LV2"; "VG"; "50"];
2130        ["lvremove"; "/dev/VG/LV1"];
2131        ["lvs"]], ["/dev/VG/LV2"]);
2132     InitEmpty, Always, TestOutputList (
2133       [["part_disk"; "/dev/sda"; "mbr"];
2134        ["pvcreate"; "/dev/sda1"];
2135        ["vgcreate"; "VG"; "/dev/sda1"];
2136        ["lvcreate"; "LV1"; "VG"; "50"];
2137        ["lvcreate"; "LV2"; "VG"; "50"];
2138        ["lvremove"; "/dev/VG"];
2139        ["lvs"]], []);
2140     InitEmpty, Always, TestOutputList (
2141       [["part_disk"; "/dev/sda"; "mbr"];
2142        ["pvcreate"; "/dev/sda1"];
2143        ["vgcreate"; "VG"; "/dev/sda1"];
2144        ["lvcreate"; "LV1"; "VG"; "50"];
2145        ["lvcreate"; "LV2"; "VG"; "50"];
2146        ["lvremove"; "/dev/VG"];
2147        ["vgs"]], ["VG"])],
2148    "remove an LVM logical volume",
2149    "\
2150 Remove an LVM logical volume C<device>, where C<device> is
2151 the path to the LV, such as C</dev/VG/LV>.
2152
2153 You can also remove all LVs in a volume group by specifying
2154 the VG name, C</dev/VG>.");
2155
2156   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2157    [InitEmpty, Always, TestOutputList (
2158       [["part_disk"; "/dev/sda"; "mbr"];
2159        ["pvcreate"; "/dev/sda1"];
2160        ["vgcreate"; "VG"; "/dev/sda1"];
2161        ["lvcreate"; "LV1"; "VG"; "50"];
2162        ["lvcreate"; "LV2"; "VG"; "50"];
2163        ["vgremove"; "VG"];
2164        ["lvs"]], []);
2165     InitEmpty, Always, TestOutputList (
2166       [["part_disk"; "/dev/sda"; "mbr"];
2167        ["pvcreate"; "/dev/sda1"];
2168        ["vgcreate"; "VG"; "/dev/sda1"];
2169        ["lvcreate"; "LV1"; "VG"; "50"];
2170        ["lvcreate"; "LV2"; "VG"; "50"];
2171        ["vgremove"; "VG"];
2172        ["vgs"]], [])],
2173    "remove an LVM volume group",
2174    "\
2175 Remove an LVM volume group C<vgname>, (for example C<VG>).
2176
2177 This also forcibly removes all logical volumes in the volume
2178 group (if any).");
2179
2180   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2181    [InitEmpty, Always, TestOutputListOfDevices (
2182       [["part_disk"; "/dev/sda"; "mbr"];
2183        ["pvcreate"; "/dev/sda1"];
2184        ["vgcreate"; "VG"; "/dev/sda1"];
2185        ["lvcreate"; "LV1"; "VG"; "50"];
2186        ["lvcreate"; "LV2"; "VG"; "50"];
2187        ["vgremove"; "VG"];
2188        ["pvremove"; "/dev/sda1"];
2189        ["lvs"]], []);
2190     InitEmpty, Always, TestOutputListOfDevices (
2191       [["part_disk"; "/dev/sda"; "mbr"];
2192        ["pvcreate"; "/dev/sda1"];
2193        ["vgcreate"; "VG"; "/dev/sda1"];
2194        ["lvcreate"; "LV1"; "VG"; "50"];
2195        ["lvcreate"; "LV2"; "VG"; "50"];
2196        ["vgremove"; "VG"];
2197        ["pvremove"; "/dev/sda1"];
2198        ["vgs"]], []);
2199     InitEmpty, Always, TestOutputListOfDevices (
2200       [["part_disk"; "/dev/sda"; "mbr"];
2201        ["pvcreate"; "/dev/sda1"];
2202        ["vgcreate"; "VG"; "/dev/sda1"];
2203        ["lvcreate"; "LV1"; "VG"; "50"];
2204        ["lvcreate"; "LV2"; "VG"; "50"];
2205        ["vgremove"; "VG"];
2206        ["pvremove"; "/dev/sda1"];
2207        ["pvs"]], [])],
2208    "remove an LVM physical volume",
2209    "\
2210 This wipes a physical volume C<device> so that LVM will no longer
2211 recognise it.
2212
2213 The implementation uses the C<pvremove> command which refuses to
2214 wipe physical volumes that contain any volume groups, so you have
2215 to remove those first.");
2216
2217   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2218    [InitBasicFS, Always, TestOutput (
2219       [["set_e2label"; "/dev/sda1"; "testlabel"];
2220        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2221    "set the ext2/3/4 filesystem label",
2222    "\
2223 This sets the ext2/3/4 filesystem label of the filesystem on
2224 C<device> to C<label>.  Filesystem labels are limited to
2225 16 characters.
2226
2227 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2228 to return the existing label on a filesystem.");
2229
2230   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2231    [],
2232    "get the ext2/3/4 filesystem label",
2233    "\
2234 This returns the ext2/3/4 filesystem label of the filesystem on
2235 C<device>.");
2236
2237   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2238    (let uuid = uuidgen () in
2239     [InitBasicFS, Always, TestOutput (
2240        [["set_e2uuid"; "/dev/sda1"; uuid];
2241         ["get_e2uuid"; "/dev/sda1"]], uuid);
2242      InitBasicFS, Always, TestOutput (
2243        [["set_e2uuid"; "/dev/sda1"; "clear"];
2244         ["get_e2uuid"; "/dev/sda1"]], "");
2245      (* We can't predict what UUIDs will be, so just check the commands run. *)
2246      InitBasicFS, Always, TestRun (
2247        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2248      InitBasicFS, Always, TestRun (
2249        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2250    "set the ext2/3/4 filesystem UUID",
2251    "\
2252 This sets the ext2/3/4 filesystem UUID of the filesystem on
2253 C<device> to C<uuid>.  The format of the UUID and alternatives
2254 such as C<clear>, C<random> and C<time> are described in the
2255 L<tune2fs(8)> manpage.
2256
2257 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2258 to return the existing UUID of a filesystem.");
2259
2260   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2261    [],
2262    "get the ext2/3/4 filesystem UUID",
2263    "\
2264 This returns the ext2/3/4 filesystem UUID of the filesystem on
2265 C<device>.");
2266
2267   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2268    [InitBasicFS, Always, TestOutputInt (
2269       [["umount"; "/dev/sda1"];
2270        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2271     InitBasicFS, Always, TestOutputInt (
2272       [["umount"; "/dev/sda1"];
2273        ["zero"; "/dev/sda1"];
2274        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2275    "run the filesystem checker",
2276    "\
2277 This runs the filesystem checker (fsck) on C<device> which
2278 should have filesystem type C<fstype>.
2279
2280 The returned integer is the status.  See L<fsck(8)> for the
2281 list of status codes from C<fsck>.
2282
2283 Notes:
2284
2285 =over 4
2286
2287 =item *
2288
2289 Multiple status codes can be summed together.
2290
2291 =item *
2292
2293 A non-zero return code can mean \"success\", for example if
2294 errors have been corrected on the filesystem.
2295
2296 =item *
2297
2298 Checking or repairing NTFS volumes is not supported
2299 (by linux-ntfs).
2300
2301 =back
2302
2303 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2304
2305   ("zero", (RErr, [Device "device"]), 85, [],
2306    [InitBasicFS, Always, TestOutput (
2307       [["umount"; "/dev/sda1"];
2308        ["zero"; "/dev/sda1"];
2309        ["file"; "/dev/sda1"]], "data")],
2310    "write zeroes to the device",
2311    "\
2312 This command writes zeroes over the first few blocks of C<device>.
2313
2314 How many blocks are zeroed isn't specified (but it's I<not> enough
2315 to securely wipe the device).  It should be sufficient to remove
2316 any partition tables, filesystem superblocks and so on.
2317
2318 See also: C<guestfs_scrub_device>.");
2319
2320   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2321    (* Test disabled because grub-install incompatible with virtio-blk driver.
2322     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2323     *)
2324    [InitBasicFS, Disabled, TestOutputTrue (
2325       [["grub_install"; "/"; "/dev/sda1"];
2326        ["is_dir"; "/boot"]])],
2327    "install GRUB",
2328    "\
2329 This command installs GRUB (the Grand Unified Bootloader) on
2330 C<device>, with the root directory being C<root>.
2331
2332 Note: If grub-install reports the error
2333 \"No suitable drive was found in the generated device map.\"
2334 it may be that you need to create a C</boot/grub/device.map>
2335 file first that contains the mapping between grub device names
2336 and Linux device names.  It is usually sufficient to create
2337 a file containing:
2338
2339  (hd0) /dev/vda
2340
2341 replacing C</dev/vda> with the name of the installation device.");
2342
2343   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2344    [InitBasicFS, Always, TestOutput (
2345       [["write_file"; "/old"; "file content"; "0"];
2346        ["cp"; "/old"; "/new"];
2347        ["cat"; "/new"]], "file content");
2348     InitBasicFS, Always, TestOutputTrue (
2349       [["write_file"; "/old"; "file content"; "0"];
2350        ["cp"; "/old"; "/new"];
2351        ["is_file"; "/old"]]);
2352     InitBasicFS, Always, TestOutput (
2353       [["write_file"; "/old"; "file content"; "0"];
2354        ["mkdir"; "/dir"];
2355        ["cp"; "/old"; "/dir/new"];
2356        ["cat"; "/dir/new"]], "file content")],
2357    "copy a file",
2358    "\
2359 This copies a file from C<src> to C<dest> where C<dest> is
2360 either a destination filename or destination directory.");
2361
2362   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2363    [InitBasicFS, Always, TestOutput (
2364       [["mkdir"; "/olddir"];
2365        ["mkdir"; "/newdir"];
2366        ["write_file"; "/olddir/file"; "file content"; "0"];
2367        ["cp_a"; "/olddir"; "/newdir"];
2368        ["cat"; "/newdir/olddir/file"]], "file content")],
2369    "copy a file or directory recursively",
2370    "\
2371 This copies a file or directory from C<src> to C<dest>
2372 recursively using the C<cp -a> command.");
2373
2374   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2375    [InitBasicFS, Always, TestOutput (
2376       [["write_file"; "/old"; "file content"; "0"];
2377        ["mv"; "/old"; "/new"];
2378        ["cat"; "/new"]], "file content");
2379     InitBasicFS, Always, TestOutputFalse (
2380       [["write_file"; "/old"; "file content"; "0"];
2381        ["mv"; "/old"; "/new"];
2382        ["is_file"; "/old"]])],
2383    "move a file",
2384    "\
2385 This moves a file from C<src> to C<dest> where C<dest> is
2386 either a destination filename or destination directory.");
2387
2388   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2389    [InitEmpty, Always, TestRun (
2390       [["drop_caches"; "3"]])],
2391    "drop kernel page cache, dentries and inodes",
2392    "\
2393 This instructs the guest kernel to drop its page cache,
2394 and/or dentries and inode caches.  The parameter C<whattodrop>
2395 tells the kernel what precisely to drop, see
2396 L<http://linux-mm.org/Drop_Caches>
2397
2398 Setting C<whattodrop> to 3 should drop everything.
2399
2400 This automatically calls L<sync(2)> before the operation,
2401 so that the maximum guest memory is freed.");
2402
2403   ("dmesg", (RString "kmsgs", []), 91, [],
2404    [InitEmpty, Always, TestRun (
2405       [["dmesg"]])],
2406    "return kernel messages",
2407    "\
2408 This returns the kernel messages (C<dmesg> output) from
2409 the guest kernel.  This is sometimes useful for extended
2410 debugging of problems.
2411
2412 Another way to get the same information is to enable
2413 verbose messages with C<guestfs_set_verbose> or by setting
2414 the environment variable C<LIBGUESTFS_DEBUG=1> before
2415 running the program.");
2416
2417   ("ping_daemon", (RErr, []), 92, [],
2418    [InitEmpty, Always, TestRun (
2419       [["ping_daemon"]])],
2420    "ping the guest daemon",
2421    "\
2422 This is a test probe into the guestfs daemon running inside
2423 the qemu subprocess.  Calling this function checks that the
2424 daemon responds to the ping message, without affecting the daemon
2425 or attached block device(s) in any other way.");
2426
2427   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2428    [InitBasicFS, Always, TestOutputTrue (
2429       [["write_file"; "/file1"; "contents of a file"; "0"];
2430        ["cp"; "/file1"; "/file2"];
2431        ["equal"; "/file1"; "/file2"]]);
2432     InitBasicFS, Always, TestOutputFalse (
2433       [["write_file"; "/file1"; "contents of a file"; "0"];
2434        ["write_file"; "/file2"; "contents of another file"; "0"];
2435        ["equal"; "/file1"; "/file2"]]);
2436     InitBasicFS, Always, TestLastFail (
2437       [["equal"; "/file1"; "/file2"]])],
2438    "test if two files have equal contents",
2439    "\
2440 This compares the two files C<file1> and C<file2> and returns
2441 true if their content is exactly equal, or false otherwise.
2442
2443 The external L<cmp(1)> program is used for the comparison.");
2444
2445   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2446    [InitISOFS, Always, TestOutputList (
2447       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2448     InitISOFS, Always, TestOutputList (
2449       [["strings"; "/empty"]], [])],
2450    "print the printable strings in a file",
2451    "\
2452 This runs the L<strings(1)> command on a file and returns
2453 the list of printable strings found.");
2454
2455   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2456    [InitISOFS, Always, TestOutputList (
2457       [["strings_e"; "b"; "/known-5"]], []);
2458     InitBasicFS, Disabled, TestOutputList (
2459       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2460        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2461    "print the printable strings in a file",
2462    "\
2463 This is like the C<guestfs_strings> command, but allows you to
2464 specify the encoding of strings that are looked for in
2465 the source file C<path>.
2466
2467 Allowed encodings are:
2468
2469 =over 4
2470
2471 =item s
2472
2473 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2474 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2475
2476 =item S
2477
2478 Single 8-bit-byte characters.
2479
2480 =item b
2481
2482 16-bit big endian strings such as those encoded in
2483 UTF-16BE or UCS-2BE.
2484
2485 =item l (lower case letter L)
2486
2487 16-bit little endian such as UTF-16LE and UCS-2LE.
2488 This is useful for examining binaries in Windows guests.
2489
2490 =item B
2491
2492 32-bit big endian such as UCS-4BE.
2493
2494 =item L
2495
2496 32-bit little endian such as UCS-4LE.
2497
2498 =back
2499
2500 The returned strings are transcoded to UTF-8.");
2501
2502   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2503    [InitISOFS, Always, TestOutput (
2504       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2505     (* Test for RHBZ#501888c2 regression which caused large hexdump
2506      * commands to segfault.
2507      *)
2508     InitISOFS, Always, TestRun (
2509       [["hexdump"; "/100krandom"]])],
2510    "dump a file in hexadecimal",
2511    "\
2512 This runs C<hexdump -C> on the given C<path>.  The result is
2513 the human-readable, canonical hex dump of the file.");
2514
2515   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2516    [InitNone, Always, TestOutput (
2517       [["part_disk"; "/dev/sda"; "mbr"];
2518        ["mkfs"; "ext3"; "/dev/sda1"];
2519        ["mount_options"; ""; "/dev/sda1"; "/"];
2520        ["write_file"; "/new"; "test file"; "0"];
2521        ["umount"; "/dev/sda1"];
2522        ["zerofree"; "/dev/sda1"];
2523        ["mount_options"; ""; "/dev/sda1"; "/"];
2524        ["cat"; "/new"]], "test file")],
2525    "zero unused inodes and disk blocks on ext2/3 filesystem",
2526    "\
2527 This runs the I<zerofree> program on C<device>.  This program
2528 claims to zero unused inodes and disk blocks on an ext2/3
2529 filesystem, thus making it possible to compress the filesystem
2530 more effectively.
2531
2532 You should B<not> run this program if the filesystem is
2533 mounted.
2534
2535 It is possible that using this program can damage the filesystem
2536 or data on the filesystem.");
2537
2538   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2539    [],
2540    "resize an LVM physical volume",
2541    "\
2542 This resizes (expands or shrinks) an existing LVM physical
2543 volume to match the new size of the underlying device.");
2544
2545   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2546                        Int "cyls"; Int "heads"; Int "sectors";
2547                        String "line"]), 99, [DangerWillRobinson],
2548    [],
2549    "modify a single partition on a block device",
2550    "\
2551 This runs L<sfdisk(8)> option to modify just the single
2552 partition C<n> (note: C<n> counts from 1).
2553
2554 For other parameters, see C<guestfs_sfdisk>.  You should usually
2555 pass C<0> for the cyls/heads/sectors parameters.
2556
2557 See also: C<guestfs_part_add>");
2558
2559   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2560    [],
2561    "display the partition table",
2562    "\
2563 This displays the partition table on C<device>, in the
2564 human-readable output of the L<sfdisk(8)> command.  It is
2565 not intended to be parsed.
2566
2567 See also: C<guestfs_part_list>");
2568
2569   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2570    [],
2571    "display the kernel geometry",
2572    "\
2573 This displays the kernel's idea of the geometry of C<device>.
2574
2575 The result is in human-readable format, and not designed to
2576 be parsed.");
2577
2578   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2579    [],
2580    "display the disk geometry from the partition table",
2581    "\
2582 This displays the disk geometry of C<device> read from the
2583 partition table.  Especially in the case where the underlying
2584 block device has been resized, this can be different from the
2585 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2586
2587 The result is in human-readable format, and not designed to
2588 be parsed.");
2589
2590   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2591    [],
2592    "activate or deactivate all volume groups",
2593    "\
2594 This command activates or (if C<activate> is false) deactivates
2595 all logical volumes in all volume groups.
2596 If activated, then they are made known to the
2597 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2598 then those devices disappear.
2599
2600 This command is the same as running C<vgchange -a y|n>");
2601
2602   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2603    [],
2604    "activate or deactivate some volume groups",
2605    "\
2606 This command activates or (if C<activate> is false) deactivates
2607 all logical volumes in the listed volume groups C<volgroups>.
2608 If activated, then they are made known to the
2609 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2610 then those devices disappear.
2611
2612 This command is the same as running C<vgchange -a y|n volgroups...>
2613
2614 Note that if C<volgroups> is an empty list then B<all> volume groups
2615 are activated or deactivated.");
2616
2617   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2618    [InitNone, Always, TestOutput (
2619       [["part_disk"; "/dev/sda"; "mbr"];
2620        ["pvcreate"; "/dev/sda1"];
2621        ["vgcreate"; "VG"; "/dev/sda1"];
2622        ["lvcreate"; "LV"; "VG"; "10"];
2623        ["mkfs"; "ext2"; "/dev/VG/LV"];
2624        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2625        ["write_file"; "/new"; "test content"; "0"];
2626        ["umount"; "/"];
2627        ["lvresize"; "/dev/VG/LV"; "20"];
2628        ["e2fsck_f"; "/dev/VG/LV"];
2629        ["resize2fs"; "/dev/VG/LV"];
2630        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2631        ["cat"; "/new"]], "test content");
2632     InitNone, Always, TestRun (
2633       (* Make an LV smaller to test RHBZ#587484. *)
2634       [["part_disk"; "/dev/sda"; "mbr"];
2635        ["pvcreate"; "/dev/sda1"];
2636        ["vgcreate"; "VG"; "/dev/sda1"];
2637        ["lvcreate"; "LV"; "VG"; "20"];
2638        ["lvresize"; "/dev/VG/LV"; "10"]])],
2639    "resize an LVM logical volume",
2640    "\
2641 This resizes (expands or shrinks) an existing LVM logical
2642 volume to C<mbytes>.  When reducing, data in the reduced part
2643 is lost.");
2644
2645   ("resize2fs", (RErr, [Device "device"]), 106, [],
2646    [], (* lvresize tests this *)
2647    "resize an ext2, ext3 or ext4 filesystem",
2648    "\
2649 This resizes an ext2, ext3 or ext4 filesystem to match the size of
2650 the underlying device.
2651
2652 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2653 on the C<device> before calling this command.  For unknown reasons
2654 C<resize2fs> sometimes gives an error about this and sometimes not.
2655 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2656 calling this function.");
2657
2658   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2659    [InitBasicFS, Always, TestOutputList (
2660       [["find"; "/"]], ["lost+found"]);
2661     InitBasicFS, Always, TestOutputList (
2662       [["touch"; "/a"];
2663        ["mkdir"; "/b"];
2664        ["touch"; "/b/c"];
2665        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2666     InitBasicFS, Always, TestOutputList (
2667       [["mkdir_p"; "/a/b/c"];
2668        ["touch"; "/a/b/c/d"];
2669        ["find"; "/a/b/"]], ["c"; "c/d"])],
2670    "find all files and directories",
2671    "\
2672 This command lists out all files and directories, recursively,
2673 starting at C<directory>.  It is essentially equivalent to
2674 running the shell command C<find directory -print> but some
2675 post-processing happens on the output, described below.
2676
2677 This returns a list of strings I<without any prefix>.  Thus
2678 if the directory structure was:
2679
2680  /tmp/a
2681  /tmp/b
2682  /tmp/c/d
2683
2684 then the returned list from C<guestfs_find> C</tmp> would be
2685 4 elements:
2686
2687  a
2688  b
2689  c
2690  c/d
2691
2692 If C<directory> is not a directory, then this command returns
2693 an error.
2694
2695 The returned list is sorted.
2696
2697 See also C<guestfs_find0>.");
2698
2699   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2700    [], (* lvresize tests this *)
2701    "check an ext2/ext3 filesystem",
2702    "\
2703 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2704 filesystem checker on C<device>, noninteractively (C<-p>),
2705 even if the filesystem appears to be clean (C<-f>).
2706
2707 This command is only needed because of C<guestfs_resize2fs>
2708 (q.v.).  Normally you should use C<guestfs_fsck>.");
2709
2710   ("sleep", (RErr, [Int "secs"]), 109, [],
2711    [InitNone, Always, TestRun (
2712       [["sleep"; "1"]])],
2713    "sleep for some seconds",
2714    "\
2715 Sleep for C<secs> seconds.");
2716
2717   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2718    [InitNone, Always, TestOutputInt (
2719       [["part_disk"; "/dev/sda"; "mbr"];
2720        ["mkfs"; "ntfs"; "/dev/sda1"];
2721        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2722     InitNone, Always, TestOutputInt (
2723       [["part_disk"; "/dev/sda"; "mbr"];
2724        ["mkfs"; "ext2"; "/dev/sda1"];
2725        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2726    "probe NTFS volume",
2727    "\
2728 This command runs the L<ntfs-3g.probe(8)> command which probes
2729 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2730 be mounted read-write, and some cannot be mounted at all).
2731
2732 C<rw> is a boolean flag.  Set it to true if you want to test
2733 if the volume can be mounted read-write.  Set it to false if
2734 you want to test if the volume can be mounted read-only.
2735
2736 The return value is an integer which C<0> if the operation
2737 would succeed, or some non-zero value documented in the
2738 L<ntfs-3g.probe(8)> manual page.");
2739
2740   ("sh", (RString "output", [String "command"]), 111, [],
2741    [], (* XXX needs tests *)
2742    "run a command via the shell",
2743    "\
2744 This call runs a command from the guest filesystem via the
2745 guest's C</bin/sh>.
2746
2747 This is like C<guestfs_command>, but passes the command to:
2748
2749  /bin/sh -c \"command\"
2750
2751 Depending on the guest's shell, this usually results in
2752 wildcards being expanded, shell expressions being interpolated
2753 and so on.
2754
2755 All the provisos about C<guestfs_command> apply to this call.");
2756
2757   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2758    [], (* XXX needs tests *)
2759    "run a command via the shell returning lines",
2760    "\
2761 This is the same as C<guestfs_sh>, but splits the result
2762 into a list of lines.
2763
2764 See also: C<guestfs_command_lines>");
2765
2766   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2767    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2768     * code in stubs.c, since all valid glob patterns must start with "/".
2769     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2770     *)
2771    [InitBasicFS, Always, TestOutputList (
2772       [["mkdir_p"; "/a/b/c"];
2773        ["touch"; "/a/b/c/d"];
2774        ["touch"; "/a/b/c/e"];
2775        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2776     InitBasicFS, Always, TestOutputList (
2777       [["mkdir_p"; "/a/b/c"];
2778        ["touch"; "/a/b/c/d"];
2779        ["touch"; "/a/b/c/e"];
2780        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2781     InitBasicFS, Always, TestOutputList (
2782       [["mkdir_p"; "/a/b/c"];
2783        ["touch"; "/a/b/c/d"];
2784        ["touch"; "/a/b/c/e"];
2785        ["glob_expand"; "/a/*/x/*"]], [])],
2786    "expand a wildcard path",
2787    "\
2788 This command searches for all the pathnames matching
2789 C<pattern> according to the wildcard expansion rules
2790 used by the shell.
2791
2792 If no paths match, then this returns an empty list
2793 (note: not an error).
2794
2795 It is just a wrapper around the C L<glob(3)> function
2796 with flags C<GLOB_MARK|GLOB_BRACE>.
2797 See that manual page for more details.");
2798
2799   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2800    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2801       [["scrub_device"; "/dev/sdc"]])],
2802    "scrub (securely wipe) a device",
2803    "\
2804 This command writes patterns over C<device> to make data retrieval
2805 more difficult.
2806
2807 It is an interface to the L<scrub(1)> program.  See that
2808 manual page for more details.");
2809
2810   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2811    [InitBasicFS, Always, TestRun (
2812       [["write_file"; "/file"; "content"; "0"];
2813        ["scrub_file"; "/file"]])],
2814    "scrub (securely wipe) a file",
2815    "\
2816 This command writes patterns over a file to make data retrieval
2817 more difficult.
2818
2819 The file is I<removed> after scrubbing.
2820
2821 It is an interface to the L<scrub(1)> program.  See that
2822 manual page for more details.");
2823
2824   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2825    [], (* XXX needs testing *)
2826    "scrub (securely wipe) free space",
2827    "\
2828 This command creates the directory C<dir> and then fills it
2829 with files until the filesystem is full, and scrubs the files
2830 as for C<guestfs_scrub_file>, and deletes them.
2831 The intention is to scrub any free space on the partition
2832 containing C<dir>.
2833
2834 It is an interface to the L<scrub(1)> program.  See that
2835 manual page for more details.");
2836
2837   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2838    [InitBasicFS, Always, TestRun (
2839       [["mkdir"; "/tmp"];
2840        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2841    "create a temporary directory",
2842    "\
2843 This command creates a temporary directory.  The
2844 C<template> parameter should be a full pathname for the
2845 temporary directory name with the final six characters being
2846 \"XXXXXX\".
2847
2848 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2849 the second one being suitable for Windows filesystems.
2850
2851 The name of the temporary directory that was created
2852 is returned.
2853
2854 The temporary directory is created with mode 0700
2855 and is owned by root.
2856
2857 The caller is responsible for deleting the temporary
2858 directory and its contents after use.
2859
2860 See also: L<mkdtemp(3)>");
2861
2862   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2863    [InitISOFS, Always, TestOutputInt (
2864       [["wc_l"; "/10klines"]], 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    "return first 10 lines of a file",
2890    "\
2891 This command returns up to the first 10 lines of a file as
2892 a list of strings.");
2893
2894   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2895    [InitISOFS, Always, TestOutputList (
2896       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2897     InitISOFS, Always, TestOutputList (
2898       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2899     InitISOFS, Always, TestOutputList (
2900       [["head_n"; "0"; "/10klines"]], [])],
2901    "return first N lines of a file",
2902    "\
2903 If the parameter C<nrlines> is a positive number, this returns the first
2904 C<nrlines> lines of the file C<path>.
2905
2906 If the parameter C<nrlines> is a negative number, this returns lines
2907 from the file C<path>, excluding the last C<nrlines> lines.
2908
2909 If the parameter C<nrlines> is zero, this returns an empty list.");
2910
2911   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2912    [InitISOFS, Always, TestOutputList (
2913       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2914    "return last 10 lines of a file",
2915    "\
2916 This command returns up to the last 10 lines of a file as
2917 a list of strings.");
2918
2919   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2920    [InitISOFS, Always, TestOutputList (
2921       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2922     InitISOFS, Always, TestOutputList (
2923       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2924     InitISOFS, Always, TestOutputList (
2925       [["tail_n"; "0"; "/10klines"]], [])],
2926    "return last N lines of a file",
2927    "\
2928 If the parameter C<nrlines> is a positive number, this returns the last
2929 C<nrlines> lines of the file C<path>.
2930
2931 If the parameter C<nrlines> is a negative number, this returns lines
2932 from the file C<path>, starting with the C<-nrlines>th line.
2933
2934 If the parameter C<nrlines> is zero, this returns an empty list.");
2935
2936   ("df", (RString "output", []), 125, [],
2937    [], (* XXX Tricky to test because it depends on the exact format
2938         * of the 'df' command and other imponderables.
2939         *)
2940    "report file system disk space usage",
2941    "\
2942 This command runs the C<df> command to report disk space used.
2943
2944 This command is mostly useful for interactive sessions.  It
2945 is I<not> intended that you try to parse the output string.
2946 Use C<statvfs> from programs.");
2947
2948   ("df_h", (RString "output", []), 126, [],
2949    [], (* XXX Tricky to test because it depends on the exact format
2950         * of the 'df' command and other imponderables.
2951         *)
2952    "report file system disk space usage (human readable)",
2953    "\
2954 This command runs the C<df -h> command to report disk space used
2955 in human-readable format.
2956
2957 This command is mostly useful for interactive sessions.  It
2958 is I<not> intended that you try to parse the output string.
2959 Use C<statvfs> from programs.");
2960
2961   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2962    [InitISOFS, Always, TestOutputInt (
2963       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2964    "estimate file space usage",
2965    "\
2966 This command runs the C<du -s> command to estimate file space
2967 usage for C<path>.
2968
2969 C<path> can be a file or a directory.  If C<path> is a directory
2970 then the estimate includes the contents of the directory and all
2971 subdirectories (recursively).
2972
2973 The result is the estimated size in I<kilobytes>
2974 (ie. units of 1024 bytes).");
2975
2976   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2977    [InitISOFS, Always, TestOutputList (
2978       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2979    "list files in an initrd",
2980    "\
2981 This command lists out files contained in an initrd.
2982
2983 The files are listed without any initial C</> character.  The
2984 files are listed in the order they appear (not necessarily
2985 alphabetical).  Directory names are listed as separate items.
2986
2987 Old Linux kernels (2.4 and earlier) used a compressed ext2
2988 filesystem as initrd.  We I<only> support the newer initramfs
2989 format (compressed cpio files).");
2990
2991   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2992    [],
2993    "mount a file using the loop device",
2994    "\
2995 This command lets you mount C<file> (a filesystem image
2996 in a file) on a mount point.  It is entirely equivalent to
2997 the command C<mount -o loop file mountpoint>.");
2998
2999   ("mkswap", (RErr, [Device "device"]), 130, [],
3000    [InitEmpty, Always, TestRun (
3001       [["part_disk"; "/dev/sda"; "mbr"];
3002        ["mkswap"; "/dev/sda1"]])],
3003    "create a swap partition",
3004    "\
3005 Create a swap partition on C<device>.");
3006
3007   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3008    [InitEmpty, Always, TestRun (
3009       [["part_disk"; "/dev/sda"; "mbr"];
3010        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3011    "create a swap partition with a label",
3012    "\
3013 Create a swap partition on C<device> with label C<label>.
3014
3015 Note that you cannot attach a swap label to a block device
3016 (eg. C</dev/sda>), just to a partition.  This appears to be
3017 a limitation of the kernel or swap tools.");
3018
3019   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3020    (let uuid = uuidgen () in
3021     [InitEmpty, Always, TestRun (
3022        [["part_disk"; "/dev/sda"; "mbr"];
3023         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3024    "create a swap partition with an explicit UUID",
3025    "\
3026 Create a swap partition on C<device> with UUID C<uuid>.");
3027
3028   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3029    [InitBasicFS, Always, TestOutputStruct (
3030       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3031        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3032        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3033     InitBasicFS, Always, TestOutputStruct (
3034       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3035        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3036    "make block, character or FIFO devices",
3037    "\
3038 This call creates block or character special devices, or
3039 named pipes (FIFOs).
3040
3041 The C<mode> parameter should be the mode, using the standard
3042 constants.  C<devmajor> and C<devminor> are the
3043 device major and minor numbers, only used when creating block
3044 and character special devices.
3045
3046 Note that, just like L<mknod(2)>, the mode must be bitwise
3047 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3048 just creates a regular file).  These constants are
3049 available in the standard Linux header files, or you can use
3050 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3051 which are wrappers around this command which bitwise OR
3052 in the appropriate constant for you.
3053
3054 The mode actually set is affected by the umask.");
3055
3056   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3057    [InitBasicFS, Always, TestOutputStruct (
3058       [["mkfifo"; "0o777"; "/node"];
3059        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3060    "make FIFO (named pipe)",
3061    "\
3062 This call creates a FIFO (named pipe) called C<path> with
3063 mode C<mode>.  It is just a convenient wrapper around
3064 C<guestfs_mknod>.
3065
3066 The mode actually set is affected by the umask.");
3067
3068   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3069    [InitBasicFS, Always, TestOutputStruct (
3070       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3071        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3072    "make block device node",
3073    "\
3074 This call creates a block device node called C<path> with
3075 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3076 It is just a convenient wrapper around C<guestfs_mknod>.
3077
3078 The mode actually set is affected by the umask.");
3079
3080   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3081    [InitBasicFS, Always, TestOutputStruct (
3082       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3083        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3084    "make char device node",
3085    "\
3086 This call creates a char device node called C<path> with
3087 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3088 It is just a convenient wrapper around C<guestfs_mknod>.
3089
3090 The mode actually set is affected by the umask.");
3091
3092   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3093    [InitEmpty, Always, TestOutputInt (
3094       [["umask"; "0o22"]], 0o22)],
3095    "set file mode creation mask (umask)",
3096    "\
3097 This function sets the mask used for creating new files and
3098 device nodes to C<mask & 0777>.
3099
3100 Typical umask values would be C<022> which creates new files
3101 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3102 C<002> which creates new files with permissions like
3103 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3104
3105 The default umask is C<022>.  This is important because it
3106 means that directories and device nodes will be created with
3107 C<0644> or C<0755> mode even if you specify C<0777>.
3108
3109 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3110
3111 This call returns the previous umask.");
3112
3113   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3114    [],
3115    "read directories entries",
3116    "\
3117 This returns the list of directory entries in directory C<dir>.
3118
3119 All entries in the directory are returned, including C<.> and
3120 C<..>.  The entries are I<not> sorted, but returned in the same
3121 order as the underlying filesystem.
3122
3123 Also this call returns basic file type information about each
3124 file.  The C<ftyp> field will contain one of the following characters:
3125
3126 =over 4
3127
3128 =item 'b'
3129
3130 Block special
3131
3132 =item 'c'
3133
3134 Char special
3135
3136 =item 'd'
3137
3138 Directory
3139
3140 =item 'f'
3141
3142 FIFO (named pipe)
3143
3144 =item 'l'
3145
3146 Symbolic link
3147
3148 =item 'r'
3149
3150 Regular file
3151
3152 =item 's'
3153
3154 Socket
3155
3156 =item 'u'
3157
3158 Unknown file type
3159
3160 =item '?'
3161
3162 The L<readdir(3)> call returned a C<d_type> field with an
3163 unexpected value
3164
3165 =back
3166
3167 This function is primarily intended for use by programs.  To
3168 get a simple list of names, use C<guestfs_ls>.  To get a printable
3169 directory for human consumption, use C<guestfs_ll>.");
3170
3171   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3172    [],
3173    "create partitions on a block device",
3174    "\
3175 This is a simplified interface to the C<guestfs_sfdisk>
3176 command, where partition sizes are specified in megabytes
3177 only (rounded to the nearest cylinder) and you don't need
3178 to specify the cyls, heads and sectors parameters which
3179 were rarely if ever used anyway.
3180
3181 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3182 and C<guestfs_part_disk>");
3183
3184   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3185    [],
3186    "determine file type inside a compressed file",
3187    "\
3188 This command runs C<file> after first decompressing C<path>
3189 using C<method>.
3190
3191 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3192
3193 Since 1.0.63, use C<guestfs_file> instead which can now
3194 process compressed files.");
3195
3196   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3197    [],
3198    "list extended attributes of a file or directory",
3199    "\
3200 This call lists the extended attributes of the file or directory
3201 C<path>.
3202
3203 At the system call level, this is a combination of the
3204 L<listxattr(2)> and L<getxattr(2)> calls.
3205
3206 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3207
3208   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3209    [],
3210    "list extended attributes of a file or directory",
3211    "\
3212 This is the same as C<guestfs_getxattrs>, but if C<path>
3213 is a symbolic link, then it returns the extended attributes
3214 of the link itself.");
3215
3216   ("setxattr", (RErr, [String "xattr";
3217                        String "val"; Int "vallen"; (* will be BufferIn *)
3218                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3219    [],
3220    "set extended attribute of a file or directory",
3221    "\
3222 This call sets the extended attribute named C<xattr>
3223 of the file C<path> to the value C<val> (of length C<vallen>).
3224 The value is arbitrary 8 bit data.
3225
3226 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3227
3228   ("lsetxattr", (RErr, [String "xattr";
3229                         String "val"; Int "vallen"; (* will be BufferIn *)
3230                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3231    [],
3232    "set extended attribute of a file or directory",
3233    "\
3234 This is the same as C<guestfs_setxattr>, but if C<path>
3235 is a symbolic link, then it sets an extended attribute
3236 of the link itself.");
3237
3238   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3239    [],
3240    "remove extended attribute of a file or directory",
3241    "\
3242 This call removes the extended attribute named C<xattr>
3243 of the file C<path>.
3244
3245 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3246
3247   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3248    [],
3249    "remove extended attribute of a file or directory",
3250    "\
3251 This is the same as C<guestfs_removexattr>, but if C<path>
3252 is a symbolic link, then it removes an extended attribute
3253 of the link itself.");
3254
3255   ("mountpoints", (RHashtable "mps", []), 147, [],
3256    [],
3257    "show mountpoints",
3258    "\
3259 This call is similar to C<guestfs_mounts>.  That call returns
3260 a list of devices.  This one returns a hash table (map) of
3261 device name to directory where the device is mounted.");
3262
3263   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3264    (* This is a special case: while you would expect a parameter
3265     * of type "Pathname", that doesn't work, because it implies
3266     * NEED_ROOT in the generated calling code in stubs.c, and
3267     * this function cannot use NEED_ROOT.
3268     *)
3269    [],
3270    "create a mountpoint",
3271    "\
3272 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3273 specialized calls that can be used to create extra mountpoints
3274 before mounting the first filesystem.
3275
3276 These calls are I<only> necessary in some very limited circumstances,
3277 mainly the case where you want to mount a mix of unrelated and/or
3278 read-only filesystems together.
3279
3280 For example, live CDs often contain a \"Russian doll\" nest of
3281 filesystems, an ISO outer layer, with a squashfs image inside, with
3282 an ext2/3 image inside that.  You can unpack this as follows
3283 in guestfish:
3284
3285  add-ro Fedora-11-i686-Live.iso
3286  run
3287  mkmountpoint /cd
3288  mkmountpoint /squash
3289  mkmountpoint /ext3
3290  mount /dev/sda /cd
3291  mount-loop /cd/LiveOS/squashfs.img /squash
3292  mount-loop /squash/LiveOS/ext3fs.img /ext3
3293
3294 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3295
3296   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3297    [],
3298    "remove a mountpoint",
3299    "\
3300 This calls removes a mountpoint that was previously created
3301 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3302 for full details.");
3303
3304   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3305    [InitISOFS, Always, TestOutputBuffer (
3306       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3307     (* Test various near large, large and too large files (RHBZ#589039). *)
3308     InitBasicFS, Always, TestLastFail (
3309       [["touch"; "/a"];
3310        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3311        ["read_file"; "/a"]]);
3312     InitBasicFS, Always, TestLastFail (
3313       [["touch"; "/a"];
3314        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3315        ["read_file"; "/a"]]);
3316     InitBasicFS, Always, TestLastFail (
3317       [["touch"; "/a"];
3318        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3319        ["read_file"; "/a"]])],
3320    "read a file",
3321    "\
3322 This calls returns the contents of the file C<path> as a
3323 buffer.
3324
3325 Unlike C<guestfs_cat>, this function can correctly
3326 handle files that contain embedded ASCII NUL characters.
3327 However unlike C<guestfs_download>, this function is limited
3328 in the total size of file that can be handled.");
3329
3330   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3331    [InitISOFS, Always, TestOutputList (
3332       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3333     InitISOFS, Always, TestOutputList (
3334       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3335    "return lines matching a pattern",
3336    "\
3337 This calls the external C<grep> program and returns the
3338 matching lines.");
3339
3340   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3341    [InitISOFS, Always, TestOutputList (
3342       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3343    "return lines matching a pattern",
3344    "\
3345 This calls the external C<egrep> program and returns the
3346 matching lines.");
3347
3348   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3349    [InitISOFS, Always, TestOutputList (
3350       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3351    "return lines matching a pattern",
3352    "\
3353 This calls the external C<fgrep> program and returns the
3354 matching lines.");
3355
3356   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3357    [InitISOFS, Always, TestOutputList (
3358       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3359    "return lines matching a pattern",
3360    "\
3361 This calls the external C<grep -i> program and returns the
3362 matching lines.");
3363
3364   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3365    [InitISOFS, Always, TestOutputList (
3366       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3367    "return lines matching a pattern",
3368    "\
3369 This calls the external C<egrep -i> program and returns the
3370 matching lines.");
3371
3372   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3373    [InitISOFS, Always, TestOutputList (
3374       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3375    "return lines matching a pattern",
3376    "\
3377 This calls the external C<fgrep -i> program and returns the
3378 matching lines.");
3379
3380   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3381    [InitISOFS, Always, TestOutputList (
3382       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3383    "return lines matching a pattern",
3384    "\
3385 This calls the external C<zgrep> program and returns the
3386 matching lines.");
3387
3388   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3389    [InitISOFS, Always, TestOutputList (
3390       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3391    "return lines matching a pattern",
3392    "\
3393 This calls the external C<zegrep> program and returns the
3394 matching lines.");
3395
3396   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3397    [InitISOFS, Always, TestOutputList (
3398       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3399    "return lines matching a pattern",
3400    "\
3401 This calls the external C<zfgrep> program and returns the
3402 matching lines.");
3403
3404   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3405    [InitISOFS, Always, TestOutputList (
3406       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3407    "return lines matching a pattern",
3408    "\
3409 This calls the external C<zgrep -i> program and returns the
3410 matching lines.");
3411
3412   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3413    [InitISOFS, Always, TestOutputList (
3414       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3415    "return lines matching a pattern",
3416    "\
3417 This calls the external C<zegrep -i> program and returns the
3418 matching lines.");
3419
3420   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3421    [InitISOFS, Always, TestOutputList (
3422       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3423    "return lines matching a pattern",
3424    "\
3425 This calls the external C<zfgrep -i> program and returns the
3426 matching lines.");
3427
3428   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3429    [InitISOFS, Always, TestOutput (
3430       [["realpath"; "/../directory"]], "/directory")],
3431    "canonicalized absolute pathname",
3432    "\
3433 Return the canonicalized absolute pathname of C<path>.  The
3434 returned path has no C<.>, C<..> or symbolic link path elements.");
3435
3436   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3437    [InitBasicFS, Always, TestOutputStruct (
3438       [["touch"; "/a"];
3439        ["ln"; "/a"; "/b"];
3440        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3441    "create a hard link",
3442    "\
3443 This command creates a hard link using the C<ln> command.");
3444
3445   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3446    [InitBasicFS, Always, TestOutputStruct (
3447       [["touch"; "/a"];
3448        ["touch"; "/b"];
3449        ["ln_f"; "/a"; "/b"];
3450        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3451    "create a hard link",
3452    "\
3453 This command creates a hard link using the C<ln -f> command.
3454 The C<-f> option removes the link (C<linkname>) if it exists already.");
3455
3456   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3457    [InitBasicFS, Always, TestOutputStruct (
3458       [["touch"; "/a"];
3459        ["ln_s"; "a"; "/b"];
3460        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3461    "create a symbolic link",
3462    "\
3463 This command creates a symbolic link using the C<ln -s> command.");
3464
3465   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3466    [InitBasicFS, Always, TestOutput (
3467       [["mkdir_p"; "/a/b"];
3468        ["touch"; "/a/b/c"];
3469        ["ln_sf"; "../d"; "/a/b/c"];
3470        ["readlink"; "/a/b/c"]], "../d")],
3471    "create a symbolic link",
3472    "\
3473 This command creates a symbolic link using the C<ln -sf> command,
3474 The C<-f> option removes the link (C<linkname>) if it exists already.");
3475
3476   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3477    [] (* XXX tested above *),
3478    "read the target of a symbolic link",
3479    "\
3480 This command reads the target of a symbolic link.");
3481
3482   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3483    [InitBasicFS, Always, TestOutputStruct (
3484       [["fallocate"; "/a"; "1000000"];
3485        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3486    "preallocate a file in the guest filesystem",
3487    "\
3488 This command preallocates a file (containing zero bytes) named
3489 C<path> of size C<len> bytes.  If the file exists already, it
3490 is overwritten.
3491
3492 Do not confuse this with the guestfish-specific
3493 C<alloc> command which allocates a file in the host and
3494 attaches it as a device.");
3495
3496   ("swapon_device", (RErr, [Device "device"]), 170, [],
3497    [InitPartition, Always, TestRun (
3498       [["mkswap"; "/dev/sda1"];
3499        ["swapon_device"; "/dev/sda1"];
3500        ["swapoff_device"; "/dev/sda1"]])],
3501    "enable swap on device",
3502    "\
3503 This command enables the libguestfs appliance to use the
3504 swap device or partition named C<device>.  The increased
3505 memory is made available for all commands, for example
3506 those run using C<guestfs_command> or C<guestfs_sh>.
3507
3508 Note that you should not swap to existing guest swap
3509 partitions unless you know what you are doing.  They may
3510 contain hibernation information, or other information that
3511 the guest doesn't want you to trash.  You also risk leaking
3512 information about the host to the guest this way.  Instead,
3513 attach a new host device to the guest and swap on that.");
3514
3515   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3516    [], (* XXX tested by swapon_device *)
3517    "disable swap on device",
3518    "\
3519 This command disables the libguestfs appliance swap
3520 device or partition named C<device>.
3521 See C<guestfs_swapon_device>.");
3522
3523   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3524    [InitBasicFS, Always, TestRun (
3525       [["fallocate"; "/swap"; "8388608"];
3526        ["mkswap_file"; "/swap"];
3527        ["swapon_file"; "/swap"];
3528        ["swapoff_file"; "/swap"]])],
3529    "enable swap on file",
3530    "\
3531 This command enables swap to a file.
3532 See C<guestfs_swapon_device> for other notes.");
3533
3534   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3535    [], (* XXX tested by swapon_file *)
3536    "disable swap on file",
3537    "\
3538 This command disables the libguestfs appliance swap on file.");
3539
3540   ("swapon_label", (RErr, [String "label"]), 174, [],
3541    [InitEmpty, Always, TestRun (
3542       [["part_disk"; "/dev/sdb"; "mbr"];
3543        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3544        ["swapon_label"; "swapit"];
3545        ["swapoff_label"; "swapit"];
3546        ["zero"; "/dev/sdb"];
3547        ["blockdev_rereadpt"; "/dev/sdb"]])],
3548    "enable swap on labeled swap partition",
3549    "\
3550 This command enables swap to a labeled swap partition.
3551 See C<guestfs_swapon_device> for other notes.");
3552
3553   ("swapoff_label", (RErr, [String "label"]), 175, [],
3554    [], (* XXX tested by swapon_label *)
3555    "disable swap on labeled swap partition",
3556    "\
3557 This command disables the libguestfs appliance swap on
3558 labeled swap partition.");
3559
3560   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3561    (let uuid = uuidgen () in
3562     [InitEmpty, Always, TestRun (
3563        [["mkswap_U"; uuid; "/dev/sdb"];
3564         ["swapon_uuid"; uuid];
3565         ["swapoff_uuid"; uuid]])]),
3566    "enable swap on swap partition by UUID",
3567    "\
3568 This command enables swap to a swap partition with the given UUID.
3569 See C<guestfs_swapon_device> for other notes.");
3570
3571   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3572    [], (* XXX tested by swapon_uuid *)
3573    "disable swap on swap partition by UUID",
3574    "\
3575 This command disables the libguestfs appliance swap partition
3576 with the given UUID.");
3577
3578   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3579    [InitBasicFS, Always, TestRun (
3580       [["fallocate"; "/swap"; "8388608"];
3581        ["mkswap_file"; "/swap"]])],
3582    "create a swap file",
3583    "\
3584 Create a swap file.
3585
3586 This command just writes a swap file signature to an existing
3587 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3588
3589   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3590    [InitISOFS, Always, TestRun (
3591       [["inotify_init"; "0"]])],
3592    "create an inotify handle",
3593    "\
3594 This command creates a new inotify handle.
3595 The inotify subsystem can be used to notify events which happen to
3596 objects in the guest filesystem.
3597
3598 C<maxevents> is the maximum number of events which will be
3599 queued up between calls to C<guestfs_inotify_read> or
3600 C<guestfs_inotify_files>.
3601 If this is passed as C<0>, then the kernel (or previously set)
3602 default is used.  For Linux 2.6.29 the default was 16384 events.
3603 Beyond this limit, the kernel throws away events, but records
3604 the fact that it threw them away by setting a flag
3605 C<IN_Q_OVERFLOW> in the returned structure list (see
3606 C<guestfs_inotify_read>).
3607
3608 Before any events are generated, you have to add some
3609 watches to the internal watch list.  See:
3610 C<guestfs_inotify_add_watch>,
3611 C<guestfs_inotify_rm_watch> and
3612 C<guestfs_inotify_watch_all>.
3613
3614 Queued up events should be read periodically by calling
3615 C<guestfs_inotify_read>
3616 (or C<guestfs_inotify_files> which is just a helpful
3617 wrapper around C<guestfs_inotify_read>).  If you don't
3618 read the events out often enough then you risk the internal
3619 queue overflowing.
3620
3621 The handle should be closed after use by calling
3622 C<guestfs_inotify_close>.  This also removes any
3623 watches automatically.
3624
3625 See also L<inotify(7)> for an overview of the inotify interface
3626 as exposed by the Linux kernel, which is roughly what we expose
3627 via libguestfs.  Note that there is one global inotify handle
3628 per libguestfs instance.");
3629
3630   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3631    [InitBasicFS, Always, TestOutputList (
3632       [["inotify_init"; "0"];
3633        ["inotify_add_watch"; "/"; "1073741823"];
3634        ["touch"; "/a"];
3635        ["touch"; "/b"];
3636        ["inotify_files"]], ["a"; "b"])],
3637    "add an inotify watch",
3638    "\
3639 Watch C<path> for the events listed in C<mask>.
3640
3641 Note that if C<path> is a directory then events within that
3642 directory are watched, but this does I<not> happen recursively
3643 (in subdirectories).
3644
3645 Note for non-C or non-Linux callers: the inotify events are
3646 defined by the Linux kernel ABI and are listed in
3647 C</usr/include/sys/inotify.h>.");
3648
3649   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3650    [],
3651    "remove an inotify watch",
3652    "\
3653 Remove a previously defined inotify watch.
3654 See C<guestfs_inotify_add_watch>.");
3655
3656   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3657    [],
3658    "return list of inotify events",
3659    "\
3660 Return the complete queue of events that have happened
3661 since the previous read call.
3662
3663 If no events have happened, this returns an empty list.
3664
3665 I<Note>: In order to make sure that all events have been
3666 read, you must call this function repeatedly until it
3667 returns an empty list.  The reason is that the call will
3668 read events up to the maximum appliance-to-host message
3669 size and leave remaining events in the queue.");
3670
3671   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3672    [],
3673    "return list of watched files that had events",
3674    "\
3675 This function is a helpful wrapper around C<guestfs_inotify_read>
3676 which just returns a list of pathnames of objects that were
3677 touched.  The returned pathnames are sorted and deduplicated.");
3678
3679   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3680    [],
3681    "close the inotify handle",
3682    "\
3683 This closes the inotify handle which was previously
3684 opened by inotify_init.  It removes all watches, throws
3685 away any pending events, and deallocates all resources.");
3686
3687   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3688    [],
3689    "set SELinux security context",
3690    "\
3691 This sets the SELinux security context of the daemon
3692 to the string C<context>.
3693
3694 See the documentation about SELINUX in L<guestfs(3)>.");
3695
3696   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3697    [],
3698    "get SELinux security context",
3699    "\
3700 This gets the SELinux security context of the daemon.
3701
3702 See the documentation about SELINUX in L<guestfs(3)>,
3703 and C<guestfs_setcon>");
3704
3705   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3706    [InitEmpty, Always, TestOutput (
3707       [["part_disk"; "/dev/sda"; "mbr"];
3708        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3709        ["mount_options"; ""; "/dev/sda1"; "/"];
3710        ["write_file"; "/new"; "new file contents"; "0"];
3711        ["cat"; "/new"]], "new file contents")],
3712    "make a filesystem with block size",
3713    "\
3714 This call is similar to C<guestfs_mkfs>, but it allows you to
3715 control the block size of the resulting filesystem.  Supported
3716 block sizes depend on the filesystem type, but typically they
3717 are C<1024>, C<2048> or C<4096> only.");
3718
3719   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3720    [InitEmpty, Always, TestOutput (
3721       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3722        ["mke2journal"; "4096"; "/dev/sda1"];
3723        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3724        ["mount_options"; ""; "/dev/sda2"; "/"];
3725        ["write_file"; "/new"; "new file contents"; "0"];
3726        ["cat"; "/new"]], "new file contents")],
3727    "make ext2/3/4 external journal",
3728    "\
3729 This creates an ext2 external journal on C<device>.  It is equivalent
3730 to the command:
3731
3732  mke2fs -O journal_dev -b blocksize device");
3733
3734   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3735    [InitEmpty, Always, TestOutput (
3736       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3737        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3738        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3739        ["mount_options"; ""; "/dev/sda2"; "/"];
3740        ["write_file"; "/new"; "new file contents"; "0"];
3741        ["cat"; "/new"]], "new file contents")],
3742    "make ext2/3/4 external journal with label",
3743    "\
3744 This creates an ext2 external journal on C<device> with label C<label>.");
3745
3746   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3747    (let uuid = uuidgen () in
3748     [InitEmpty, Always, TestOutput (
3749        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3750         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3751         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3752         ["mount_options"; ""; "/dev/sda2"; "/"];
3753         ["write_file"; "/new"; "new file contents"; "0"];
3754         ["cat"; "/new"]], "new file contents")]),
3755    "make ext2/3/4 external journal with UUID",
3756    "\
3757 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3758
3759   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3760    [],
3761    "make ext2/3/4 filesystem with external journal",
3762    "\
3763 This creates an ext2/3/4 filesystem on C<device> with
3764 an external journal on C<journal>.  It is equivalent
3765 to the command:
3766
3767  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3768
3769 See also C<guestfs_mke2journal>.");
3770
3771   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3772    [],
3773    "make ext2/3/4 filesystem with external journal",
3774    "\
3775 This creates an ext2/3/4 filesystem on C<device> with
3776 an external journal on the journal labeled C<label>.
3777
3778 See also C<guestfs_mke2journal_L>.");
3779
3780   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3781    [],
3782    "make ext2/3/4 filesystem with external journal",
3783    "\
3784 This creates an ext2/3/4 filesystem on C<device> with
3785 an external journal on the journal with UUID C<uuid>.
3786
3787 See also C<guestfs_mke2journal_U>.");
3788
3789   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3790    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3791    "load a kernel module",
3792    "\
3793 This loads a kernel module in the appliance.
3794
3795 The kernel module must have been whitelisted when libguestfs
3796 was built (see C<appliance/kmod.whitelist.in> in the source).");
3797
3798   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3799    [InitNone, Always, TestOutput (
3800       [["echo_daemon"; "This is a test"]], "This is a test"
3801     )],
3802    "echo arguments back to the client",
3803    "\
3804 This command concatenates the list of C<words> passed with single spaces
3805 between them and returns the resulting string.
3806
3807 You can use this command to test the connection through to the daemon.
3808
3809 See also C<guestfs_ping_daemon>.");
3810
3811   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3812    [], (* There is a regression test for this. *)
3813    "find all files and directories, returning NUL-separated list",
3814    "\
3815 This command lists out all files and directories, recursively,
3816 starting at C<directory>, placing the resulting list in the
3817 external file called C<files>.
3818
3819 This command works the same way as C<guestfs_find> with the
3820 following exceptions:
3821
3822 =over 4
3823
3824 =item *
3825
3826 The resulting list is written to an external file.
3827
3828 =item *
3829
3830 Items (filenames) in the result are separated
3831 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3832
3833 =item *
3834
3835 This command is not limited in the number of names that it
3836 can return.
3837
3838 =item *
3839
3840 The result list is not sorted.
3841
3842 =back");
3843
3844   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3845    [InitISOFS, Always, TestOutput (
3846       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3847     InitISOFS, Always, TestOutput (
3848       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3849     InitISOFS, Always, TestOutput (
3850       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3851     InitISOFS, Always, TestLastFail (
3852       [["case_sensitive_path"; "/Known-1/"]]);
3853     InitBasicFS, Always, TestOutput (
3854       [["mkdir"; "/a"];
3855        ["mkdir"; "/a/bbb"];
3856        ["touch"; "/a/bbb/c"];
3857        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3858     InitBasicFS, Always, TestOutput (
3859       [["mkdir"; "/a"];
3860        ["mkdir"; "/a/bbb"];
3861        ["touch"; "/a/bbb/c"];
3862        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3863     InitBasicFS, Always, TestLastFail (
3864       [["mkdir"; "/a"];
3865        ["mkdir"; "/a/bbb"];
3866        ["touch"; "/a/bbb/c"];
3867        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3868    "return true path on case-insensitive filesystem",
3869    "\
3870 This can be used to resolve case insensitive paths on
3871 a filesystem which is case sensitive.  The use case is
3872 to resolve paths which you have read from Windows configuration
3873 files or the Windows Registry, to the true path.
3874
3875 The command handles a peculiarity of the Linux ntfs-3g
3876 filesystem driver (and probably others), which is that although
3877 the underlying filesystem is case-insensitive, the driver
3878 exports the filesystem to Linux as case-sensitive.
3879
3880 One consequence of this is that special directories such
3881 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3882 (or other things) depending on the precise details of how
3883 they were created.  In Windows itself this would not be
3884 a problem.
3885
3886 Bug or feature?  You decide:
3887 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3888
3889 This function resolves the true case of each element in the
3890 path and returns the case-sensitive path.
3891
3892 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3893 might return C<\"/WINDOWS/system32\"> (the exact return value
3894 would depend on details of how the directories were originally
3895 created under Windows).
3896
3897 I<Note>:
3898 This function does not handle drive names, backslashes etc.
3899
3900 See also C<guestfs_realpath>.");
3901
3902   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3903    [InitBasicFS, Always, TestOutput (
3904       [["vfs_type"; "/dev/sda1"]], "ext2")],
3905    "get the Linux VFS type corresponding to a mounted device",
3906    "\
3907 This command gets the filesystem type corresponding to
3908 the filesystem on C<device>.
3909
3910 For most filesystems, the result is the name of the Linux
3911 VFS module which would be used to mount this filesystem
3912 if you mounted it without specifying the filesystem type.
3913 For example a string such as C<ext3> or C<ntfs>.");
3914
3915   ("truncate", (RErr, [Pathname "path"]), 199, [],
3916    [InitBasicFS, Always, TestOutputStruct (
3917       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3918        ["truncate"; "/test"];
3919        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3920    "truncate a file to zero size",
3921    "\
3922 This command truncates C<path> to a zero-length file.  The
3923 file must exist already.");
3924
3925   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3926    [InitBasicFS, Always, TestOutputStruct (
3927       [["touch"; "/test"];
3928        ["truncate_size"; "/test"; "1000"];
3929        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3930    "truncate a file to a particular size",
3931    "\
3932 This command truncates C<path> to size C<size> bytes.  The file
3933 must exist already.
3934
3935 If the current file size is less than C<size> then
3936 the file is extended to the required size with zero bytes.
3937 This creates a sparse file (ie. disk blocks are not allocated
3938 for the file until you write to it).  To create a non-sparse
3939 file of zeroes, use C<guestfs_fallocate64> instead.");
3940
3941   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3942    [InitBasicFS, Always, TestOutputStruct (
3943       [["touch"; "/test"];
3944        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3945        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3946    "set timestamp of a file with nanosecond precision",
3947    "\
3948 This command sets the timestamps of a file with nanosecond
3949 precision.
3950
3951 C<atsecs, atnsecs> are the last access time (atime) in secs and
3952 nanoseconds from the epoch.
3953
3954 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3955 secs and nanoseconds from the epoch.
3956
3957 If the C<*nsecs> field contains the special value C<-1> then
3958 the corresponding timestamp is set to the current time.  (The
3959 C<*secs> field is ignored in this case).
3960
3961 If the C<*nsecs> field contains the special value C<-2> then
3962 the corresponding timestamp is left unchanged.  (The
3963 C<*secs> field is ignored in this case).");
3964
3965   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3966    [InitBasicFS, Always, TestOutputStruct (
3967       [["mkdir_mode"; "/test"; "0o111"];
3968        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3969    "create a directory with a particular mode",
3970    "\
3971 This command creates a directory, setting the initial permissions
3972 of the directory to C<mode>.
3973
3974 For common Linux filesystems, the actual mode which is set will
3975 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3976 interpret the mode in other ways.
3977
3978 See also C<guestfs_mkdir>, C<guestfs_umask>");
3979
3980   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3981    [], (* XXX *)
3982    "change file owner and group",
3983    "\
3984 Change the file owner to C<owner> and group to C<group>.
3985 This is like C<guestfs_chown> but if C<path> is a symlink then
3986 the link itself is changed, not the target.
3987
3988 Only numeric uid and gid are supported.  If you want to use
3989 names, you will need to locate and parse the password file
3990 yourself (Augeas support makes this relatively easy).");
3991
3992   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3993    [], (* XXX *)
3994    "lstat on multiple files",
3995    "\
3996 This call allows you to perform the C<guestfs_lstat> operation
3997 on multiple files, where all files are in the directory C<path>.
3998 C<names> is the list of files from this directory.
3999
4000 On return you get a list of stat structs, with a one-to-one
4001 correspondence to the C<names> list.  If any name did not exist
4002 or could not be lstat'd, then the C<ino> field of that structure
4003 is set to C<-1>.
4004
4005 This call is intended for programs that want to efficiently
4006 list a directory contents without making many round-trips.
4007 See also C<guestfs_lxattrlist> for a similarly efficient call
4008 for getting extended attributes.  Very long directory listings
4009 might cause the protocol message size to be exceeded, causing
4010 this call to fail.  The caller must split up such requests
4011 into smaller groups of names.");
4012
4013   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4014    [], (* XXX *)
4015    "lgetxattr on multiple files",
4016    "\
4017 This call allows you to get the extended attributes
4018 of multiple files, where all files are in the directory C<path>.
4019 C<names> is the list of files from this directory.
4020
4021 On return you get a flat list of xattr structs which must be
4022 interpreted sequentially.  The first xattr struct always has a zero-length
4023 C<attrname>.  C<attrval> in this struct is zero-length
4024 to indicate there was an error doing C<lgetxattr> for this
4025 file, I<or> is a C string which is a decimal number
4026 (the number of following attributes for this file, which could
4027 be C<\"0\">).  Then after the first xattr struct are the
4028 zero or more attributes for the first named file.
4029 This repeats for the second and subsequent files.
4030
4031 This call is intended for programs that want to efficiently
4032 list a directory contents without making many round-trips.
4033 See also C<guestfs_lstatlist> for a similarly efficient call
4034 for getting standard stats.  Very long directory listings
4035 might cause the protocol message size to be exceeded, causing
4036 this call to fail.  The caller must split up such requests
4037 into smaller groups of names.");
4038
4039   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4040    [], (* XXX *)
4041    "readlink on multiple files",
4042    "\
4043 This call allows you to do a C<readlink> operation
4044 on multiple files, where all files are in the directory C<path>.
4045 C<names> is the list of files from this directory.
4046
4047 On return you get a list of strings, with a one-to-one
4048 correspondence to the C<names> list.  Each string is the
4049 value of the symbolic link.
4050
4051 If the C<readlink(2)> operation fails on any name, then
4052 the corresponding result string is the empty string C<\"\">.
4053 However the whole operation is completed even if there
4054 were C<readlink(2)> errors, and so you can call this
4055 function with names where you don't know if they are
4056 symbolic links already (albeit slightly less efficient).
4057
4058 This call is intended for programs that want to efficiently
4059 list a directory contents without making many round-trips.
4060 Very long directory listings might cause the protocol
4061 message size to be exceeded, causing
4062 this call to fail.  The caller must split up such requests
4063 into smaller groups of names.");
4064
4065   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4066    [InitISOFS, Always, TestOutputBuffer (
4067       [["pread"; "/known-4"; "1"; "3"]], "\n");
4068     InitISOFS, Always, TestOutputBuffer (
4069       [["pread"; "/empty"; "0"; "100"]], "")],
4070    "read part of a file",
4071    "\
4072 This command lets you read part of a file.  It reads C<count>
4073 bytes of the file, starting at C<offset>, from file C<path>.
4074
4075 This may read fewer bytes than requested.  For further details
4076 see the L<pread(2)> system call.");
4077
4078   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4079    [InitEmpty, Always, TestRun (
4080       [["part_init"; "/dev/sda"; "gpt"]])],
4081    "create an empty partition table",
4082    "\
4083 This creates an empty partition table on C<device> of one of the
4084 partition types listed below.  Usually C<parttype> should be
4085 either C<msdos> or C<gpt> (for large disks).
4086
4087 Initially there are no partitions.  Following this, you should
4088 call C<guestfs_part_add> for each partition required.
4089
4090 Possible values for C<parttype> are:
4091
4092 =over 4
4093
4094 =item B<efi> | B<gpt>
4095
4096 Intel EFI / GPT partition table.
4097
4098 This is recommended for >= 2 TB partitions that will be accessed
4099 from Linux and Intel-based Mac OS X.  It also has limited backwards
4100 compatibility with the C<mbr> format.
4101
4102 =item B<mbr> | B<msdos>
4103
4104 The standard PC \"Master Boot Record\" (MBR) format used
4105 by MS-DOS and Windows.  This partition type will B<only> work
4106 for device sizes up to 2 TB.  For large disks we recommend
4107 using C<gpt>.
4108
4109 =back
4110
4111 Other partition table types that may work but are not
4112 supported include:
4113
4114 =over 4
4115
4116 =item B<aix>
4117
4118 AIX disk labels.
4119
4120 =item B<amiga> | B<rdb>
4121
4122 Amiga \"Rigid Disk Block\" format.
4123
4124 =item B<bsd>
4125
4126 BSD disk labels.
4127
4128 =item B<dasd>
4129
4130 DASD, used on IBM mainframes.
4131
4132 =item B<dvh>
4133
4134 MIPS/SGI volumes.
4135
4136 =item B<mac>
4137
4138 Old Mac partition format.  Modern Macs use C<gpt>.
4139
4140 =item B<pc98>
4141
4142 NEC PC-98 format, common in Japan apparently.
4143
4144 =item B<sun>
4145
4146 Sun disk labels.
4147
4148 =back");
4149
4150   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4151    [InitEmpty, Always, TestRun (
4152       [["part_init"; "/dev/sda"; "mbr"];
4153        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4154     InitEmpty, Always, TestRun (
4155       [["part_init"; "/dev/sda"; "gpt"];
4156        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4157        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4158     InitEmpty, Always, TestRun (
4159       [["part_init"; "/dev/sda"; "mbr"];
4160        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4161        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4162        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4163        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4164    "add a partition to the device",
4165    "\
4166 This command adds a partition to C<device>.  If there is no partition
4167 table on the device, call C<guestfs_part_init> first.
4168
4169 The C<prlogex> parameter is the type of partition.  Normally you
4170 should pass C<p> or C<primary> here, but MBR partition tables also
4171 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4172 types.
4173
4174 C<startsect> and C<endsect> are the start and end of the partition
4175 in I<sectors>.  C<endsect> may be negative, which means it counts
4176 backwards from the end of the disk (C<-1> is the last sector).
4177
4178 Creating a partition which covers the whole disk is not so easy.
4179 Use C<guestfs_part_disk> to do that.");
4180
4181   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4182    [InitEmpty, Always, TestRun (
4183       [["part_disk"; "/dev/sda"; "mbr"]]);
4184     InitEmpty, Always, TestRun (
4185       [["part_disk"; "/dev/sda"; "gpt"]])],
4186    "partition whole disk with a single primary partition",
4187    "\
4188 This command is simply a combination of C<guestfs_part_init>
4189 followed by C<guestfs_part_add> to create a single primary partition
4190 covering the whole disk.
4191
4192 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4193 but other possible values are described in C<guestfs_part_init>.");
4194
4195   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4196    [InitEmpty, Always, TestRun (
4197       [["part_disk"; "/dev/sda"; "mbr"];
4198        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4199    "make a partition bootable",
4200    "\
4201 This sets the bootable flag on partition numbered C<partnum> on
4202 device C<device>.  Note that partitions are numbered from 1.
4203
4204 The bootable flag is used by some operating systems (notably
4205 Windows) to determine which partition to boot from.  It is by
4206 no means universally recognized.");
4207
4208   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4209    [InitEmpty, Always, TestRun (
4210       [["part_disk"; "/dev/sda"; "gpt"];
4211        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4212    "set partition name",
4213    "\
4214 This sets the partition name on partition numbered C<partnum> on
4215 device C<device>.  Note that partitions are numbered from 1.
4216
4217 The partition name can only be set on certain types of partition
4218 table.  This works on C<gpt> but not on C<mbr> partitions.");
4219
4220   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4221    [], (* XXX Add a regression test for this. *)
4222    "list partitions on a device",
4223    "\
4224 This command parses the partition table on C<device> and
4225 returns the list of partitions found.
4226
4227 The fields in the returned structure are:
4228
4229 =over 4
4230
4231 =item B<part_num>
4232
4233 Partition number, counting from 1.
4234
4235 =item B<part_start>
4236
4237 Start of the partition I<in bytes>.  To get sectors you have to
4238 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4239
4240 =item B<part_end>
4241
4242 End of the partition in bytes.
4243
4244 =item B<part_size>
4245
4246 Size of the partition in bytes.
4247
4248 =back");
4249
4250   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4251    [InitEmpty, Always, TestOutput (
4252       [["part_disk"; "/dev/sda"; "gpt"];
4253        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4254    "get the partition table type",
4255    "\
4256 This command examines the partition table on C<device> and
4257 returns the partition table type (format) being used.
4258
4259 Common return values include: C<msdos> (a DOS/Windows style MBR
4260 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4261 values are possible, although unusual.  See C<guestfs_part_init>
4262 for a full list.");
4263
4264   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4265    [InitBasicFS, Always, TestOutputBuffer (
4266       [["fill"; "0x63"; "10"; "/test"];
4267        ["read_file"; "/test"]], "cccccccccc")],
4268    "fill a file with octets",
4269    "\
4270 This command creates a new file called C<path>.  The initial
4271 content of the file is C<len> octets of C<c>, where C<c>
4272 must be a number in the range C<[0..255]>.
4273
4274 To fill a file with zero bytes (sparsely), it is
4275 much more efficient to use C<guestfs_truncate_size>.");
4276
4277   ("available", (RErr, [StringList "groups"]), 216, [],
4278    [InitNone, Always, TestRun [["available"; ""]]],
4279    "test availability of some parts of the API",
4280    "\
4281 This command is used to check the availability of some
4282 groups of functionality in the appliance, which not all builds of
4283 the libguestfs appliance will be able to provide.
4284
4285 The libguestfs groups, and the functions that those
4286 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4287
4288 The argument C<groups> is a list of group names, eg:
4289 C<[\"inotify\", \"augeas\"]> would check for the availability of
4290 the Linux inotify functions and Augeas (configuration file
4291 editing) functions.
4292
4293 The command returns no error if I<all> requested groups are available.
4294
4295 It fails with an error if one or more of the requested
4296 groups is unavailable in the appliance.
4297
4298 If an unknown group name is included in the
4299 list of groups then an error is always returned.
4300
4301 I<Notes:>
4302
4303 =over 4
4304
4305 =item *
4306
4307 You must call C<guestfs_launch> before calling this function.
4308
4309 The reason is because we don't know what groups are
4310 supported by the appliance/daemon until it is running and can
4311 be queried.
4312
4313 =item *
4314
4315 If a group of functions is available, this does not necessarily
4316 mean that they will work.  You still have to check for errors
4317 when calling individual API functions even if they are
4318 available.
4319
4320 =item *
4321
4322 It is usually the job of distro packagers to build
4323 complete functionality into the libguestfs appliance.
4324 Upstream libguestfs, if built from source with all
4325 requirements satisfied, will support everything.
4326
4327 =item *
4328
4329 This call was added in version C<1.0.80>.  In previous
4330 versions of libguestfs all you could do would be to speculatively
4331 execute a command to find out if the daemon implemented it.
4332 See also C<guestfs_version>.
4333
4334 =back");
4335
4336   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4337    [InitBasicFS, Always, TestOutputBuffer (
4338       [["write_file"; "/src"; "hello, world"; "0"];
4339        ["dd"; "/src"; "/dest"];
4340        ["read_file"; "/dest"]], "hello, world")],
4341    "copy from source to destination using dd",
4342    "\
4343 This command copies from one source device or file C<src>
4344 to another destination device or file C<dest>.  Normally you
4345 would use this to copy to or from a device or partition, for
4346 example to duplicate a filesystem.
4347
4348 If the destination is a device, it must be as large or larger
4349 than the source file or device, otherwise the copy will fail.
4350 This command cannot do partial copies (see C<guestfs_copy_size>).");
4351
4352   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4353    [InitBasicFS, Always, TestOutputInt (
4354       [["write_file"; "/file"; "hello, world"; "0"];
4355        ["filesize"; "/file"]], 12)],
4356    "return the size of the file in bytes",
4357    "\
4358 This command returns the size of C<file> in bytes.
4359
4360 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4361 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4362 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4363
4364   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4365    [InitBasicFSonLVM, Always, TestOutputList (
4366       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4367        ["lvs"]], ["/dev/VG/LV2"])],
4368    "rename an LVM logical volume",
4369    "\
4370 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4371
4372   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4373    [InitBasicFSonLVM, Always, TestOutputList (
4374       [["umount"; "/"];
4375        ["vg_activate"; "false"; "VG"];
4376        ["vgrename"; "VG"; "VG2"];
4377        ["vg_activate"; "true"; "VG2"];
4378        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4379        ["vgs"]], ["VG2"])],
4380    "rename an LVM volume group",
4381    "\
4382 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4383
4384   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4385    [InitISOFS, Always, TestOutputBuffer (
4386       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4387    "list the contents of a single file in an initrd",
4388    "\
4389 This command unpacks the file C<filename> from the initrd file
4390 called C<initrdpath>.  The filename must be given I<without> the
4391 initial C</> character.
4392
4393 For example, in guestfish you could use the following command
4394 to examine the boot script (usually called C</init>)
4395 contained in a Linux initrd or initramfs image:
4396
4397  initrd-cat /boot/initrd-<version>.img init
4398
4399 See also C<guestfs_initrd_list>.");
4400
4401   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4402    [],
4403    "get the UUID of a physical volume",
4404    "\
4405 This command returns the UUID of the LVM PV C<device>.");
4406
4407   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4408    [],
4409    "get the UUID of a volume group",
4410    "\
4411 This command returns the UUID of the LVM VG named C<vgname>.");
4412
4413   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4414    [],
4415    "get the UUID of a logical volume",
4416    "\
4417 This command returns the UUID of the LVM LV C<device>.");
4418
4419   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4420    [],
4421    "get the PV UUIDs containing the volume group",
4422    "\
4423 Given a VG called C<vgname>, this returns the UUIDs of all
4424 the physical volumes that this volume group resides on.
4425
4426 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4427 calls to associate physical volumes and volume groups.
4428
4429 See also C<guestfs_vglvuuids>.");
4430
4431   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4432    [],
4433    "get the LV UUIDs of all LVs in the volume group",
4434    "\
4435 Given a VG called C<vgname>, this returns the UUIDs of all
4436 the logical volumes created in this volume group.
4437
4438 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4439 calls to associate logical volumes and volume groups.
4440
4441 See also C<guestfs_vgpvuuids>.");
4442
4443   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4444    [InitBasicFS, Always, TestOutputBuffer (
4445       [["write_file"; "/src"; "hello, world"; "0"];
4446        ["copy_size"; "/src"; "/dest"; "5"];
4447        ["read_file"; "/dest"]], "hello")],
4448    "copy size bytes from source to destination using dd",
4449    "\
4450 This command copies exactly C<size> bytes from one source device
4451 or file C<src> to another destination device or file C<dest>.
4452
4453 Note this will fail if the source is too short or if the destination
4454 is not large enough.");
4455
4456   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4457    [InitEmpty, Always, TestRun (
4458       [["part_init"; "/dev/sda"; "mbr"];
4459        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4460        ["part_del"; "/dev/sda"; "1"]])],
4461    "delete a partition",
4462    "\
4463 This command deletes the partition numbered C<partnum> on C<device>.
4464
4465 Note that in the case of MBR partitioning, deleting an
4466 extended partition also deletes any logical partitions
4467 it contains.");
4468
4469   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4470    [InitEmpty, Always, TestOutputTrue (
4471       [["part_init"; "/dev/sda"; "mbr"];
4472        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4473        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4474        ["part_get_bootable"; "/dev/sda"; "1"]])],
4475    "return true if a partition is bootable",
4476    "\
4477 This command returns true if the partition C<partnum> on
4478 C<device> has the bootable flag set.
4479
4480 See also C<guestfs_part_set_bootable>.");
4481
4482   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4483    [InitEmpty, Always, TestOutputInt (
4484       [["part_init"; "/dev/sda"; "mbr"];
4485        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4486        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4487        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4488    "get the MBR type byte (ID byte) from a partition",
4489    "\
4490 Returns the MBR type byte (also known as the ID byte) from
4491 the numbered partition C<partnum>.
4492
4493 Note that only MBR (old DOS-style) partitions have type bytes.
4494 You will get undefined results for other partition table
4495 types (see C<guestfs_part_get_parttype>).");
4496
4497   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4498    [], (* tested by part_get_mbr_id *)
4499    "set the MBR type byte (ID byte) of a partition",
4500    "\
4501 Sets the MBR type byte (also known as the ID byte) of
4502 the numbered partition C<partnum> to C<idbyte>.  Note
4503 that the type bytes quoted in most documentation are
4504 in fact hexadecimal numbers, but usually documented
4505 without any leading \"0x\" which might be confusing.
4506
4507 Note that only MBR (old DOS-style) partitions have type bytes.
4508 You will get undefined results for other partition table
4509 types (see C<guestfs_part_get_parttype>).");
4510
4511 ]
4512
4513 let all_functions = non_daemon_functions @ daemon_functions
4514
4515 (* In some places we want the functions to be displayed sorted
4516  * alphabetically, so this is useful:
4517  *)
4518 let all_functions_sorted =
4519   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4520                compare n1 n2) all_functions
4521
4522 (* Field types for structures. *)
4523 type field =
4524   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4525   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4526   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4527   | FUInt32
4528   | FInt32
4529   | FUInt64
4530   | FInt64
4531   | FBytes                      (* Any int measure that counts bytes. *)
4532   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4533   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4534
4535 (* Because we generate extra parsing code for LVM command line tools,
4536  * we have to pull out the LVM columns separately here.
4537  *)
4538 let lvm_pv_cols = [
4539   "pv_name", FString;
4540   "pv_uuid", FUUID;
4541   "pv_fmt", FString;
4542   "pv_size", FBytes;
4543   "dev_size", FBytes;
4544   "pv_free", FBytes;
4545   "pv_used", FBytes;
4546   "pv_attr", FString (* XXX *);
4547   "pv_pe_count", FInt64;
4548   "pv_pe_alloc_count", FInt64;
4549   "pv_tags", FString;
4550   "pe_start", FBytes;
4551   "pv_mda_count", FInt64;
4552   "pv_mda_free", FBytes;
4553   (* Not in Fedora 10:
4554      "pv_mda_size", FBytes;
4555   *)
4556 ]
4557 let lvm_vg_cols = [
4558   "vg_name", FString;
4559   "vg_uuid", FUUID;
4560   "vg_fmt", FString;
4561   "vg_attr", FString (* XXX *);
4562   "vg_size", FBytes;
4563   "vg_free", FBytes;
4564   "vg_sysid", FString;
4565   "vg_extent_size", FBytes;
4566   "vg_extent_count", FInt64;
4567   "vg_free_count", FInt64;
4568   "max_lv", FInt64;
4569   "max_pv", FInt64;
4570   "pv_count", FInt64;
4571   "lv_count", FInt64;
4572   "snap_count", FInt64;
4573   "vg_seqno", FInt64;
4574   "vg_tags", FString;
4575   "vg_mda_count", FInt64;
4576   "vg_mda_free", FBytes;
4577   (* Not in Fedora 10:
4578      "vg_mda_size", FBytes;
4579   *)
4580 ]
4581 let lvm_lv_cols = [
4582   "lv_name", FString;
4583   "lv_uuid", FUUID;
4584   "lv_attr", FString (* XXX *);
4585   "lv_major", FInt64;
4586   "lv_minor", FInt64;
4587   "lv_kernel_major", FInt64;
4588   "lv_kernel_minor", FInt64;
4589   "lv_size", FBytes;
4590   "seg_count", FInt64;
4591   "origin", FString;
4592   "snap_percent", FOptPercent;
4593   "copy_percent", FOptPercent;
4594   "move_pv", FString;
4595   "lv_tags", FString;
4596   "mirror_log", FString;
4597   "modules", FString;
4598 ]
4599
4600 (* Names and fields in all structures (in RStruct and RStructList)
4601  * that we support.
4602  *)
4603 let structs = [
4604   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4605    * not use this struct in any new code.
4606    *)
4607   "int_bool", [
4608     "i", FInt32;                (* for historical compatibility *)
4609     "b", FInt32;                (* for historical compatibility *)
4610   ];
4611
4612   (* LVM PVs, VGs, LVs. *)
4613   "lvm_pv", lvm_pv_cols;
4614   "lvm_vg", lvm_vg_cols;
4615   "lvm_lv", lvm_lv_cols;
4616
4617   (* Column names and types from stat structures.
4618    * NB. Can't use things like 'st_atime' because glibc header files
4619    * define some of these as macros.  Ugh.
4620    *)
4621   "stat", [
4622     "dev", FInt64;
4623     "ino", FInt64;
4624     "mode", FInt64;
4625     "nlink", FInt64;
4626     "uid", FInt64;
4627     "gid", FInt64;
4628     "rdev", FInt64;
4629     "size", FInt64;
4630     "blksize", FInt64;
4631     "blocks", FInt64;
4632     "atime", FInt64;
4633     "mtime", FInt64;
4634     "ctime", FInt64;
4635   ];
4636   "statvfs", [
4637     "bsize", FInt64;
4638     "frsize", FInt64;
4639     "blocks", FInt64;
4640     "bfree", FInt64;
4641     "bavail", FInt64;
4642     "files", FInt64;
4643     "ffree", FInt64;
4644     "favail", FInt64;
4645     "fsid", FInt64;
4646     "flag", FInt64;
4647     "namemax", FInt64;
4648   ];
4649
4650   (* Column names in dirent structure. *)
4651   "dirent", [
4652     "ino", FInt64;
4653     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4654     "ftyp", FChar;
4655     "name", FString;
4656   ];
4657
4658   (* Version numbers. *)
4659   "version", [
4660     "major", FInt64;
4661     "minor", FInt64;
4662     "release", FInt64;
4663     "extra", FString;
4664   ];
4665
4666   (* Extended attribute. *)
4667   "xattr", [
4668     "attrname", FString;
4669     "attrval", FBuffer;
4670   ];
4671
4672   (* Inotify events. *)
4673   "inotify_event", [
4674     "in_wd", FInt64;
4675     "in_mask", FUInt32;
4676     "in_cookie", FUInt32;
4677     "in_name", FString;
4678   ];
4679
4680   (* Partition table entry. *)
4681   "partition", [
4682     "part_num", FInt32;
4683     "part_start", FBytes;
4684     "part_end", FBytes;
4685     "part_size", FBytes;
4686   ];
4687 ] (* end of structs *)
4688
4689 (* Ugh, Java has to be different ..
4690  * These names are also used by the Haskell bindings.
4691  *)
4692 let java_structs = [
4693   "int_bool", "IntBool";
4694   "lvm_pv", "PV";
4695   "lvm_vg", "VG";
4696   "lvm_lv", "LV";
4697   "stat", "Stat";
4698   "statvfs", "StatVFS";
4699   "dirent", "Dirent";
4700   "version", "Version";
4701   "xattr", "XAttr";
4702   "inotify_event", "INotifyEvent";
4703   "partition", "Partition";
4704 ]
4705
4706 (* What structs are actually returned. *)
4707 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4708
4709 (* Returns a list of RStruct/RStructList structs that are returned
4710  * by any function.  Each element of returned list is a pair:
4711  *
4712  * (structname, RStructOnly)
4713  *    == there exists function which returns RStruct (_, structname)
4714  * (structname, RStructListOnly)
4715  *    == there exists function which returns RStructList (_, structname)
4716  * (structname, RStructAndList)
4717  *    == there are functions returning both RStruct (_, structname)
4718  *                                      and RStructList (_, structname)
4719  *)
4720 let rstructs_used_by functions =
4721   (* ||| is a "logical OR" for rstructs_used_t *)
4722   let (|||) a b =
4723     match a, b with
4724     | RStructAndList, _
4725     | _, RStructAndList -> RStructAndList
4726     | RStructOnly, RStructListOnly
4727     | RStructListOnly, RStructOnly -> RStructAndList
4728     | RStructOnly, RStructOnly -> RStructOnly
4729     | RStructListOnly, RStructListOnly -> RStructListOnly
4730   in
4731
4732   let h = Hashtbl.create 13 in
4733
4734   (* if elem->oldv exists, update entry using ||| operator,
4735    * else just add elem->newv to the hash
4736    *)
4737   let update elem newv =
4738     try  let oldv = Hashtbl.find h elem in
4739          Hashtbl.replace h elem (newv ||| oldv)
4740     with Not_found -> Hashtbl.add h elem newv
4741   in
4742
4743   List.iter (
4744     fun (_, style, _, _, _, _, _) ->
4745       match fst style with
4746       | RStruct (_, structname) -> update structname RStructOnly
4747       | RStructList (_, structname) -> update structname RStructListOnly
4748       | _ -> ()
4749   ) functions;
4750
4751   (* return key->values as a list of (key,value) *)
4752   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4753
4754 (* Used for testing language bindings. *)
4755 type callt =
4756   | CallString of string
4757   | CallOptString of string option
4758   | CallStringList of string list
4759   | CallInt of int
4760   | CallInt64 of int64
4761   | CallBool of bool
4762
4763 (* Used to memoize the result of pod2text. *)
4764 let pod2text_memo_filename = "src/.pod2text.data"
4765 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4766   try
4767     let chan = open_in pod2text_memo_filename in
4768     let v = input_value chan in
4769     close_in chan;
4770     v
4771   with
4772     _ -> Hashtbl.create 13
4773 let pod2text_memo_updated () =
4774   let chan = open_out pod2text_memo_filename in
4775   output_value chan pod2text_memo;
4776   close_out chan
4777
4778 (* Useful functions.
4779  * Note we don't want to use any external OCaml libraries which
4780  * makes this a bit harder than it should be.
4781  *)
4782 module StringMap = Map.Make (String)
4783
4784 let failwithf fs = ksprintf failwith fs
4785
4786 let unique = let i = ref 0 in fun () -> incr i; !i
4787
4788 let replace_char s c1 c2 =
4789   let s2 = String.copy s in
4790   let r = ref false in
4791   for i = 0 to String.length s2 - 1 do
4792     if String.unsafe_get s2 i = c1 then (
4793       String.unsafe_set s2 i c2;
4794       r := true
4795     )
4796   done;
4797   if not !r then s else s2
4798
4799 let isspace c =
4800   c = ' '
4801   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4802
4803 let triml ?(test = isspace) str =
4804   let i = ref 0 in
4805   let n = ref (String.length str) in
4806   while !n > 0 && test str.[!i]; do
4807     decr n;
4808     incr i
4809   done;
4810   if !i = 0 then str
4811   else String.sub str !i !n
4812
4813 let trimr ?(test = isspace) str =
4814   let n = ref (String.length str) in
4815   while !n > 0 && test str.[!n-1]; do
4816     decr n
4817   done;
4818   if !n = String.length str then str
4819   else String.sub str 0 !n
4820
4821 let trim ?(test = isspace) str =
4822   trimr ~test (triml ~test str)
4823
4824 let rec find s sub =
4825   let len = String.length s in
4826   let sublen = String.length sub in
4827   let rec loop i =
4828     if i <= len-sublen then (
4829       let rec loop2 j =
4830         if j < sublen then (
4831           if s.[i+j] = sub.[j] then loop2 (j+1)
4832           else -1
4833         ) else
4834           i (* found *)
4835       in
4836       let r = loop2 0 in
4837       if r = -1 then loop (i+1) else r
4838     ) else
4839       -1 (* not found *)
4840   in
4841   loop 0
4842
4843 let rec replace_str s s1 s2 =
4844   let len = String.length s in
4845   let sublen = String.length s1 in
4846   let i = find s s1 in
4847   if i = -1 then s
4848   else (
4849     let s' = String.sub s 0 i in
4850     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4851     s' ^ s2 ^ replace_str s'' s1 s2
4852   )
4853
4854 let rec string_split sep str =
4855   let len = String.length str in
4856   let seplen = String.length sep in
4857   let i = find str sep in
4858   if i = -1 then [str]
4859   else (
4860     let s' = String.sub str 0 i in
4861     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4862     s' :: string_split sep s''
4863   )
4864
4865 let files_equal n1 n2 =
4866   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4867   match Sys.command cmd with
4868   | 0 -> true
4869   | 1 -> false
4870   | i -> failwithf "%s: failed with error code %d" cmd i
4871
4872 let rec filter_map f = function
4873   | [] -> []
4874   | x :: xs ->
4875       match f x with
4876       | Some y -> y :: filter_map f xs
4877       | None -> filter_map f xs
4878
4879 let rec find_map f = function
4880   | [] -> raise Not_found
4881   | x :: xs ->
4882       match f x with
4883       | Some y -> y
4884       | None -> find_map f xs
4885
4886 let iteri f xs =
4887   let rec loop i = function
4888     | [] -> ()
4889     | x :: xs -> f i x; loop (i+1) xs
4890   in
4891   loop 0 xs
4892
4893 let mapi f xs =
4894   let rec loop i = function
4895     | [] -> []
4896     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4897   in
4898   loop 0 xs
4899
4900 let count_chars c str =
4901   let count = ref 0 in
4902   for i = 0 to String.length str - 1 do
4903     if c = String.unsafe_get str i then incr count
4904   done;
4905   !count
4906
4907 let name_of_argt = function
4908   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4909   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4910   | FileIn n | FileOut n -> n
4911
4912 let java_name_of_struct typ =
4913   try List.assoc typ java_structs
4914   with Not_found ->
4915     failwithf
4916       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4917
4918 let cols_of_struct typ =
4919   try List.assoc typ structs
4920   with Not_found ->
4921     failwithf "cols_of_struct: unknown struct %s" typ
4922
4923 let seq_of_test = function
4924   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4925   | TestOutputListOfDevices (s, _)
4926   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4927   | TestOutputTrue s | TestOutputFalse s
4928   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4929   | TestOutputStruct (s, _)
4930   | TestLastFail s -> s
4931
4932 (* Handling for function flags. *)
4933 let protocol_limit_warning =
4934   "Because of the message protocol, there is a transfer limit
4935 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4936
4937 let danger_will_robinson =
4938   "B<This command is dangerous.  Without careful use you
4939 can easily destroy all your data>."
4940
4941 let deprecation_notice flags =
4942   try
4943     let alt =
4944       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4945     let txt =
4946       sprintf "This function is deprecated.
4947 In new code, use the C<%s> call instead.
4948
4949 Deprecated functions will not be removed from the API, but the
4950 fact that they are deprecated indicates that there are problems
4951 with correct use of these functions." alt in
4952     Some txt
4953   with
4954     Not_found -> None
4955
4956 (* Create list of optional groups. *)
4957 let optgroups =
4958   let h = Hashtbl.create 13 in
4959   List.iter (
4960     fun (name, _, _, flags, _, _, _) ->
4961       List.iter (
4962         function
4963         | Optional group ->
4964             let names = try Hashtbl.find h group with Not_found -> [] in
4965             Hashtbl.replace h group (name :: names)
4966         | _ -> ()
4967       ) flags
4968   ) daemon_functions;
4969   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4970   let groups =
4971     List.map (
4972       fun group -> group, List.sort compare (Hashtbl.find h group)
4973     ) groups in
4974   List.sort (fun x y -> compare (fst x) (fst y)) groups
4975
4976 (* Check function names etc. for consistency. *)
4977 let check_functions () =
4978   let contains_uppercase str =
4979     let len = String.length str in
4980     let rec loop i =
4981       if i >= len then false
4982       else (
4983         let c = str.[i] in
4984         if c >= 'A' && c <= 'Z' then true
4985         else loop (i+1)
4986       )
4987     in
4988     loop 0
4989   in
4990
4991   (* Check function names. *)
4992   List.iter (
4993     fun (name, _, _, _, _, _, _) ->
4994       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4995         failwithf "function name %s does not need 'guestfs' prefix" name;
4996       if name = "" then
4997         failwithf "function name is empty";
4998       if name.[0] < 'a' || name.[0] > 'z' then
4999         failwithf "function name %s must start with lowercase a-z" name;
5000       if String.contains name '-' then
5001         failwithf "function name %s should not contain '-', use '_' instead."
5002           name
5003   ) all_functions;
5004
5005   (* Check function parameter/return names. *)
5006   List.iter (
5007     fun (name, style, _, _, _, _, _) ->
5008       let check_arg_ret_name n =
5009         if contains_uppercase n then
5010           failwithf "%s param/ret %s should not contain uppercase chars"
5011             name n;
5012         if String.contains n '-' || String.contains n '_' then
5013           failwithf "%s param/ret %s should not contain '-' or '_'"
5014             name n;
5015         if n = "value" then
5016           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;
5017         if n = "int" || n = "char" || n = "short" || n = "long" then
5018           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5019         if n = "i" || n = "n" then
5020           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5021         if n = "argv" || n = "args" then
5022           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5023
5024         (* List Haskell, OCaml and C keywords here.
5025          * http://www.haskell.org/haskellwiki/Keywords
5026          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5027          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5028          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5029          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5030          * Omitting _-containing words, since they're handled above.
5031          * Omitting the OCaml reserved word, "val", is ok,
5032          * and saves us from renaming several parameters.
5033          *)
5034         let reserved = [
5035           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5036           "char"; "class"; "const"; "constraint"; "continue"; "data";
5037           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5038           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5039           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5040           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
5041           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
5042           "interface";
5043           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
5044           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
5045           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
5046           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
5047           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
5048           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
5049           "volatile"; "when"; "where"; "while";
5050           ] in
5051         if List.mem n reserved then
5052           failwithf "%s has param/ret using reserved word %s" name n;
5053       in
5054
5055       (match fst style with
5056        | RErr -> ()
5057        | RInt n | RInt64 n | RBool n
5058        | RConstString n | RConstOptString n | RString n
5059        | RStringList n | RStruct (n, _) | RStructList (n, _)
5060        | RHashtable n | RBufferOut n ->
5061            check_arg_ret_name n
5062       );
5063       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5064   ) all_functions;
5065
5066   (* Check short descriptions. *)
5067   List.iter (
5068     fun (name, _, _, _, _, shortdesc, _) ->
5069       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5070         failwithf "short description of %s should begin with lowercase." name;
5071       let c = shortdesc.[String.length shortdesc-1] in
5072       if c = '\n' || c = '.' then
5073         failwithf "short description of %s should not end with . or \\n." name
5074   ) all_functions;
5075
5076   (* Check long descriptions. *)
5077   List.iter (
5078     fun (name, _, _, _, _, _, longdesc) ->
5079       if longdesc.[String.length longdesc-1] = '\n' then
5080         failwithf "long description of %s should not end with \\n." name
5081   ) all_functions;
5082
5083   (* Check proc_nrs. *)
5084   List.iter (
5085     fun (name, _, proc_nr, _, _, _, _) ->
5086       if proc_nr <= 0 then
5087         failwithf "daemon function %s should have proc_nr > 0" name
5088   ) daemon_functions;
5089
5090   List.iter (
5091     fun (name, _, proc_nr, _, _, _, _) ->
5092       if proc_nr <> -1 then
5093         failwithf "non-daemon function %s should have proc_nr -1" name
5094   ) non_daemon_functions;
5095
5096   let proc_nrs =
5097     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5098       daemon_functions in
5099   let proc_nrs =
5100     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5101   let rec loop = function
5102     | [] -> ()
5103     | [_] -> ()
5104     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5105         loop rest
5106     | (name1,nr1) :: (name2,nr2) :: _ ->
5107         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5108           name1 name2 nr1 nr2
5109   in
5110   loop proc_nrs;
5111
5112   (* Check tests. *)
5113   List.iter (
5114     function
5115       (* Ignore functions that have no tests.  We generate a
5116        * warning when the user does 'make check' instead.
5117        *)
5118     | name, _, _, _, [], _, _ -> ()
5119     | name, _, _, _, tests, _, _ ->
5120         let funcs =
5121           List.map (
5122             fun (_, _, test) ->
5123               match seq_of_test test with
5124               | [] ->
5125                   failwithf "%s has a test containing an empty sequence" name
5126               | cmds -> List.map List.hd cmds
5127           ) tests in
5128         let funcs = List.flatten funcs in
5129
5130         let tested = List.mem name funcs in
5131
5132         if not tested then
5133           failwithf "function %s has tests but does not test itself" name
5134   ) all_functions
5135
5136 (* 'pr' prints to the current output file. *)
5137 let chan = ref Pervasives.stdout
5138 let lines = ref 0
5139 let pr fs =
5140   ksprintf
5141     (fun str ->
5142        let i = count_chars '\n' str in
5143        lines := !lines + i;
5144        output_string !chan str
5145     ) fs
5146
5147 let copyright_years =
5148   let this_year = 1900 + (localtime (time ())).tm_year in
5149   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5150
5151 (* Generate a header block in a number of standard styles. *)
5152 type comment_style =
5153     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5154 type license = GPLv2plus | LGPLv2plus
5155
5156 let generate_header ?(extra_inputs = []) comment license =
5157   let inputs = "src/generator.ml" :: extra_inputs in
5158   let c = match comment with
5159     | CStyle ->         pr "/* "; " *"
5160     | CPlusPlusStyle -> pr "// "; "//"
5161     | HashStyle ->      pr "# ";  "#"
5162     | OCamlStyle ->     pr "(* "; " *"
5163     | HaskellStyle ->   pr "{- "; "  " in
5164   pr "libguestfs generated file\n";
5165   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5166   List.iter (pr "%s   %s\n" c) inputs;
5167   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5168   pr "%s\n" c;
5169   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5170   pr "%s\n" c;
5171   (match license with
5172    | GPLv2plus ->
5173        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5174        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5175        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5176        pr "%s (at your option) any later version.\n" c;
5177        pr "%s\n" c;
5178        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5179        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5180        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5181        pr "%s GNU General Public License for more details.\n" c;
5182        pr "%s\n" c;
5183        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5184        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5185        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5186
5187    | LGPLv2plus ->
5188        pr "%s This library is free software; you can redistribute it and/or\n" c;
5189        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5190        pr "%s License as published by the Free Software Foundation; either\n" c;
5191        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5192        pr "%s\n" c;
5193        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5194        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5195        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5196        pr "%s Lesser General Public License for more details.\n" c;
5197        pr "%s\n" c;
5198        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5199        pr "%s License along with this library; if not, write to the Free Software\n" c;
5200        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5201   );
5202   (match comment with
5203    | CStyle -> pr " */\n"
5204    | CPlusPlusStyle
5205    | HashStyle -> ()
5206    | OCamlStyle -> pr " *)\n"
5207    | HaskellStyle -> pr "-}\n"
5208   );
5209   pr "\n"
5210
5211 (* Start of main code generation functions below this line. *)
5212
5213 (* Generate the pod documentation for the C API. *)
5214 let rec generate_actions_pod () =
5215   List.iter (
5216     fun (shortname, style, _, flags, _, _, longdesc) ->
5217       if not (List.mem NotInDocs flags) then (
5218         let name = "guestfs_" ^ shortname in
5219         pr "=head2 %s\n\n" name;
5220         pr " ";
5221         generate_prototype ~extern:false ~handle:"g" name style;
5222         pr "\n\n";
5223         pr "%s\n\n" longdesc;
5224         (match fst style with
5225          | RErr ->
5226              pr "This function returns 0 on success or -1 on error.\n\n"
5227          | RInt _ ->
5228              pr "On error this function returns -1.\n\n"
5229          | RInt64 _ ->
5230              pr "On error this function returns -1.\n\n"
5231          | RBool _ ->
5232              pr "This function returns a C truth value on success or -1 on error.\n\n"
5233          | RConstString _ ->
5234              pr "This function returns a string, or NULL on error.
5235 The string is owned by the guest handle and must I<not> be freed.\n\n"
5236          | RConstOptString _ ->
5237              pr "This function returns a string which may be NULL.
5238 There is way to return an error from this function.
5239 The string is owned by the guest handle and must I<not> be freed.\n\n"
5240          | RString _ ->
5241              pr "This function returns a string, or NULL on error.
5242 I<The caller must free the returned string after use>.\n\n"
5243          | RStringList _ ->
5244              pr "This function returns a NULL-terminated array of strings
5245 (like L<environ(3)>), or NULL if there was an error.
5246 I<The caller must free the strings and the array after use>.\n\n"
5247          | RStruct (_, typ) ->
5248              pr "This function returns a C<struct guestfs_%s *>,
5249 or NULL if there was an error.
5250 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5251          | RStructList (_, typ) ->
5252              pr "This function returns a C<struct guestfs_%s_list *>
5253 (see E<lt>guestfs-structs.hE<gt>),
5254 or NULL if there was an error.
5255 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5256          | RHashtable _ ->
5257              pr "This function returns a NULL-terminated array of
5258 strings, or NULL if there was an error.
5259 The array of strings will always have length C<2n+1>, where
5260 C<n> keys and values alternate, followed by the trailing NULL entry.
5261 I<The caller must free the strings and the array after use>.\n\n"
5262          | RBufferOut _ ->
5263              pr "This function returns a buffer, or NULL on error.
5264 The size of the returned buffer is written to C<*size_r>.
5265 I<The caller must free the returned buffer after use>.\n\n"
5266         );
5267         if List.mem ProtocolLimitWarning flags then
5268           pr "%s\n\n" protocol_limit_warning;
5269         if List.mem DangerWillRobinson flags then
5270           pr "%s\n\n" danger_will_robinson;
5271         match deprecation_notice flags with
5272         | None -> ()
5273         | Some txt -> pr "%s\n\n" txt
5274       )
5275   ) all_functions_sorted
5276
5277 and generate_structs_pod () =
5278   (* Structs documentation. *)
5279   List.iter (
5280     fun (typ, cols) ->
5281       pr "=head2 guestfs_%s\n" typ;
5282       pr "\n";
5283       pr " struct guestfs_%s {\n" typ;
5284       List.iter (
5285         function
5286         | name, FChar -> pr "   char %s;\n" name
5287         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5288         | name, FInt32 -> pr "   int32_t %s;\n" name
5289         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5290         | name, FInt64 -> pr "   int64_t %s;\n" name
5291         | name, FString -> pr "   char *%s;\n" name
5292         | name, FBuffer ->
5293             pr "   /* The next two fields describe a byte array. */\n";
5294             pr "   uint32_t %s_len;\n" name;
5295             pr "   char *%s;\n" name
5296         | name, FUUID ->
5297             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5298             pr "   char %s[32];\n" name
5299         | name, FOptPercent ->
5300             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5301             pr "   float %s;\n" name
5302       ) cols;
5303       pr " };\n";
5304       pr " \n";
5305       pr " struct guestfs_%s_list {\n" typ;
5306       pr "   uint32_t len; /* Number of elements in list. */\n";
5307       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5308       pr " };\n";
5309       pr " \n";
5310       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5311       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5312         typ typ;
5313       pr "\n"
5314   ) structs
5315
5316 and generate_availability_pod () =
5317   (* Availability documentation. *)
5318   pr "=over 4\n";
5319   pr "\n";
5320   List.iter (
5321     fun (group, functions) ->
5322       pr "=item B<%s>\n" group;
5323       pr "\n";
5324       pr "The following functions:\n";
5325       List.iter (pr "L</guestfs_%s>\n") functions;
5326       pr "\n"
5327   ) optgroups;
5328   pr "=back\n";
5329   pr "\n"
5330
5331 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5332  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5333  *
5334  * We have to use an underscore instead of a dash because otherwise
5335  * rpcgen generates incorrect code.
5336  *
5337  * This header is NOT exported to clients, but see also generate_structs_h.
5338  *)
5339 and generate_xdr () =
5340   generate_header CStyle LGPLv2plus;
5341
5342   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5343   pr "typedef string str<>;\n";
5344   pr "\n";
5345
5346   (* Internal structures. *)
5347   List.iter (
5348     function
5349     | typ, cols ->
5350         pr "struct guestfs_int_%s {\n" typ;
5351         List.iter (function
5352                    | name, FChar -> pr "  char %s;\n" name
5353                    | name, FString -> pr "  string %s<>;\n" name
5354                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5355                    | name, FUUID -> pr "  opaque %s[32];\n" name
5356                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5357                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5358                    | name, FOptPercent -> pr "  float %s;\n" name
5359                   ) cols;
5360         pr "};\n";
5361         pr "\n";
5362         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5363         pr "\n";
5364   ) structs;
5365
5366   List.iter (
5367     fun (shortname, style, _, _, _, _, _) ->
5368       let name = "guestfs_" ^ shortname in
5369
5370       (match snd style with
5371        | [] -> ()
5372        | args ->
5373            pr "struct %s_args {\n" name;
5374            List.iter (
5375              function
5376              | Pathname n | Device n | Dev_or_Path n | String n ->
5377                  pr "  string %s<>;\n" n
5378              | OptString n -> pr "  str *%s;\n" n
5379              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5380              | Bool n -> pr "  bool %s;\n" n
5381              | Int n -> pr "  int %s;\n" n
5382              | Int64 n -> pr "  hyper %s;\n" n
5383              | FileIn _ | FileOut _ -> ()
5384            ) args;
5385            pr "};\n\n"
5386       );
5387       (match fst style with
5388        | RErr -> ()
5389        | RInt n ->
5390            pr "struct %s_ret {\n" name;
5391            pr "  int %s;\n" n;
5392            pr "};\n\n"
5393        | RInt64 n ->
5394            pr "struct %s_ret {\n" name;
5395            pr "  hyper %s;\n" n;
5396            pr "};\n\n"
5397        | RBool n ->
5398            pr "struct %s_ret {\n" name;
5399            pr "  bool %s;\n" n;
5400            pr "};\n\n"
5401        | RConstString _ | RConstOptString _ ->
5402            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5403        | RString n ->
5404            pr "struct %s_ret {\n" name;
5405            pr "  string %s<>;\n" n;
5406            pr "};\n\n"
5407        | RStringList n ->
5408            pr "struct %s_ret {\n" name;
5409            pr "  str %s<>;\n" n;
5410            pr "};\n\n"
5411        | RStruct (n, typ) ->
5412            pr "struct %s_ret {\n" name;
5413            pr "  guestfs_int_%s %s;\n" typ n;
5414            pr "};\n\n"
5415        | RStructList (n, typ) ->
5416            pr "struct %s_ret {\n" name;
5417            pr "  guestfs_int_%s_list %s;\n" typ n;
5418            pr "};\n\n"
5419        | RHashtable n ->
5420            pr "struct %s_ret {\n" name;
5421            pr "  str %s<>;\n" n;
5422            pr "};\n\n"
5423        | RBufferOut n ->
5424            pr "struct %s_ret {\n" name;
5425            pr "  opaque %s<>;\n" n;
5426            pr "};\n\n"
5427       );
5428   ) daemon_functions;
5429
5430   (* Table of procedure numbers. *)
5431   pr "enum guestfs_procedure {\n";
5432   List.iter (
5433     fun (shortname, _, proc_nr, _, _, _, _) ->
5434       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5435   ) daemon_functions;
5436   pr "  GUESTFS_PROC_NR_PROCS\n";
5437   pr "};\n";
5438   pr "\n";
5439
5440   (* Having to choose a maximum message size is annoying for several
5441    * reasons (it limits what we can do in the API), but it (a) makes
5442    * the protocol a lot simpler, and (b) provides a bound on the size
5443    * of the daemon which operates in limited memory space.
5444    *)
5445   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5446   pr "\n";
5447
5448   (* Message header, etc. *)
5449   pr "\
5450 /* The communication protocol is now documented in the guestfs(3)
5451  * manpage.
5452  */
5453
5454 const GUESTFS_PROGRAM = 0x2000F5F5;
5455 const GUESTFS_PROTOCOL_VERSION = 1;
5456
5457 /* These constants must be larger than any possible message length. */
5458 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5459 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5460
5461 enum guestfs_message_direction {
5462   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5463   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5464 };
5465
5466 enum guestfs_message_status {
5467   GUESTFS_STATUS_OK = 0,
5468   GUESTFS_STATUS_ERROR = 1
5469 };
5470
5471 const GUESTFS_ERROR_LEN = 256;
5472
5473 struct guestfs_message_error {
5474   string error_message<GUESTFS_ERROR_LEN>;
5475 };
5476
5477 struct guestfs_message_header {
5478   unsigned prog;                     /* GUESTFS_PROGRAM */
5479   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5480   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5481   guestfs_message_direction direction;
5482   unsigned serial;                   /* message serial number */
5483   guestfs_message_status status;
5484 };
5485
5486 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5487
5488 struct guestfs_chunk {
5489   int cancel;                        /* if non-zero, transfer is cancelled */
5490   /* data size is 0 bytes if the transfer has finished successfully */
5491   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5492 };
5493 "
5494
5495 (* Generate the guestfs-structs.h file. *)
5496 and generate_structs_h () =
5497   generate_header CStyle LGPLv2plus;
5498
5499   (* This is a public exported header file containing various
5500    * structures.  The structures are carefully written to have
5501    * exactly the same in-memory format as the XDR structures that
5502    * we use on the wire to the daemon.  The reason for creating
5503    * copies of these structures here is just so we don't have to
5504    * export the whole of guestfs_protocol.h (which includes much
5505    * unrelated and XDR-dependent stuff that we don't want to be
5506    * public, or required by clients).
5507    *
5508    * To reiterate, we will pass these structures to and from the
5509    * client with a simple assignment or memcpy, so the format
5510    * must be identical to what rpcgen / the RFC defines.
5511    *)
5512
5513   (* Public structures. *)
5514   List.iter (
5515     fun (typ, cols) ->
5516       pr "struct guestfs_%s {\n" typ;
5517       List.iter (
5518         function
5519         | name, FChar -> pr "  char %s;\n" name
5520         | name, FString -> pr "  char *%s;\n" name
5521         | name, FBuffer ->
5522             pr "  uint32_t %s_len;\n" name;
5523             pr "  char *%s;\n" name
5524         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5525         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5526         | name, FInt32 -> pr "  int32_t %s;\n" name
5527         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5528         | name, FInt64 -> pr "  int64_t %s;\n" name
5529         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5530       ) cols;
5531       pr "};\n";
5532       pr "\n";
5533       pr "struct guestfs_%s_list {\n" typ;
5534       pr "  uint32_t len;\n";
5535       pr "  struct guestfs_%s *val;\n" typ;
5536       pr "};\n";
5537       pr "\n";
5538       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5539       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5540       pr "\n"
5541   ) structs
5542
5543 (* Generate the guestfs-actions.h file. *)
5544 and generate_actions_h () =
5545   generate_header CStyle LGPLv2plus;
5546   List.iter (
5547     fun (shortname, style, _, _, _, _, _) ->
5548       let name = "guestfs_" ^ shortname in
5549       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5550         name style
5551   ) all_functions
5552
5553 (* Generate the guestfs-internal-actions.h file. *)
5554 and generate_internal_actions_h () =
5555   generate_header CStyle LGPLv2plus;
5556   List.iter (
5557     fun (shortname, style, _, _, _, _, _) ->
5558       let name = "guestfs__" ^ shortname in
5559       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5560         name style
5561   ) non_daemon_functions
5562
5563 (* Generate the client-side dispatch stubs. *)
5564 and generate_client_actions () =
5565   generate_header CStyle LGPLv2plus;
5566
5567   pr "\
5568 #include <stdio.h>
5569 #include <stdlib.h>
5570 #include <stdint.h>
5571 #include <string.h>
5572 #include <inttypes.h>
5573
5574 #include \"guestfs.h\"
5575 #include \"guestfs-internal.h\"
5576 #include \"guestfs-internal-actions.h\"
5577 #include \"guestfs_protocol.h\"
5578
5579 #define error guestfs_error
5580 //#define perrorf guestfs_perrorf
5581 #define safe_malloc guestfs_safe_malloc
5582 #define safe_realloc guestfs_safe_realloc
5583 //#define safe_strdup guestfs_safe_strdup
5584 #define safe_memdup guestfs_safe_memdup
5585
5586 /* Check the return message from a call for validity. */
5587 static int
5588 check_reply_header (guestfs_h *g,
5589                     const struct guestfs_message_header *hdr,
5590                     unsigned int proc_nr, unsigned int serial)
5591 {
5592   if (hdr->prog != GUESTFS_PROGRAM) {
5593     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5594     return -1;
5595   }
5596   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5597     error (g, \"wrong protocol version (%%d/%%d)\",
5598            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5599     return -1;
5600   }
5601   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5602     error (g, \"unexpected message direction (%%d/%%d)\",
5603            hdr->direction, GUESTFS_DIRECTION_REPLY);
5604     return -1;
5605   }
5606   if (hdr->proc != proc_nr) {
5607     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5608     return -1;
5609   }
5610   if (hdr->serial != serial) {
5611     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5612     return -1;
5613   }
5614
5615   return 0;
5616 }
5617
5618 /* Check we are in the right state to run a high-level action. */
5619 static int
5620 check_state (guestfs_h *g, const char *caller)
5621 {
5622   if (!guestfs__is_ready (g)) {
5623     if (guestfs__is_config (g) || guestfs__is_launching (g))
5624       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5625         caller);
5626     else
5627       error (g, \"%%s called from the wrong state, %%d != READY\",
5628         caller, guestfs__get_state (g));
5629     return -1;
5630   }
5631   return 0;
5632 }
5633
5634 ";
5635
5636   (* Generate code to generate guestfish call traces. *)
5637   let trace_call shortname style =
5638     pr "  if (guestfs__get_trace (g)) {\n";
5639
5640     let needs_i =
5641       List.exists (function
5642                    | StringList _ | DeviceList _ -> true
5643                    | _ -> false) (snd style) in
5644     if needs_i then (
5645       pr "    int i;\n";
5646       pr "\n"
5647     );
5648
5649     pr "    printf (\"%s\");\n" shortname;
5650     List.iter (
5651       function
5652       | String n                        (* strings *)
5653       | Device n
5654       | Pathname n
5655       | Dev_or_Path n
5656       | FileIn n
5657       | FileOut n ->
5658           (* guestfish doesn't support string escaping, so neither do we *)
5659           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5660       | OptString n ->                  (* string option *)
5661           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5662           pr "    else printf (\" null\");\n"
5663       | StringList n
5664       | DeviceList n ->                 (* string list *)
5665           pr "    putchar (' ');\n";
5666           pr "    putchar ('\"');\n";
5667           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5668           pr "      if (i > 0) putchar (' ');\n";
5669           pr "      fputs (%s[i], stdout);\n" n;
5670           pr "    }\n";
5671           pr "    putchar ('\"');\n";
5672       | Bool n ->                       (* boolean *)
5673           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5674       | Int n ->                        (* int *)
5675           pr "    printf (\" %%d\", %s);\n" n
5676       | Int64 n ->
5677           pr "    printf (\" %%\" PRIi64, %s);\n" n
5678     ) (snd style);
5679     pr "    putchar ('\\n');\n";
5680     pr "  }\n";
5681     pr "\n";
5682   in
5683
5684   (* For non-daemon functions, generate a wrapper around each function. *)
5685   List.iter (
5686     fun (shortname, style, _, _, _, _, _) ->
5687       let name = "guestfs_" ^ shortname in
5688
5689       generate_prototype ~extern:false ~semicolon:false ~newline:true
5690         ~handle:"g" name style;
5691       pr "{\n";
5692       trace_call shortname style;
5693       pr "  return guestfs__%s " shortname;
5694       generate_c_call_args ~handle:"g" style;
5695       pr ";\n";
5696       pr "}\n";
5697       pr "\n"
5698   ) non_daemon_functions;
5699
5700   (* Client-side stubs for each function. *)
5701   List.iter (
5702     fun (shortname, style, _, _, _, _, _) ->
5703       let name = "guestfs_" ^ shortname in
5704
5705       (* Generate the action stub. *)
5706       generate_prototype ~extern:false ~semicolon:false ~newline:true
5707         ~handle:"g" name style;
5708
5709       let error_code =
5710         match fst style with
5711         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5712         | RConstString _ | RConstOptString _ ->
5713             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5714         | RString _ | RStringList _
5715         | RStruct _ | RStructList _
5716         | RHashtable _ | RBufferOut _ ->
5717             "NULL" in
5718
5719       pr "{\n";
5720
5721       (match snd style with
5722        | [] -> ()
5723        | _ -> pr "  struct %s_args args;\n" name
5724       );
5725
5726       pr "  guestfs_message_header hdr;\n";
5727       pr "  guestfs_message_error err;\n";
5728       let has_ret =
5729         match fst style with
5730         | RErr -> false
5731         | RConstString _ | RConstOptString _ ->
5732             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5733         | RInt _ | RInt64 _
5734         | RBool _ | RString _ | RStringList _
5735         | RStruct _ | RStructList _
5736         | RHashtable _ | RBufferOut _ ->
5737             pr "  struct %s_ret ret;\n" name;
5738             true in
5739
5740       pr "  int serial;\n";
5741       pr "  int r;\n";
5742       pr "\n";
5743       trace_call shortname style;
5744       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5745       pr "  guestfs___set_busy (g);\n";
5746       pr "\n";
5747
5748       (* Send the main header and arguments. *)
5749       (match snd style with
5750        | [] ->
5751            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5752              (String.uppercase shortname)
5753        | args ->
5754            List.iter (
5755              function
5756              | Pathname n | Device n | Dev_or_Path n | String n ->
5757                  pr "  args.%s = (char *) %s;\n" n n
5758              | OptString n ->
5759                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5760              | StringList n | DeviceList n ->
5761                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5762                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5763              | Bool n ->
5764                  pr "  args.%s = %s;\n" n n
5765              | Int n ->
5766                  pr "  args.%s = %s;\n" n n
5767              | Int64 n ->
5768                  pr "  args.%s = %s;\n" n n
5769              | FileIn _ | FileOut _ -> ()
5770            ) args;
5771            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5772              (String.uppercase shortname);
5773            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5774              name;
5775       );
5776       pr "  if (serial == -1) {\n";
5777       pr "    guestfs___end_busy (g);\n";
5778       pr "    return %s;\n" error_code;
5779       pr "  }\n";
5780       pr "\n";
5781
5782       (* Send any additional files (FileIn) requested. *)
5783       let need_read_reply_label = ref false in
5784       List.iter (
5785         function
5786         | FileIn n ->
5787             pr "  r = guestfs___send_file (g, %s);\n" n;
5788             pr "  if (r == -1) {\n";
5789             pr "    guestfs___end_busy (g);\n";
5790             pr "    return %s;\n" error_code;
5791             pr "  }\n";
5792             pr "  if (r == -2) /* daemon cancelled */\n";
5793             pr "    goto read_reply;\n";
5794             need_read_reply_label := true;
5795             pr "\n";
5796         | _ -> ()
5797       ) (snd style);
5798
5799       (* Wait for the reply from the remote end. *)
5800       if !need_read_reply_label then pr " read_reply:\n";
5801       pr "  memset (&hdr, 0, sizeof hdr);\n";
5802       pr "  memset (&err, 0, sizeof err);\n";
5803       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5804       pr "\n";
5805       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5806       if not has_ret then
5807         pr "NULL, NULL"
5808       else
5809         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5810       pr ");\n";
5811
5812       pr "  if (r == -1) {\n";
5813       pr "    guestfs___end_busy (g);\n";
5814       pr "    return %s;\n" error_code;
5815       pr "  }\n";
5816       pr "\n";
5817
5818       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5819         (String.uppercase shortname);
5820       pr "    guestfs___end_busy (g);\n";
5821       pr "    return %s;\n" error_code;
5822       pr "  }\n";
5823       pr "\n";
5824
5825       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5826       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5827       pr "    free (err.error_message);\n";
5828       pr "    guestfs___end_busy (g);\n";
5829       pr "    return %s;\n" error_code;
5830       pr "  }\n";
5831       pr "\n";
5832
5833       (* Expecting to receive further files (FileOut)? *)
5834       List.iter (
5835         function
5836         | FileOut n ->
5837             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5838             pr "    guestfs___end_busy (g);\n";
5839             pr "    return %s;\n" error_code;
5840             pr "  }\n";
5841             pr "\n";
5842         | _ -> ()
5843       ) (snd style);
5844
5845       pr "  guestfs___end_busy (g);\n";
5846
5847       (match fst style with
5848        | RErr -> pr "  return 0;\n"
5849        | RInt n | RInt64 n | RBool n ->
5850            pr "  return ret.%s;\n" n
5851        | RConstString _ | RConstOptString _ ->
5852            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5853        | RString n ->
5854            pr "  return ret.%s; /* caller will free */\n" n
5855        | RStringList n | RHashtable n ->
5856            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5857            pr "  ret.%s.%s_val =\n" n n;
5858            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5859            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5860              n n;
5861            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5862            pr "  return ret.%s.%s_val;\n" n n
5863        | RStruct (n, _) ->
5864            pr "  /* caller will free this */\n";
5865            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5866        | RStructList (n, _) ->
5867            pr "  /* caller will free this */\n";
5868            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5869        | RBufferOut n ->
5870            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5871            pr "   * _val might be NULL here.  To make the API saner for\n";
5872            pr "   * callers, we turn this case into a unique pointer (using\n";
5873            pr "   * malloc(1)).\n";
5874            pr "   */\n";
5875            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5876            pr "    *size_r = ret.%s.%s_len;\n" n n;
5877            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5878            pr "  } else {\n";
5879            pr "    free (ret.%s.%s_val);\n" n n;
5880            pr "    char *p = safe_malloc (g, 1);\n";
5881            pr "    *size_r = ret.%s.%s_len;\n" n n;
5882            pr "    return p;\n";
5883            pr "  }\n";
5884       );
5885
5886       pr "}\n\n"
5887   ) daemon_functions;
5888
5889   (* Functions to free structures. *)
5890   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5891   pr " * structure format is identical to the XDR format.  See note in\n";
5892   pr " * generator.ml.\n";
5893   pr " */\n";
5894   pr "\n";
5895
5896   List.iter (
5897     fun (typ, _) ->
5898       pr "void\n";
5899       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5900       pr "{\n";
5901       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5902       pr "  free (x);\n";
5903       pr "}\n";
5904       pr "\n";
5905
5906       pr "void\n";
5907       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5908       pr "{\n";
5909       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5910       pr "  free (x);\n";
5911       pr "}\n";
5912       pr "\n";
5913
5914   ) structs;
5915
5916 (* Generate daemon/actions.h. *)
5917 and generate_daemon_actions_h () =
5918   generate_header CStyle GPLv2plus;
5919
5920   pr "#include \"../src/guestfs_protocol.h\"\n";
5921   pr "\n";
5922
5923   List.iter (
5924     fun (name, style, _, _, _, _, _) ->
5925       generate_prototype
5926         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5927         name style;
5928   ) daemon_functions
5929
5930 (* Generate the linker script which controls the visibility of
5931  * symbols in the public ABI and ensures no other symbols get
5932  * exported accidentally.
5933  *)
5934 and generate_linker_script () =
5935   generate_header HashStyle GPLv2plus;
5936
5937   let globals = [
5938     "guestfs_create";
5939     "guestfs_close";
5940     "guestfs_get_error_handler";
5941     "guestfs_get_out_of_memory_handler";
5942     "guestfs_last_error";
5943     "guestfs_set_error_handler";
5944     "guestfs_set_launch_done_callback";
5945     "guestfs_set_log_message_callback";
5946     "guestfs_set_out_of_memory_handler";
5947     "guestfs_set_subprocess_quit_callback";
5948
5949     (* Unofficial parts of the API: the bindings code use these
5950      * functions, so it is useful to export them.
5951      *)
5952     "guestfs_safe_calloc";
5953     "guestfs_safe_malloc";
5954   ] in
5955   let functions =
5956     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5957       all_functions in
5958   let structs =
5959     List.concat (
5960       List.map (fun (typ, _) ->
5961                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5962         structs
5963     ) in
5964   let globals = List.sort compare (globals @ functions @ structs) in
5965
5966   pr "{\n";
5967   pr "    global:\n";
5968   List.iter (pr "        %s;\n") globals;
5969   pr "\n";
5970
5971   pr "    local:\n";
5972   pr "        *;\n";
5973   pr "};\n"
5974
5975 (* Generate the server-side stubs. *)
5976 and generate_daemon_actions () =
5977   generate_header CStyle GPLv2plus;
5978
5979   pr "#include <config.h>\n";
5980   pr "\n";
5981   pr "#include <stdio.h>\n";
5982   pr "#include <stdlib.h>\n";
5983   pr "#include <string.h>\n";
5984   pr "#include <inttypes.h>\n";
5985   pr "#include <rpc/types.h>\n";
5986   pr "#include <rpc/xdr.h>\n";
5987   pr "\n";
5988   pr "#include \"daemon.h\"\n";
5989   pr "#include \"c-ctype.h\"\n";
5990   pr "#include \"../src/guestfs_protocol.h\"\n";
5991   pr "#include \"actions.h\"\n";
5992   pr "\n";
5993
5994   List.iter (
5995     fun (name, style, _, _, _, _, _) ->
5996       (* Generate server-side stubs. *)
5997       pr "static void %s_stub (XDR *xdr_in)\n" name;
5998       pr "{\n";
5999       let error_code =
6000         match fst style with
6001         | RErr | RInt _ -> pr "  int r;\n"; "-1"
6002         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6003         | RBool _ -> pr "  int r;\n"; "-1"
6004         | RConstString _ | RConstOptString _ ->
6005             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6006         | RString _ -> pr "  char *r;\n"; "NULL"
6007         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6008         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
6009         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
6010         | RBufferOut _ ->
6011             pr "  size_t size = 1;\n";
6012             pr "  char *r;\n";
6013             "NULL" in
6014
6015       (match snd style with
6016        | [] -> ()
6017        | args ->
6018            pr "  struct guestfs_%s_args args;\n" name;
6019            List.iter (
6020              function
6021              | Device n | Dev_or_Path n
6022              | Pathname n
6023              | String n -> ()
6024              | OptString n -> pr "  char *%s;\n" n
6025              | StringList n | DeviceList n -> pr "  char **%s;\n" n
6026              | Bool n -> pr "  int %s;\n" n
6027              | Int n -> pr "  int %s;\n" n
6028              | Int64 n -> pr "  int64_t %s;\n" n
6029              | FileIn _ | FileOut _ -> ()
6030            ) args
6031       );
6032       pr "\n";
6033
6034       (match snd style with
6035        | [] -> ()
6036        | args ->
6037            pr "  memset (&args, 0, sizeof args);\n";
6038            pr "\n";
6039            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
6040            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
6041            pr "    return;\n";
6042            pr "  }\n";
6043            let pr_args n =
6044              pr "  char *%s = args.%s;\n" n n
6045            in
6046            let pr_list_handling_code n =
6047              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
6048              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
6049              pr "  if (%s == NULL) {\n" n;
6050              pr "    reply_with_perror (\"realloc\");\n";
6051              pr "    goto done;\n";
6052              pr "  }\n";
6053              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6054              pr "  args.%s.%s_val = %s;\n" n n n;
6055            in
6056            List.iter (
6057              function
6058              | Pathname n ->
6059                  pr_args n;
6060                  pr "  ABS_PATH (%s, goto done);\n" n;
6061              | Device n ->
6062                  pr_args n;
6063                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6064              | Dev_or_Path n ->
6065                  pr_args n;
6066                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6067              | String n -> pr_args n
6068              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6069              | StringList n ->
6070                  pr_list_handling_code n;
6071              | DeviceList n ->
6072                  pr_list_handling_code n;
6073                  pr "  /* Ensure that each is a device,\n";
6074                  pr "   * and perform device name translation. */\n";
6075                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
6076                  pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
6077                  pr "  }\n";
6078              | Bool n -> pr "  %s = args.%s;\n" n n
6079              | Int n -> pr "  %s = args.%s;\n" n n
6080              | Int64 n -> pr "  %s = args.%s;\n" n n
6081              | FileIn _ | FileOut _ -> ()
6082            ) args;
6083            pr "\n"
6084       );
6085
6086
6087       (* this is used at least for do_equal *)
6088       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6089         (* Emit NEED_ROOT just once, even when there are two or
6090            more Pathname args *)
6091         pr "  NEED_ROOT (goto done);\n";
6092       );
6093
6094       (* Don't want to call the impl with any FileIn or FileOut
6095        * parameters, since these go "outside" the RPC protocol.
6096        *)
6097       let args' =
6098         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6099           (snd style) in
6100       pr "  r = do_%s " name;
6101       generate_c_call_args (fst style, args');
6102       pr ";\n";
6103
6104       (match fst style with
6105        | RErr | RInt _ | RInt64 _ | RBool _
6106        | RConstString _ | RConstOptString _
6107        | RString _ | RStringList _ | RHashtable _
6108        | RStruct (_, _) | RStructList (_, _) ->
6109            pr "  if (r == %s)\n" error_code;
6110            pr "    /* do_%s has already called reply_with_error */\n" name;
6111            pr "    goto done;\n";
6112            pr "\n"
6113        | RBufferOut _ ->
6114            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6115            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6116            pr "   */\n";
6117            pr "  if (size == 1 && r == %s)\n" error_code;
6118            pr "    /* do_%s has already called reply_with_error */\n" name;
6119            pr "    goto done;\n";
6120            pr "\n"
6121       );
6122
6123       (* If there are any FileOut parameters, then the impl must
6124        * send its own reply.
6125        *)
6126       let no_reply =
6127         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6128       if no_reply then
6129         pr "  /* do_%s has already sent a reply */\n" name
6130       else (
6131         match fst style with
6132         | RErr -> pr "  reply (NULL, NULL);\n"
6133         | RInt n | RInt64 n | RBool n ->
6134             pr "  struct guestfs_%s_ret ret;\n" name;
6135             pr "  ret.%s = r;\n" n;
6136             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6137               name
6138         | RConstString _ | RConstOptString _ ->
6139             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6140         | RString n ->
6141             pr "  struct guestfs_%s_ret ret;\n" name;
6142             pr "  ret.%s = r;\n" n;
6143             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6144               name;
6145             pr "  free (r);\n"
6146         | RStringList n | RHashtable n ->
6147             pr "  struct guestfs_%s_ret ret;\n" name;
6148             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6149             pr "  ret.%s.%s_val = r;\n" n n;
6150             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6151               name;
6152             pr "  free_strings (r);\n"
6153         | RStruct (n, _) ->
6154             pr "  struct guestfs_%s_ret ret;\n" name;
6155             pr "  ret.%s = *r;\n" n;
6156             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6157               name;
6158             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6159               name
6160         | RStructList (n, _) ->
6161             pr "  struct guestfs_%s_ret ret;\n" name;
6162             pr "  ret.%s = *r;\n" n;
6163             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6164               name;
6165             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6166               name
6167         | RBufferOut n ->
6168             pr "  struct guestfs_%s_ret ret;\n" name;
6169             pr "  ret.%s.%s_val = r;\n" n n;
6170             pr "  ret.%s.%s_len = size;\n" n n;
6171             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6172               name;
6173             pr "  free (r);\n"
6174       );
6175
6176       (* Free the args. *)
6177       (match snd style with
6178        | [] ->
6179            pr "done: ;\n";
6180        | _ ->
6181            pr "done:\n";
6182            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6183              name
6184       );
6185
6186       pr "}\n\n";
6187   ) daemon_functions;
6188
6189   (* Dispatch function. *)
6190   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6191   pr "{\n";
6192   pr "  switch (proc_nr) {\n";
6193
6194   List.iter (
6195     fun (name, style, _, _, _, _, _) ->
6196       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6197       pr "      %s_stub (xdr_in);\n" name;
6198       pr "      break;\n"
6199   ) daemon_functions;
6200
6201   pr "    default:\n";
6202   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";
6203   pr "  }\n";
6204   pr "}\n";
6205   pr "\n";
6206
6207   (* LVM columns and tokenization functions. *)
6208   (* XXX This generates crap code.  We should rethink how we
6209    * do this parsing.
6210    *)
6211   List.iter (
6212     function
6213     | typ, cols ->
6214         pr "static const char *lvm_%s_cols = \"%s\";\n"
6215           typ (String.concat "," (List.map fst cols));
6216         pr "\n";
6217
6218         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6219         pr "{\n";
6220         pr "  char *tok, *p, *next;\n";
6221         pr "  int i, j;\n";
6222         pr "\n";
6223         (*
6224           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6225           pr "\n";
6226         *)
6227         pr "  if (!str) {\n";
6228         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6229         pr "    return -1;\n";
6230         pr "  }\n";
6231         pr "  if (!*str || c_isspace (*str)) {\n";
6232         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6233         pr "    return -1;\n";
6234         pr "  }\n";
6235         pr "  tok = str;\n";
6236         List.iter (
6237           fun (name, coltype) ->
6238             pr "  if (!tok) {\n";
6239             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6240             pr "    return -1;\n";
6241             pr "  }\n";
6242             pr "  p = strchrnul (tok, ',');\n";
6243             pr "  if (*p) next = p+1; else next = NULL;\n";
6244             pr "  *p = '\\0';\n";
6245             (match coltype with
6246              | FString ->
6247                  pr "  r->%s = strdup (tok);\n" name;
6248                  pr "  if (r->%s == NULL) {\n" name;
6249                  pr "    perror (\"strdup\");\n";
6250                  pr "    return -1;\n";
6251                  pr "  }\n"
6252              | FUUID ->
6253                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6254                  pr "    if (tok[j] == '\\0') {\n";
6255                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6256                  pr "      return -1;\n";
6257                  pr "    } else if (tok[j] != '-')\n";
6258                  pr "      r->%s[i++] = tok[j];\n" name;
6259                  pr "  }\n";
6260              | FBytes ->
6261                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6262                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6263                  pr "    return -1;\n";
6264                  pr "  }\n";
6265              | FInt64 ->
6266                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6267                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6268                  pr "    return -1;\n";
6269                  pr "  }\n";
6270              | FOptPercent ->
6271                  pr "  if (tok[0] == '\\0')\n";
6272                  pr "    r->%s = -1;\n" name;
6273                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6274                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6275                  pr "    return -1;\n";
6276                  pr "  }\n";
6277              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6278                  assert false (* can never be an LVM column *)
6279             );
6280             pr "  tok = next;\n";
6281         ) cols;
6282
6283         pr "  if (tok != NULL) {\n";
6284         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6285         pr "    return -1;\n";
6286         pr "  }\n";
6287         pr "  return 0;\n";
6288         pr "}\n";
6289         pr "\n";
6290
6291         pr "guestfs_int_lvm_%s_list *\n" typ;
6292         pr "parse_command_line_%ss (void)\n" typ;
6293         pr "{\n";
6294         pr "  char *out, *err;\n";
6295         pr "  char *p, *pend;\n";
6296         pr "  int r, i;\n";
6297         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6298         pr "  void *newp;\n";
6299         pr "\n";
6300         pr "  ret = malloc (sizeof *ret);\n";
6301         pr "  if (!ret) {\n";
6302         pr "    reply_with_perror (\"malloc\");\n";
6303         pr "    return NULL;\n";
6304         pr "  }\n";
6305         pr "\n";
6306         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6307         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6308         pr "\n";
6309         pr "  r = command (&out, &err,\n";
6310         pr "           \"lvm\", \"%ss\",\n" typ;
6311         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6312         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6313         pr "  if (r == -1) {\n";
6314         pr "    reply_with_error (\"%%s\", err);\n";
6315         pr "    free (out);\n";
6316         pr "    free (err);\n";
6317         pr "    free (ret);\n";
6318         pr "    return NULL;\n";
6319         pr "  }\n";
6320         pr "\n";
6321         pr "  free (err);\n";
6322         pr "\n";
6323         pr "  /* Tokenize each line of the output. */\n";
6324         pr "  p = out;\n";
6325         pr "  i = 0;\n";
6326         pr "  while (p) {\n";
6327         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6328         pr "    if (pend) {\n";
6329         pr "      *pend = '\\0';\n";
6330         pr "      pend++;\n";
6331         pr "    }\n";
6332         pr "\n";
6333         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6334         pr "      p++;\n";
6335         pr "\n";
6336         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6337         pr "      p = pend;\n";
6338         pr "      continue;\n";
6339         pr "    }\n";
6340         pr "\n";
6341         pr "    /* Allocate some space to store this next entry. */\n";
6342         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6343         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6344         pr "    if (newp == NULL) {\n";
6345         pr "      reply_with_perror (\"realloc\");\n";
6346         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6347         pr "      free (ret);\n";
6348         pr "      free (out);\n";
6349         pr "      return NULL;\n";
6350         pr "    }\n";
6351         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6352         pr "\n";
6353         pr "    /* Tokenize the next entry. */\n";
6354         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6355         pr "    if (r == -1) {\n";
6356         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6357         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6358         pr "      free (ret);\n";
6359         pr "      free (out);\n";
6360         pr "      return NULL;\n";
6361         pr "    }\n";
6362         pr "\n";
6363         pr "    ++i;\n";
6364         pr "    p = pend;\n";
6365         pr "  }\n";
6366         pr "\n";
6367         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6368         pr "\n";
6369         pr "  free (out);\n";
6370         pr "  return ret;\n";
6371         pr "}\n"
6372
6373   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6374
6375 (* Generate a list of function names, for debugging in the daemon.. *)
6376 and generate_daemon_names () =
6377   generate_header CStyle GPLv2plus;
6378
6379   pr "#include <config.h>\n";
6380   pr "\n";
6381   pr "#include \"daemon.h\"\n";
6382   pr "\n";
6383
6384   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6385   pr "const char *function_names[] = {\n";
6386   List.iter (
6387     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6388   ) daemon_functions;
6389   pr "};\n";
6390
6391 (* Generate the optional groups for the daemon to implement
6392  * guestfs_available.
6393  *)
6394 and generate_daemon_optgroups_c () =
6395   generate_header CStyle GPLv2plus;
6396
6397   pr "#include <config.h>\n";
6398   pr "\n";
6399   pr "#include \"daemon.h\"\n";
6400   pr "#include \"optgroups.h\"\n";
6401   pr "\n";
6402
6403   pr "struct optgroup optgroups[] = {\n";
6404   List.iter (
6405     fun (group, _) ->
6406       pr "  { \"%s\", optgroup_%s_available },\n" group group
6407   ) optgroups;
6408   pr "  { NULL, NULL }\n";
6409   pr "};\n"
6410
6411 and generate_daemon_optgroups_h () =
6412   generate_header CStyle GPLv2plus;
6413
6414   List.iter (
6415     fun (group, _) ->
6416       pr "extern int optgroup_%s_available (void);\n" group
6417   ) optgroups
6418
6419 (* Generate the tests. *)
6420 and generate_tests () =
6421   generate_header CStyle GPLv2plus;
6422
6423   pr "\
6424 #include <stdio.h>
6425 #include <stdlib.h>
6426 #include <string.h>
6427 #include <unistd.h>
6428 #include <sys/types.h>
6429 #include <fcntl.h>
6430
6431 #include \"guestfs.h\"
6432 #include \"guestfs-internal.h\"
6433
6434 static guestfs_h *g;
6435 static int suppress_error = 0;
6436
6437 static void print_error (guestfs_h *g, void *data, const char *msg)
6438 {
6439   if (!suppress_error)
6440     fprintf (stderr, \"%%s\\n\", msg);
6441 }
6442
6443 /* FIXME: nearly identical code appears in fish.c */
6444 static void print_strings (char *const *argv)
6445 {
6446   int argc;
6447
6448   for (argc = 0; argv[argc] != NULL; ++argc)
6449     printf (\"\\t%%s\\n\", argv[argc]);
6450 }
6451
6452 /*
6453 static void print_table (char const *const *argv)
6454 {
6455   int i;
6456
6457   for (i = 0; argv[i] != NULL; i += 2)
6458     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6459 }
6460 */
6461
6462 static int
6463 is_available (const char *group)
6464 {
6465   const char *groups[] = { group, NULL };
6466   int r;
6467
6468   suppress_error = 1;
6469   r = guestfs_available (g, (char **) groups);
6470   suppress_error = 0;
6471
6472   return r == 0;
6473 }
6474
6475 ";
6476
6477   (* Generate a list of commands which are not tested anywhere. *)
6478   pr "static void no_test_warnings (void)\n";
6479   pr "{\n";
6480
6481   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6482   List.iter (
6483     fun (_, _, _, _, tests, _, _) ->
6484       let tests = filter_map (
6485         function
6486         | (_, (Always|If _|Unless _), test) -> Some test
6487         | (_, Disabled, _) -> None
6488       ) tests in
6489       let seq = List.concat (List.map seq_of_test tests) in
6490       let cmds_tested = List.map List.hd seq in
6491       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6492   ) all_functions;
6493
6494   List.iter (
6495     fun (name, _, _, _, _, _, _) ->
6496       if not (Hashtbl.mem hash name) then
6497         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6498   ) all_functions;
6499
6500   pr "}\n";
6501   pr "\n";
6502
6503   (* Generate the actual tests.  Note that we generate the tests
6504    * in reverse order, deliberately, so that (in general) the
6505    * newest tests run first.  This makes it quicker and easier to
6506    * debug them.
6507    *)
6508   let test_names =
6509     List.map (
6510       fun (name, _, _, flags, tests, _, _) ->
6511         mapi (generate_one_test name flags) tests
6512     ) (List.rev all_functions) in
6513   let test_names = List.concat test_names in
6514   let nr_tests = List.length test_names in
6515
6516   pr "\
6517 int main (int argc, char *argv[])
6518 {
6519   char c = 0;
6520   unsigned long int n_failed = 0;
6521   const char *filename;
6522   int fd;
6523   int nr_tests, test_num = 0;
6524
6525   setbuf (stdout, NULL);
6526
6527   no_test_warnings ();
6528
6529   g = guestfs_create ();
6530   if (g == NULL) {
6531     printf (\"guestfs_create FAILED\\n\");
6532     exit (EXIT_FAILURE);
6533   }
6534
6535   guestfs_set_error_handler (g, print_error, NULL);
6536
6537   guestfs_set_path (g, \"../appliance\");
6538
6539   filename = \"test1.img\";
6540   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6541   if (fd == -1) {
6542     perror (filename);
6543     exit (EXIT_FAILURE);
6544   }
6545   if (lseek (fd, %d, SEEK_SET) == -1) {
6546     perror (\"lseek\");
6547     close (fd);
6548     unlink (filename);
6549     exit (EXIT_FAILURE);
6550   }
6551   if (write (fd, &c, 1) == -1) {
6552     perror (\"write\");
6553     close (fd);
6554     unlink (filename);
6555     exit (EXIT_FAILURE);
6556   }
6557   if (close (fd) == -1) {
6558     perror (filename);
6559     unlink (filename);
6560     exit (EXIT_FAILURE);
6561   }
6562   if (guestfs_add_drive (g, filename) == -1) {
6563     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6564     exit (EXIT_FAILURE);
6565   }
6566
6567   filename = \"test2.img\";
6568   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6569   if (fd == -1) {
6570     perror (filename);
6571     exit (EXIT_FAILURE);
6572   }
6573   if (lseek (fd, %d, SEEK_SET) == -1) {
6574     perror (\"lseek\");
6575     close (fd);
6576     unlink (filename);
6577     exit (EXIT_FAILURE);
6578   }
6579   if (write (fd, &c, 1) == -1) {
6580     perror (\"write\");
6581     close (fd);
6582     unlink (filename);
6583     exit (EXIT_FAILURE);
6584   }
6585   if (close (fd) == -1) {
6586     perror (filename);
6587     unlink (filename);
6588     exit (EXIT_FAILURE);
6589   }
6590   if (guestfs_add_drive (g, filename) == -1) {
6591     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6592     exit (EXIT_FAILURE);
6593   }
6594
6595   filename = \"test3.img\";
6596   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6597   if (fd == -1) {
6598     perror (filename);
6599     exit (EXIT_FAILURE);
6600   }
6601   if (lseek (fd, %d, SEEK_SET) == -1) {
6602     perror (\"lseek\");
6603     close (fd);
6604     unlink (filename);
6605     exit (EXIT_FAILURE);
6606   }
6607   if (write (fd, &c, 1) == -1) {
6608     perror (\"write\");
6609     close (fd);
6610     unlink (filename);
6611     exit (EXIT_FAILURE);
6612   }
6613   if (close (fd) == -1) {
6614     perror (filename);
6615     unlink (filename);
6616     exit (EXIT_FAILURE);
6617   }
6618   if (guestfs_add_drive (g, filename) == -1) {
6619     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6620     exit (EXIT_FAILURE);
6621   }
6622
6623   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6624     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6625     exit (EXIT_FAILURE);
6626   }
6627
6628   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6629   alarm (600);
6630
6631   if (guestfs_launch (g) == -1) {
6632     printf (\"guestfs_launch FAILED\\n\");
6633     exit (EXIT_FAILURE);
6634   }
6635
6636   /* Cancel previous alarm. */
6637   alarm (0);
6638
6639   nr_tests = %d;
6640
6641 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6642
6643   iteri (
6644     fun i test_name ->
6645       pr "  test_num++;\n";
6646       pr "  if (guestfs_get_verbose (g))\n";
6647       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6648       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6649       pr "  if (%s () == -1) {\n" test_name;
6650       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6651       pr "    n_failed++;\n";
6652       pr "  }\n";
6653   ) test_names;
6654   pr "\n";
6655
6656   pr "  guestfs_close (g);\n";
6657   pr "  unlink (\"test1.img\");\n";
6658   pr "  unlink (\"test2.img\");\n";
6659   pr "  unlink (\"test3.img\");\n";
6660   pr "\n";
6661
6662   pr "  if (n_failed > 0) {\n";
6663   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6664   pr "    exit (EXIT_FAILURE);\n";
6665   pr "  }\n";
6666   pr "\n";
6667
6668   pr "  exit (EXIT_SUCCESS);\n";
6669   pr "}\n"
6670
6671 and generate_one_test name flags i (init, prereq, test) =
6672   let test_name = sprintf "test_%s_%d" name i in
6673
6674   pr "\
6675 static int %s_skip (void)
6676 {
6677   const char *str;
6678
6679   str = getenv (\"TEST_ONLY\");
6680   if (str)
6681     return strstr (str, \"%s\") == NULL;
6682   str = getenv (\"SKIP_%s\");
6683   if (str && STREQ (str, \"1\")) return 1;
6684   str = getenv (\"SKIP_TEST_%s\");
6685   if (str && STREQ (str, \"1\")) return 1;
6686   return 0;
6687 }
6688
6689 " test_name name (String.uppercase test_name) (String.uppercase name);
6690
6691   (match prereq with
6692    | Disabled | Always -> ()
6693    | If code | Unless code ->
6694        pr "static int %s_prereq (void)\n" test_name;
6695        pr "{\n";
6696        pr "  %s\n" code;
6697        pr "}\n";
6698        pr "\n";
6699   );
6700
6701   pr "\
6702 static int %s (void)
6703 {
6704   if (%s_skip ()) {
6705     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6706     return 0;
6707   }
6708
6709 " test_name test_name test_name;
6710
6711   (* Optional functions should only be tested if the relevant
6712    * support is available in the daemon.
6713    *)
6714   List.iter (
6715     function
6716     | Optional group ->
6717         pr "  if (!is_available (\"%s\")) {\n" group;
6718         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
6719         pr "    return 0;\n";
6720         pr "  }\n";
6721     | _ -> ()
6722   ) flags;
6723
6724   (match prereq with
6725    | Disabled ->
6726        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6727    | If _ ->
6728        pr "  if (! %s_prereq ()) {\n" test_name;
6729        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6730        pr "    return 0;\n";
6731        pr "  }\n";
6732        pr "\n";
6733        generate_one_test_body name i test_name init test;
6734    | Unless _ ->
6735        pr "  if (%s_prereq ()) {\n" test_name;
6736        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6737        pr "    return 0;\n";
6738        pr "  }\n";
6739        pr "\n";
6740        generate_one_test_body name i test_name init test;
6741    | Always ->
6742        generate_one_test_body name i test_name init test
6743   );
6744
6745   pr "  return 0;\n";
6746   pr "}\n";
6747   pr "\n";
6748   test_name
6749
6750 and generate_one_test_body name i test_name init test =
6751   (match init with
6752    | InitNone (* XXX at some point, InitNone and InitEmpty became
6753                * folded together as the same thing.  Really we should
6754                * make InitNone do nothing at all, but the tests may
6755                * need to be checked to make sure this is OK.
6756                *)
6757    | InitEmpty ->
6758        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6759        List.iter (generate_test_command_call test_name)
6760          [["blockdev_setrw"; "/dev/sda"];
6761           ["umount_all"];
6762           ["lvm_remove_all"]]
6763    | InitPartition ->
6764        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6765        List.iter (generate_test_command_call test_name)
6766          [["blockdev_setrw"; "/dev/sda"];
6767           ["umount_all"];
6768           ["lvm_remove_all"];
6769           ["part_disk"; "/dev/sda"; "mbr"]]
6770    | InitBasicFS ->
6771        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6772        List.iter (generate_test_command_call test_name)
6773          [["blockdev_setrw"; "/dev/sda"];
6774           ["umount_all"];
6775           ["lvm_remove_all"];
6776           ["part_disk"; "/dev/sda"; "mbr"];
6777           ["mkfs"; "ext2"; "/dev/sda1"];
6778           ["mount_options"; ""; "/dev/sda1"; "/"]]
6779    | InitBasicFSonLVM ->
6780        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6781          test_name;
6782        List.iter (generate_test_command_call test_name)
6783          [["blockdev_setrw"; "/dev/sda"];
6784           ["umount_all"];
6785           ["lvm_remove_all"];
6786           ["part_disk"; "/dev/sda"; "mbr"];
6787           ["pvcreate"; "/dev/sda1"];
6788           ["vgcreate"; "VG"; "/dev/sda1"];
6789           ["lvcreate"; "LV"; "VG"; "8"];
6790           ["mkfs"; "ext2"; "/dev/VG/LV"];
6791           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6792    | InitISOFS ->
6793        pr "  /* InitISOFS for %s */\n" test_name;
6794        List.iter (generate_test_command_call test_name)
6795          [["blockdev_setrw"; "/dev/sda"];
6796           ["umount_all"];
6797           ["lvm_remove_all"];
6798           ["mount_ro"; "/dev/sdd"; "/"]]
6799   );
6800
6801   let get_seq_last = function
6802     | [] ->
6803         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6804           test_name
6805     | seq ->
6806         let seq = List.rev seq in
6807         List.rev (List.tl seq), List.hd seq
6808   in
6809
6810   match test with
6811   | TestRun seq ->
6812       pr "  /* TestRun for %s (%d) */\n" name i;
6813       List.iter (generate_test_command_call test_name) seq
6814   | TestOutput (seq, expected) ->
6815       pr "  /* TestOutput for %s (%d) */\n" name i;
6816       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6817       let seq, last = get_seq_last seq in
6818       let test () =
6819         pr "    if (STRNEQ (r, expected)) {\n";
6820         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6821         pr "      return -1;\n";
6822         pr "    }\n"
6823       in
6824       List.iter (generate_test_command_call test_name) seq;
6825       generate_test_command_call ~test test_name last
6826   | TestOutputList (seq, expected) ->
6827       pr "  /* TestOutputList for %s (%d) */\n" name i;
6828       let seq, last = get_seq_last seq in
6829       let test () =
6830         iteri (
6831           fun i str ->
6832             pr "    if (!r[%d]) {\n" i;
6833             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6834             pr "      print_strings (r);\n";
6835             pr "      return -1;\n";
6836             pr "    }\n";
6837             pr "    {\n";
6838             pr "      const char *expected = \"%s\";\n" (c_quote str);
6839             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6840             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6841             pr "        return -1;\n";
6842             pr "      }\n";
6843             pr "    }\n"
6844         ) expected;
6845         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6846         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6847           test_name;
6848         pr "      print_strings (r);\n";
6849         pr "      return -1;\n";
6850         pr "    }\n"
6851       in
6852       List.iter (generate_test_command_call test_name) seq;
6853       generate_test_command_call ~test test_name last
6854   | TestOutputListOfDevices (seq, expected) ->
6855       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6856       let seq, last = get_seq_last seq in
6857       let test () =
6858         iteri (
6859           fun i str ->
6860             pr "    if (!r[%d]) {\n" i;
6861             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6862             pr "      print_strings (r);\n";
6863             pr "      return -1;\n";
6864             pr "    }\n";
6865             pr "    {\n";
6866             pr "      const char *expected = \"%s\";\n" (c_quote str);
6867             pr "      r[%d][5] = 's';\n" i;
6868             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6869             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6870             pr "        return -1;\n";
6871             pr "      }\n";
6872             pr "    }\n"
6873         ) expected;
6874         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6875         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6876           test_name;
6877         pr "      print_strings (r);\n";
6878         pr "      return -1;\n";
6879         pr "    }\n"
6880       in
6881       List.iter (generate_test_command_call test_name) seq;
6882       generate_test_command_call ~test test_name last
6883   | TestOutputInt (seq, expected) ->
6884       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6885       let seq, last = get_seq_last seq in
6886       let test () =
6887         pr "    if (r != %d) {\n" expected;
6888         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6889           test_name expected;
6890         pr "               (int) r);\n";
6891         pr "      return -1;\n";
6892         pr "    }\n"
6893       in
6894       List.iter (generate_test_command_call test_name) seq;
6895       generate_test_command_call ~test test_name last
6896   | TestOutputIntOp (seq, op, expected) ->
6897       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6898       let seq, last = get_seq_last seq in
6899       let test () =
6900         pr "    if (! (r %s %d)) {\n" op expected;
6901         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6902           test_name op expected;
6903         pr "               (int) r);\n";
6904         pr "      return -1;\n";
6905         pr "    }\n"
6906       in
6907       List.iter (generate_test_command_call test_name) seq;
6908       generate_test_command_call ~test test_name last
6909   | TestOutputTrue seq ->
6910       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6911       let seq, last = get_seq_last seq in
6912       let test () =
6913         pr "    if (!r) {\n";
6914         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6915           test_name;
6916         pr "      return -1;\n";
6917         pr "    }\n"
6918       in
6919       List.iter (generate_test_command_call test_name) seq;
6920       generate_test_command_call ~test test_name last
6921   | TestOutputFalse seq ->
6922       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6923       let seq, last = get_seq_last seq in
6924       let test () =
6925         pr "    if (r) {\n";
6926         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6927           test_name;
6928         pr "      return -1;\n";
6929         pr "    }\n"
6930       in
6931       List.iter (generate_test_command_call test_name) seq;
6932       generate_test_command_call ~test test_name last
6933   | TestOutputLength (seq, expected) ->
6934       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6935       let seq, last = get_seq_last seq in
6936       let test () =
6937         pr "    int j;\n";
6938         pr "    for (j = 0; j < %d; ++j)\n" expected;
6939         pr "      if (r[j] == NULL) {\n";
6940         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6941           test_name;
6942         pr "        print_strings (r);\n";
6943         pr "        return -1;\n";
6944         pr "      }\n";
6945         pr "    if (r[j] != NULL) {\n";
6946         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6947           test_name;
6948         pr "      print_strings (r);\n";
6949         pr "      return -1;\n";
6950         pr "    }\n"
6951       in
6952       List.iter (generate_test_command_call test_name) seq;
6953       generate_test_command_call ~test test_name last
6954   | TestOutputBuffer (seq, expected) ->
6955       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6956       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6957       let seq, last = get_seq_last seq in
6958       let len = String.length expected in
6959       let test () =
6960         pr "    if (size != %d) {\n" len;
6961         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6962         pr "      return -1;\n";
6963         pr "    }\n";
6964         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6965         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6966         pr "      return -1;\n";
6967         pr "    }\n"
6968       in
6969       List.iter (generate_test_command_call test_name) seq;
6970       generate_test_command_call ~test test_name last
6971   | TestOutputStruct (seq, checks) ->
6972       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6973       let seq, last = get_seq_last seq in
6974       let test () =
6975         List.iter (
6976           function
6977           | CompareWithInt (field, expected) ->
6978               pr "    if (r->%s != %d) {\n" field expected;
6979               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6980                 test_name field expected;
6981               pr "               (int) r->%s);\n" field;
6982               pr "      return -1;\n";
6983               pr "    }\n"
6984           | CompareWithIntOp (field, op, expected) ->
6985               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6986               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
6987                 test_name field op expected;
6988               pr "               (int) r->%s);\n" field;
6989               pr "      return -1;\n";
6990               pr "    }\n"
6991           | CompareWithString (field, expected) ->
6992               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
6993               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
6994                 test_name field expected;
6995               pr "               r->%s);\n" field;
6996               pr "      return -1;\n";
6997               pr "    }\n"
6998           | CompareFieldsIntEq (field1, field2) ->
6999               pr "    if (r->%s != r->%s) {\n" field1 field2;
7000               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
7001                 test_name field1 field2;
7002               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
7003               pr "      return -1;\n";
7004               pr "    }\n"
7005           | CompareFieldsStrEq (field1, field2) ->
7006               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
7007               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
7008                 test_name field1 field2;
7009               pr "               r->%s, r->%s);\n" field1 field2;
7010               pr "      return -1;\n";
7011               pr "    }\n"
7012         ) checks
7013       in
7014       List.iter (generate_test_command_call test_name) seq;
7015       generate_test_command_call ~test test_name last
7016   | TestLastFail seq ->
7017       pr "  /* TestLastFail for %s (%d) */\n" name i;
7018       let seq, last = get_seq_last seq in
7019       List.iter (generate_test_command_call test_name) seq;
7020       generate_test_command_call test_name ~expect_error:true last
7021
7022 (* Generate the code to run a command, leaving the result in 'r'.
7023  * If you expect to get an error then you should set expect_error:true.
7024  *)
7025 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
7026   match cmd with
7027   | [] -> assert false
7028   | name :: args ->
7029       (* Look up the command to find out what args/ret it has. *)
7030       let style =
7031         try
7032           let _, style, _, _, _, _, _ =
7033             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
7034           style
7035         with Not_found ->
7036           failwithf "%s: in test, command %s was not found" test_name name in
7037
7038       if List.length (snd style) <> List.length args then
7039         failwithf "%s: in test, wrong number of args given to %s"
7040           test_name name;
7041
7042       pr "  {\n";
7043
7044       List.iter (
7045         function
7046         | OptString n, "NULL" -> ()
7047         | Pathname n, arg
7048         | Device n, arg
7049         | Dev_or_Path n, arg
7050         | String n, arg
7051         | OptString n, arg ->
7052             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
7053         | Int _, _
7054         | Int64 _, _
7055         | Bool _, _
7056         | FileIn _, _ | FileOut _, _ -> ()
7057         | StringList n, "" | DeviceList n, "" ->
7058             pr "    const char *const %s[1] = { NULL };\n" n
7059         | StringList n, arg | DeviceList n, arg ->
7060             let strs = string_split " " arg in
7061             iteri (
7062               fun i str ->
7063                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7064             ) strs;
7065             pr "    const char *const %s[] = {\n" n;
7066             iteri (
7067               fun i _ -> pr "      %s_%d,\n" n i
7068             ) strs;
7069             pr "      NULL\n";
7070             pr "    };\n";
7071       ) (List.combine (snd style) args);
7072
7073       let error_code =
7074         match fst style with
7075         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7076         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7077         | RConstString _ | RConstOptString _ ->
7078             pr "    const char *r;\n"; "NULL"
7079         | RString _ -> pr "    char *r;\n"; "NULL"
7080         | RStringList _ | RHashtable _ ->
7081             pr "    char **r;\n";
7082             pr "    int i;\n";
7083             "NULL"
7084         | RStruct (_, typ) ->
7085             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7086         | RStructList (_, typ) ->
7087             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7088         | RBufferOut _ ->
7089             pr "    char *r;\n";
7090             pr "    size_t size;\n";
7091             "NULL" in
7092
7093       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7094       pr "    r = guestfs_%s (g" name;
7095
7096       (* Generate the parameters. *)
7097       List.iter (
7098         function
7099         | OptString _, "NULL" -> pr ", NULL"
7100         | Pathname n, _
7101         | Device n, _ | Dev_or_Path n, _
7102         | String n, _
7103         | OptString n, _ ->
7104             pr ", %s" n
7105         | FileIn _, arg | FileOut _, arg ->
7106             pr ", \"%s\"" (c_quote arg)
7107         | StringList n, _ | DeviceList n, _ ->
7108             pr ", (char **) %s" n
7109         | Int _, arg ->
7110             let i =
7111               try int_of_string arg
7112               with Failure "int_of_string" ->
7113                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7114             pr ", %d" i
7115         | Int64 _, arg ->
7116             let i =
7117               try Int64.of_string arg
7118               with Failure "int_of_string" ->
7119                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7120             pr ", %Ld" i
7121         | Bool _, arg ->
7122             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7123       ) (List.combine (snd style) args);
7124
7125       (match fst style with
7126        | RBufferOut _ -> pr ", &size"
7127        | _ -> ()
7128       );
7129
7130       pr ");\n";
7131
7132       if not expect_error then
7133         pr "    if (r == %s)\n" error_code
7134       else
7135         pr "    if (r != %s)\n" error_code;
7136       pr "      return -1;\n";
7137
7138       (* Insert the test code. *)
7139       (match test with
7140        | None -> ()
7141        | Some f -> f ()
7142       );
7143
7144       (match fst style with
7145        | RErr | RInt _ | RInt64 _ | RBool _
7146        | RConstString _ | RConstOptString _ -> ()
7147        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7148        | RStringList _ | RHashtable _ ->
7149            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7150            pr "      free (r[i]);\n";
7151            pr "    free (r);\n"
7152        | RStruct (_, typ) ->
7153            pr "    guestfs_free_%s (r);\n" typ
7154        | RStructList (_, typ) ->
7155            pr "    guestfs_free_%s_list (r);\n" typ
7156       );
7157
7158       pr "  }\n"
7159
7160 and c_quote str =
7161   let str = replace_str str "\r" "\\r" in
7162   let str = replace_str str "\n" "\\n" in
7163   let str = replace_str str "\t" "\\t" in
7164   let str = replace_str str "\000" "\\0" in
7165   str
7166
7167 (* Generate a lot of different functions for guestfish. *)
7168 and generate_fish_cmds () =
7169   generate_header CStyle GPLv2plus;
7170
7171   let all_functions =
7172     List.filter (
7173       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7174     ) all_functions in
7175   let all_functions_sorted =
7176     List.filter (
7177       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7178     ) all_functions_sorted in
7179
7180   pr "#include <config.h>\n";
7181   pr "\n";
7182   pr "#include <stdio.h>\n";
7183   pr "#include <stdlib.h>\n";
7184   pr "#include <string.h>\n";
7185   pr "#include <inttypes.h>\n";
7186   pr "\n";
7187   pr "#include <guestfs.h>\n";
7188   pr "#include \"c-ctype.h\"\n";
7189   pr "#include \"full-write.h\"\n";
7190   pr "#include \"xstrtol.h\"\n";
7191   pr "#include \"fish.h\"\n";
7192   pr "\n";
7193
7194   (* list_commands function, which implements guestfish -h *)
7195   pr "void list_commands (void)\n";
7196   pr "{\n";
7197   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7198   pr "  list_builtin_commands ();\n";
7199   List.iter (
7200     fun (name, _, _, flags, _, shortdesc, _) ->
7201       let name = replace_char name '_' '-' in
7202       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7203         name shortdesc
7204   ) all_functions_sorted;
7205   pr "  printf (\"    %%s\\n\",";
7206   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7207   pr "}\n";
7208   pr "\n";
7209
7210   (* display_command function, which implements guestfish -h cmd *)
7211   pr "int display_command (const char *cmd)\n";
7212   pr "{\n";
7213   List.iter (
7214     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7215       let name2 = replace_char name '_' '-' in
7216       let alias =
7217         try find_map (function FishAlias n -> Some n | _ -> None) flags
7218         with Not_found -> name in
7219       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7220       let synopsis =
7221         match snd style with
7222         | [] -> name2
7223         | args ->
7224             sprintf "%s %s"
7225               name2 (String.concat " " (List.map name_of_argt args)) in
7226
7227       let warnings =
7228         if List.mem ProtocolLimitWarning flags then
7229           ("\n\n" ^ protocol_limit_warning)
7230         else "" in
7231
7232       (* For DangerWillRobinson commands, we should probably have
7233        * guestfish prompt before allowing you to use them (especially
7234        * in interactive mode). XXX
7235        *)
7236       let warnings =
7237         warnings ^
7238           if List.mem DangerWillRobinson flags then
7239             ("\n\n" ^ danger_will_robinson)
7240           else "" in
7241
7242       let warnings =
7243         warnings ^
7244           match deprecation_notice flags with
7245           | None -> ""
7246           | Some txt -> "\n\n" ^ txt in
7247
7248       let describe_alias =
7249         if name <> alias then
7250           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7251         else "" in
7252
7253       pr "  if (";
7254       pr "STRCASEEQ (cmd, \"%s\")" name;
7255       if name <> name2 then
7256         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7257       if name <> alias then
7258         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7259       pr ") {\n";
7260       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7261         name2 shortdesc
7262         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7263          "=head1 DESCRIPTION\n\n" ^
7264          longdesc ^ warnings ^ describe_alias);
7265       pr "    return 0;\n";
7266       pr "  }\n";
7267       pr "  else\n"
7268   ) all_functions;
7269   pr "    return display_builtin_command (cmd);\n";
7270   pr "}\n";
7271   pr "\n";
7272
7273   let emit_print_list_function typ =
7274     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7275       typ typ typ;
7276     pr "{\n";
7277     pr "  unsigned int i;\n";
7278     pr "\n";
7279     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7280     pr "    printf (\"[%%d] = {\\n\", i);\n";
7281     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7282     pr "    printf (\"}\\n\");\n";
7283     pr "  }\n";
7284     pr "}\n";
7285     pr "\n";
7286   in
7287
7288   (* print_* functions *)
7289   List.iter (
7290     fun (typ, cols) ->
7291       let needs_i =
7292         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7293
7294       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7295       pr "{\n";
7296       if needs_i then (
7297         pr "  unsigned int i;\n";
7298         pr "\n"
7299       );
7300       List.iter (
7301         function
7302         | name, FString ->
7303             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7304         | name, FUUID ->
7305             pr "  printf (\"%%s%s: \", indent);\n" name;
7306             pr "  for (i = 0; i < 32; ++i)\n";
7307             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7308             pr "  printf (\"\\n\");\n"
7309         | name, FBuffer ->
7310             pr "  printf (\"%%s%s: \", indent);\n" name;
7311             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7312             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7313             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7314             pr "    else\n";
7315             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7316             pr "  printf (\"\\n\");\n"
7317         | name, (FUInt64|FBytes) ->
7318             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7319               name typ name
7320         | name, FInt64 ->
7321             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7322               name typ name
7323         | name, FUInt32 ->
7324             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7325               name typ name
7326         | name, FInt32 ->
7327             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7328               name typ name
7329         | name, FChar ->
7330             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7331               name typ name
7332         | name, FOptPercent ->
7333             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7334               typ name name typ name;
7335             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7336       ) cols;
7337       pr "}\n";
7338       pr "\n";
7339   ) structs;
7340
7341   (* Emit a print_TYPE_list function definition only if that function is used. *)
7342   List.iter (
7343     function
7344     | typ, (RStructListOnly | RStructAndList) ->
7345         (* generate the function for typ *)
7346         emit_print_list_function typ
7347     | typ, _ -> () (* empty *)
7348   ) (rstructs_used_by all_functions);
7349
7350   (* Emit a print_TYPE function definition only if that function is used. *)
7351   List.iter (
7352     function
7353     | typ, (RStructOnly | RStructAndList) ->
7354         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7355         pr "{\n";
7356         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7357         pr "}\n";
7358         pr "\n";
7359     | typ, _ -> () (* empty *)
7360   ) (rstructs_used_by all_functions);
7361
7362   (* run_<action> actions *)
7363   List.iter (
7364     fun (name, style, _, flags, _, _, _) ->
7365       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7366       pr "{\n";
7367       (match fst style with
7368        | RErr
7369        | RInt _
7370        | RBool _ -> pr "  int r;\n"
7371        | RInt64 _ -> pr "  int64_t r;\n"
7372        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7373        | RString _ -> pr "  char *r;\n"
7374        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7375        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7376        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7377        | RBufferOut _ ->
7378            pr "  char *r;\n";
7379            pr "  size_t size;\n";
7380       );
7381       List.iter (
7382         function
7383         | Device n
7384         | String n
7385         | OptString n
7386         | FileIn n
7387         | FileOut n -> pr "  const char *%s;\n" n
7388         | Pathname n
7389         | Dev_or_Path n -> pr "  char *%s;\n" n
7390         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7391         | Bool n -> pr "  int %s;\n" n
7392         | Int n -> pr "  int %s;\n" n
7393         | Int64 n -> pr "  int64_t %s;\n" n
7394       ) (snd style);
7395
7396       (* Check and convert parameters. *)
7397       let argc_expected = List.length (snd style) in
7398       pr "  if (argc != %d) {\n" argc_expected;
7399       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7400         argc_expected;
7401       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7402       pr "    return -1;\n";
7403       pr "  }\n";
7404
7405       let parse_integer fn fntyp rtyp range name i =
7406         pr "  {\n";
7407         pr "    strtol_error xerr;\n";
7408         pr "    %s r;\n" fntyp;
7409         pr "\n";
7410         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7411         pr "    if (xerr != LONGINT_OK) {\n";
7412         pr "      fprintf (stderr,\n";
7413         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7414         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7415         pr "      return -1;\n";
7416         pr "    }\n";
7417         (match range with
7418          | None -> ()
7419          | Some (min, max, comment) ->
7420              pr "    /* %s */\n" comment;
7421              pr "    if (r < %s || r > %s) {\n" min max;
7422              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7423                name;
7424              pr "      return -1;\n";
7425              pr "    }\n";
7426              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7427         );
7428         pr "    %s = r;\n" name;
7429         pr "  }\n";
7430       in
7431
7432       iteri (
7433         fun i ->
7434           function
7435           | Device name
7436           | String name ->
7437               pr "  %s = argv[%d];\n" name i
7438           | Pathname name
7439           | Dev_or_Path name ->
7440               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7441               pr "  if (%s == NULL) return -1;\n" name
7442           | OptString name ->
7443               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7444                 name i i
7445           | FileIn name ->
7446               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7447                 name i i
7448           | FileOut name ->
7449               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7450                 name i i
7451           | StringList name | DeviceList name ->
7452               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7453               pr "  if (%s == NULL) return -1;\n" name;
7454           | Bool name ->
7455               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7456           | Int name ->
7457               let range =
7458                 let min = "(-(2LL<<30))"
7459                 and max = "((2LL<<30)-1)"
7460                 and comment =
7461                   "The Int type in the generator is a signed 31 bit int." in
7462                 Some (min, max, comment) in
7463               parse_integer "xstrtoll" "long long" "int" range name i
7464           | Int64 name ->
7465               parse_integer "xstrtoll" "long long" "int64_t" None name i
7466       ) (snd style);
7467
7468       (* Call C API function. *)
7469       let fn =
7470         try find_map (function FishAction n -> Some n | _ -> None) flags
7471         with Not_found -> sprintf "guestfs_%s" name in
7472       pr "  r = %s " fn;
7473       generate_c_call_args ~handle:"g" style;
7474       pr ";\n";
7475
7476       List.iter (
7477         function
7478         | Device name | String name
7479         | OptString name | FileIn name | FileOut name | Bool name
7480         | Int name | Int64 name -> ()
7481         | Pathname name | Dev_or_Path name ->
7482             pr "  free (%s);\n" name
7483         | StringList name | DeviceList name ->
7484             pr "  free_strings (%s);\n" name
7485       ) (snd style);
7486
7487       (* Check return value for errors and display command results. *)
7488       (match fst style with
7489        | RErr -> pr "  return r;\n"
7490        | RInt _ ->
7491            pr "  if (r == -1) return -1;\n";
7492            pr "  printf (\"%%d\\n\", r);\n";
7493            pr "  return 0;\n"
7494        | RInt64 _ ->
7495            pr "  if (r == -1) return -1;\n";
7496            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7497            pr "  return 0;\n"
7498        | RBool _ ->
7499            pr "  if (r == -1) return -1;\n";
7500            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7501            pr "  return 0;\n"
7502        | RConstString _ ->
7503            pr "  if (r == NULL) return -1;\n";
7504            pr "  printf (\"%%s\\n\", r);\n";
7505            pr "  return 0;\n"
7506        | RConstOptString _ ->
7507            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7508            pr "  return 0;\n"
7509        | RString _ ->
7510            pr "  if (r == NULL) return -1;\n";
7511            pr "  printf (\"%%s\\n\", r);\n";
7512            pr "  free (r);\n";
7513            pr "  return 0;\n"
7514        | RStringList _ ->
7515            pr "  if (r == NULL) return -1;\n";
7516            pr "  print_strings (r);\n";
7517            pr "  free_strings (r);\n";
7518            pr "  return 0;\n"
7519        | RStruct (_, typ) ->
7520            pr "  if (r == NULL) return -1;\n";
7521            pr "  print_%s (r);\n" typ;
7522            pr "  guestfs_free_%s (r);\n" typ;
7523            pr "  return 0;\n"
7524        | RStructList (_, typ) ->
7525            pr "  if (r == NULL) return -1;\n";
7526            pr "  print_%s_list (r);\n" typ;
7527            pr "  guestfs_free_%s_list (r);\n" typ;
7528            pr "  return 0;\n"
7529        | RHashtable _ ->
7530            pr "  if (r == NULL) return -1;\n";
7531            pr "  print_table (r);\n";
7532            pr "  free_strings (r);\n";
7533            pr "  return 0;\n"
7534        | RBufferOut _ ->
7535            pr "  if (r == NULL) return -1;\n";
7536            pr "  if (full_write (1, r, size) != size) {\n";
7537            pr "    perror (\"write\");\n";
7538            pr "    free (r);\n";
7539            pr "    return -1;\n";
7540            pr "  }\n";
7541            pr "  free (r);\n";
7542            pr "  return 0;\n"
7543       );
7544       pr "}\n";
7545       pr "\n"
7546   ) all_functions;
7547
7548   (* run_action function *)
7549   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7550   pr "{\n";
7551   List.iter (
7552     fun (name, _, _, flags, _, _, _) ->
7553       let name2 = replace_char name '_' '-' in
7554       let alias =
7555         try find_map (function FishAlias n -> Some n | _ -> None) flags
7556         with Not_found -> name in
7557       pr "  if (";
7558       pr "STRCASEEQ (cmd, \"%s\")" name;
7559       if name <> name2 then
7560         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7561       if name <> alias then
7562         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7563       pr ")\n";
7564       pr "    return run_%s (cmd, argc, argv);\n" name;
7565       pr "  else\n";
7566   ) all_functions;
7567   pr "    {\n";
7568   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7569   pr "      if (command_num == 1)\n";
7570   pr "        extended_help_message ();\n";
7571   pr "      return -1;\n";
7572   pr "    }\n";
7573   pr "  return 0;\n";
7574   pr "}\n";
7575   pr "\n"
7576
7577 (* Readline completion for guestfish. *)
7578 and generate_fish_completion () =
7579   generate_header CStyle GPLv2plus;
7580
7581   let all_functions =
7582     List.filter (
7583       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7584     ) all_functions in
7585
7586   pr "\
7587 #include <config.h>
7588
7589 #include <stdio.h>
7590 #include <stdlib.h>
7591 #include <string.h>
7592
7593 #ifdef HAVE_LIBREADLINE
7594 #include <readline/readline.h>
7595 #endif
7596
7597 #include \"fish.h\"
7598
7599 #ifdef HAVE_LIBREADLINE
7600
7601 static const char *const commands[] = {
7602   BUILTIN_COMMANDS_FOR_COMPLETION,
7603 ";
7604
7605   (* Get the commands, including the aliases.  They don't need to be
7606    * sorted - the generator() function just does a dumb linear search.
7607    *)
7608   let commands =
7609     List.map (
7610       fun (name, _, _, flags, _, _, _) ->
7611         let name2 = replace_char name '_' '-' in
7612         let alias =
7613           try find_map (function FishAlias n -> Some n | _ -> None) flags
7614           with Not_found -> name in
7615
7616         if name <> alias then [name2; alias] else [name2]
7617     ) all_functions in
7618   let commands = List.flatten commands in
7619
7620   List.iter (pr "  \"%s\",\n") commands;
7621
7622   pr "  NULL
7623 };
7624
7625 static char *
7626 generator (const char *text, int state)
7627 {
7628   static int index, len;
7629   const char *name;
7630
7631   if (!state) {
7632     index = 0;
7633     len = strlen (text);
7634   }
7635
7636   rl_attempted_completion_over = 1;
7637
7638   while ((name = commands[index]) != NULL) {
7639     index++;
7640     if (STRCASEEQLEN (name, text, len))
7641       return strdup (name);
7642   }
7643
7644   return NULL;
7645 }
7646
7647 #endif /* HAVE_LIBREADLINE */
7648
7649 #ifdef HAVE_RL_COMPLETION_MATCHES
7650 #define RL_COMPLETION_MATCHES rl_completion_matches
7651 #else
7652 #ifdef HAVE_COMPLETION_MATCHES
7653 #define RL_COMPLETION_MATCHES completion_matches
7654 #endif
7655 #endif /* else just fail if we don't have either symbol */
7656
7657 char **
7658 do_completion (const char *text, int start, int end)
7659 {
7660   char **matches = NULL;
7661
7662 #ifdef HAVE_LIBREADLINE
7663   rl_completion_append_character = ' ';
7664
7665   if (start == 0)
7666     matches = RL_COMPLETION_MATCHES (text, generator);
7667   else if (complete_dest_paths)
7668     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7669 #endif
7670
7671   return matches;
7672 }
7673 ";
7674
7675 (* Generate the POD documentation for guestfish. *)
7676 and generate_fish_actions_pod () =
7677   let all_functions_sorted =
7678     List.filter (
7679       fun (_, _, _, flags, _, _, _) ->
7680         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7681     ) all_functions_sorted in
7682
7683   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7684
7685   List.iter (
7686     fun (name, style, _, flags, _, _, longdesc) ->
7687       let longdesc =
7688         Str.global_substitute rex (
7689           fun s ->
7690             let sub =
7691               try Str.matched_group 1 s
7692               with Not_found ->
7693                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7694             "C<" ^ replace_char sub '_' '-' ^ ">"
7695         ) longdesc in
7696       let name = replace_char name '_' '-' in
7697       let alias =
7698         try find_map (function FishAlias n -> Some n | _ -> None) flags
7699         with Not_found -> name in
7700
7701       pr "=head2 %s" name;
7702       if name <> alias then
7703         pr " | %s" alias;
7704       pr "\n";
7705       pr "\n";
7706       pr " %s" name;
7707       List.iter (
7708         function
7709         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7710         | OptString n -> pr " %s" n
7711         | StringList n | DeviceList n -> pr " '%s ...'" n
7712         | Bool _ -> pr " true|false"
7713         | Int n -> pr " %s" n
7714         | Int64 n -> pr " %s" n
7715         | FileIn n | FileOut n -> pr " (%s|-)" n
7716       ) (snd style);
7717       pr "\n";
7718       pr "\n";
7719       pr "%s\n\n" longdesc;
7720
7721       if List.exists (function FileIn _ | FileOut _ -> true
7722                       | _ -> false) (snd style) then
7723         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7724
7725       if List.mem ProtocolLimitWarning flags then
7726         pr "%s\n\n" protocol_limit_warning;
7727
7728       if List.mem DangerWillRobinson flags then
7729         pr "%s\n\n" danger_will_robinson;
7730
7731       match deprecation_notice flags with
7732       | None -> ()
7733       | Some txt -> pr "%s\n\n" txt
7734   ) all_functions_sorted
7735
7736 (* Generate a C function prototype. *)
7737 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7738     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7739     ?(prefix = "")
7740     ?handle name style =
7741   if extern then pr "extern ";
7742   if static then pr "static ";
7743   (match fst style with
7744    | RErr -> pr "int "
7745    | RInt _ -> pr "int "
7746    | RInt64 _ -> pr "int64_t "
7747    | RBool _ -> pr "int "
7748    | RConstString _ | RConstOptString _ -> pr "const char *"
7749    | RString _ | RBufferOut _ -> pr "char *"
7750    | RStringList _ | RHashtable _ -> pr "char **"
7751    | RStruct (_, typ) ->
7752        if not in_daemon then pr "struct guestfs_%s *" typ
7753        else pr "guestfs_int_%s *" typ
7754    | RStructList (_, typ) ->
7755        if not in_daemon then pr "struct guestfs_%s_list *" typ
7756        else pr "guestfs_int_%s_list *" typ
7757   );
7758   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7759   pr "%s%s (" prefix name;
7760   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7761     pr "void"
7762   else (
7763     let comma = ref false in
7764     (match handle with
7765      | None -> ()
7766      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7767     );
7768     let next () =
7769       if !comma then (
7770         if single_line then pr ", " else pr ",\n\t\t"
7771       );
7772       comma := true
7773     in
7774     List.iter (
7775       function
7776       | Pathname n
7777       | Device n | Dev_or_Path n
7778       | String n
7779       | OptString n ->
7780           next ();
7781           pr "const char *%s" n
7782       | StringList n | DeviceList n ->
7783           next ();
7784           pr "char *const *%s" n
7785       | Bool n -> next (); pr "int %s" n
7786       | Int n -> next (); pr "int %s" n
7787       | Int64 n -> next (); pr "int64_t %s" n
7788       | FileIn n
7789       | FileOut n ->
7790           if not in_daemon then (next (); pr "const char *%s" n)
7791     ) (snd style);
7792     if is_RBufferOut then (next (); pr "size_t *size_r");
7793   );
7794   pr ")";
7795   if semicolon then pr ";";
7796   if newline then pr "\n"
7797
7798 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7799 and generate_c_call_args ?handle ?(decl = false) style =
7800   pr "(";
7801   let comma = ref false in
7802   let next () =
7803     if !comma then pr ", ";
7804     comma := true
7805   in
7806   (match handle with
7807    | None -> ()
7808    | Some handle -> pr "%s" handle; comma := true
7809   );
7810   List.iter (
7811     fun arg ->
7812       next ();
7813       pr "%s" (name_of_argt arg)
7814   ) (snd style);
7815   (* For RBufferOut calls, add implicit &size parameter. *)
7816   if not decl then (
7817     match fst style with
7818     | RBufferOut _ ->
7819         next ();
7820         pr "&size"
7821     | _ -> ()
7822   );
7823   pr ")"
7824
7825 (* Generate the OCaml bindings interface. *)
7826 and generate_ocaml_mli () =
7827   generate_header OCamlStyle LGPLv2plus;
7828
7829   pr "\
7830 (** For API documentation you should refer to the C API
7831     in the guestfs(3) manual page.  The OCaml API uses almost
7832     exactly the same calls. *)
7833
7834 type t
7835 (** A [guestfs_h] handle. *)
7836
7837 exception Error of string
7838 (** This exception is raised when there is an error. *)
7839
7840 exception Handle_closed of string
7841 (** This exception is raised if you use a {!Guestfs.t} handle
7842     after calling {!close} on it.  The string is the name of
7843     the function. *)
7844
7845 val create : unit -> t
7846 (** Create a {!Guestfs.t} handle. *)
7847
7848 val close : t -> unit
7849 (** Close the {!Guestfs.t} handle and free up all resources used
7850     by it immediately.
7851
7852     Handles are closed by the garbage collector when they become
7853     unreferenced, but callers can call this in order to provide
7854     predictable cleanup. *)
7855
7856 ";
7857   generate_ocaml_structure_decls ();
7858
7859   (* The actions. *)
7860   List.iter (
7861     fun (name, style, _, _, _, shortdesc, _) ->
7862       generate_ocaml_prototype name style;
7863       pr "(** %s *)\n" shortdesc;
7864       pr "\n"
7865   ) all_functions_sorted
7866
7867 (* Generate the OCaml bindings implementation. *)
7868 and generate_ocaml_ml () =
7869   generate_header OCamlStyle LGPLv2plus;
7870
7871   pr "\
7872 type t
7873
7874 exception Error of string
7875 exception Handle_closed of string
7876
7877 external create : unit -> t = \"ocaml_guestfs_create\"
7878 external close : t -> unit = \"ocaml_guestfs_close\"
7879
7880 (* Give the exceptions names, so they can be raised from the C code. *)
7881 let () =
7882   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7883   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7884
7885 ";
7886
7887   generate_ocaml_structure_decls ();
7888
7889   (* The actions. *)
7890   List.iter (
7891     fun (name, style, _, _, _, shortdesc, _) ->
7892       generate_ocaml_prototype ~is_external:true name style;
7893   ) all_functions_sorted
7894
7895 (* Generate the OCaml bindings C implementation. *)
7896 and generate_ocaml_c () =
7897   generate_header CStyle LGPLv2plus;
7898
7899   pr "\
7900 #include <stdio.h>
7901 #include <stdlib.h>
7902 #include <string.h>
7903
7904 #include <caml/config.h>
7905 #include <caml/alloc.h>
7906 #include <caml/callback.h>
7907 #include <caml/fail.h>
7908 #include <caml/memory.h>
7909 #include <caml/mlvalues.h>
7910 #include <caml/signals.h>
7911
7912 #include <guestfs.h>
7913
7914 #include \"guestfs_c.h\"
7915
7916 /* Copy a hashtable of string pairs into an assoc-list.  We return
7917  * the list in reverse order, but hashtables aren't supposed to be
7918  * ordered anyway.
7919  */
7920 static CAMLprim value
7921 copy_table (char * const * argv)
7922 {
7923   CAMLparam0 ();
7924   CAMLlocal5 (rv, pairv, kv, vv, cons);
7925   int i;
7926
7927   rv = Val_int (0);
7928   for (i = 0; argv[i] != NULL; i += 2) {
7929     kv = caml_copy_string (argv[i]);
7930     vv = caml_copy_string (argv[i+1]);
7931     pairv = caml_alloc (2, 0);
7932     Store_field (pairv, 0, kv);
7933     Store_field (pairv, 1, vv);
7934     cons = caml_alloc (2, 0);
7935     Store_field (cons, 1, rv);
7936     rv = cons;
7937     Store_field (cons, 0, pairv);
7938   }
7939
7940   CAMLreturn (rv);
7941 }
7942
7943 ";
7944
7945   (* Struct copy functions. *)
7946
7947   let emit_ocaml_copy_list_function typ =
7948     pr "static CAMLprim value\n";
7949     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7950     pr "{\n";
7951     pr "  CAMLparam0 ();\n";
7952     pr "  CAMLlocal2 (rv, v);\n";
7953     pr "  unsigned int i;\n";
7954     pr "\n";
7955     pr "  if (%ss->len == 0)\n" typ;
7956     pr "    CAMLreturn (Atom (0));\n";
7957     pr "  else {\n";
7958     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7959     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7960     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7961     pr "      caml_modify (&Field (rv, i), v);\n";
7962     pr "    }\n";
7963     pr "    CAMLreturn (rv);\n";
7964     pr "  }\n";
7965     pr "}\n";
7966     pr "\n";
7967   in
7968
7969   List.iter (
7970     fun (typ, cols) ->
7971       let has_optpercent_col =
7972         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7973
7974       pr "static CAMLprim value\n";
7975       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7976       pr "{\n";
7977       pr "  CAMLparam0 ();\n";
7978       if has_optpercent_col then
7979         pr "  CAMLlocal3 (rv, v, v2);\n"
7980       else
7981         pr "  CAMLlocal2 (rv, v);\n";
7982       pr "\n";
7983       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7984       iteri (
7985         fun i col ->
7986           (match col with
7987            | name, FString ->
7988                pr "  v = caml_copy_string (%s->%s);\n" typ name
7989            | name, FBuffer ->
7990                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
7991                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
7992                  typ name typ name
7993            | name, FUUID ->
7994                pr "  v = caml_alloc_string (32);\n";
7995                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
7996            | name, (FBytes|FInt64|FUInt64) ->
7997                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
7998            | name, (FInt32|FUInt32) ->
7999                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
8000            | name, FOptPercent ->
8001                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
8002                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
8003                pr "    v = caml_alloc (1, 0);\n";
8004                pr "    Store_field (v, 0, v2);\n";
8005                pr "  } else /* None */\n";
8006                pr "    v = Val_int (0);\n";
8007            | name, FChar ->
8008                pr "  v = Val_int (%s->%s);\n" typ name
8009           );
8010           pr "  Store_field (rv, %d, v);\n" i
8011       ) cols;
8012       pr "  CAMLreturn (rv);\n";
8013       pr "}\n";
8014       pr "\n";
8015   ) structs;
8016
8017   (* Emit a copy_TYPE_list function definition only if that function is used. *)
8018   List.iter (
8019     function
8020     | typ, (RStructListOnly | RStructAndList) ->
8021         (* generate the function for typ *)
8022         emit_ocaml_copy_list_function typ
8023     | typ, _ -> () (* empty *)
8024   ) (rstructs_used_by all_functions);
8025
8026   (* The wrappers. *)
8027   List.iter (
8028     fun (name, style, _, _, _, _, _) ->
8029       pr "/* Automatically generated wrapper for function\n";
8030       pr " * ";
8031       generate_ocaml_prototype name style;
8032       pr " */\n";
8033       pr "\n";
8034
8035       let params =
8036         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
8037
8038       let needs_extra_vs =
8039         match fst style with RConstOptString _ -> true | _ -> false in
8040
8041       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8042       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
8043       List.iter (pr ", value %s") (List.tl params); pr ");\n";
8044       pr "\n";
8045
8046       pr "CAMLprim value\n";
8047       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
8048       List.iter (pr ", value %s") (List.tl params);
8049       pr ")\n";
8050       pr "{\n";
8051
8052       (match params with
8053        | [p1; p2; p3; p4; p5] ->
8054            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
8055        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
8056            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
8057            pr "  CAMLxparam%d (%s);\n"
8058              (List.length rest) (String.concat ", " rest)
8059        | ps ->
8060            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
8061       );
8062       if not needs_extra_vs then
8063         pr "  CAMLlocal1 (rv);\n"
8064       else
8065         pr "  CAMLlocal3 (rv, v, v2);\n";
8066       pr "\n";
8067
8068       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8069       pr "  if (g == NULL)\n";
8070       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8071       pr "\n";
8072
8073       List.iter (
8074         function
8075         | Pathname n
8076         | Device n | Dev_or_Path n
8077         | String n
8078         | FileIn n
8079         | FileOut n ->
8080             pr "  const char *%s = String_val (%sv);\n" n n
8081         | OptString n ->
8082             pr "  const char *%s =\n" n;
8083             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
8084               n n
8085         | StringList n | DeviceList n ->
8086             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8087         | Bool n ->
8088             pr "  int %s = Bool_val (%sv);\n" n n
8089         | Int n ->
8090             pr "  int %s = Int_val (%sv);\n" n n
8091         | Int64 n ->
8092             pr "  int64_t %s = Int64_val (%sv);\n" n n
8093       ) (snd style);
8094       let error_code =
8095         match fst style with
8096         | RErr -> pr "  int r;\n"; "-1"
8097         | RInt _ -> pr "  int r;\n"; "-1"
8098         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8099         | RBool _ -> pr "  int r;\n"; "-1"
8100         | RConstString _ | RConstOptString _ ->
8101             pr "  const char *r;\n"; "NULL"
8102         | RString _ -> pr "  char *r;\n"; "NULL"
8103         | RStringList _ ->
8104             pr "  int i;\n";
8105             pr "  char **r;\n";
8106             "NULL"
8107         | RStruct (_, typ) ->
8108             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8109         | RStructList (_, typ) ->
8110             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8111         | RHashtable _ ->
8112             pr "  int i;\n";
8113             pr "  char **r;\n";
8114             "NULL"
8115         | RBufferOut _ ->
8116             pr "  char *r;\n";
8117             pr "  size_t size;\n";
8118             "NULL" in
8119       pr "\n";
8120
8121       pr "  caml_enter_blocking_section ();\n";
8122       pr "  r = guestfs_%s " name;
8123       generate_c_call_args ~handle:"g" style;
8124       pr ";\n";
8125       pr "  caml_leave_blocking_section ();\n";
8126
8127       List.iter (
8128         function
8129         | StringList n | DeviceList n ->
8130             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8131         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8132         | Bool _ | Int _ | Int64 _
8133         | FileIn _ | FileOut _ -> ()
8134       ) (snd style);
8135
8136       pr "  if (r == %s)\n" error_code;
8137       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8138       pr "\n";
8139
8140       (match fst style with
8141        | RErr -> pr "  rv = Val_unit;\n"
8142        | RInt _ -> pr "  rv = Val_int (r);\n"
8143        | RInt64 _ ->
8144            pr "  rv = caml_copy_int64 (r);\n"
8145        | RBool _ -> pr "  rv = Val_bool (r);\n"
8146        | RConstString _ ->
8147            pr "  rv = caml_copy_string (r);\n"
8148        | RConstOptString _ ->
8149            pr "  if (r) { /* Some string */\n";
8150            pr "    v = caml_alloc (1, 0);\n";
8151            pr "    v2 = caml_copy_string (r);\n";
8152            pr "    Store_field (v, 0, v2);\n";
8153            pr "  } else /* None */\n";
8154            pr "    v = Val_int (0);\n";
8155        | RString _ ->
8156            pr "  rv = caml_copy_string (r);\n";
8157            pr "  free (r);\n"
8158        | RStringList _ ->
8159            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8160            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8161            pr "  free (r);\n"
8162        | RStruct (_, typ) ->
8163            pr "  rv = copy_%s (r);\n" typ;
8164            pr "  guestfs_free_%s (r);\n" typ;
8165        | RStructList (_, typ) ->
8166            pr "  rv = copy_%s_list (r);\n" typ;
8167            pr "  guestfs_free_%s_list (r);\n" typ;
8168        | RHashtable _ ->
8169            pr "  rv = copy_table (r);\n";
8170            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8171            pr "  free (r);\n";
8172        | RBufferOut _ ->
8173            pr "  rv = caml_alloc_string (size);\n";
8174            pr "  memcpy (String_val (rv), r, size);\n";
8175       );
8176
8177       pr "  CAMLreturn (rv);\n";
8178       pr "}\n";
8179       pr "\n";
8180
8181       if List.length params > 5 then (
8182         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8183         pr "CAMLprim value ";
8184         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8185         pr "CAMLprim value\n";
8186         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8187         pr "{\n";
8188         pr "  return ocaml_guestfs_%s (argv[0]" name;
8189         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8190         pr ");\n";
8191         pr "}\n";
8192         pr "\n"
8193       )
8194   ) all_functions_sorted
8195
8196 and generate_ocaml_structure_decls () =
8197   List.iter (
8198     fun (typ, cols) ->
8199       pr "type %s = {\n" typ;
8200       List.iter (
8201         function
8202         | name, FString -> pr "  %s : string;\n" name
8203         | name, FBuffer -> pr "  %s : string;\n" name
8204         | name, FUUID -> pr "  %s : string;\n" name
8205         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8206         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8207         | name, FChar -> pr "  %s : char;\n" name
8208         | name, FOptPercent -> pr "  %s : float option;\n" name
8209       ) cols;
8210       pr "}\n";
8211       pr "\n"
8212   ) structs
8213
8214 and generate_ocaml_prototype ?(is_external = false) name style =
8215   if is_external then pr "external " else pr "val ";
8216   pr "%s : t -> " name;
8217   List.iter (
8218     function
8219     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8220     | OptString _ -> pr "string option -> "
8221     | StringList _ | DeviceList _ -> pr "string array -> "
8222     | Bool _ -> pr "bool -> "
8223     | Int _ -> pr "int -> "
8224     | Int64 _ -> pr "int64 -> "
8225   ) (snd style);
8226   (match fst style with
8227    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8228    | RInt _ -> pr "int"
8229    | RInt64 _ -> pr "int64"
8230    | RBool _ -> pr "bool"
8231    | RConstString _ -> pr "string"
8232    | RConstOptString _ -> pr "string option"
8233    | RString _ | RBufferOut _ -> pr "string"
8234    | RStringList _ -> pr "string array"
8235    | RStruct (_, typ) -> pr "%s" typ
8236    | RStructList (_, typ) -> pr "%s array" typ
8237    | RHashtable _ -> pr "(string * string) list"
8238   );
8239   if is_external then (
8240     pr " = ";
8241     if List.length (snd style) + 1 > 5 then
8242       pr "\"ocaml_guestfs_%s_byte\" " name;
8243     pr "\"ocaml_guestfs_%s\"" name
8244   );
8245   pr "\n"
8246
8247 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8248 and generate_perl_xs () =
8249   generate_header CStyle LGPLv2plus;
8250
8251   pr "\
8252 #include \"EXTERN.h\"
8253 #include \"perl.h\"
8254 #include \"XSUB.h\"
8255
8256 #include <guestfs.h>
8257
8258 #ifndef PRId64
8259 #define PRId64 \"lld\"
8260 #endif
8261
8262 static SV *
8263 my_newSVll(long long val) {
8264 #ifdef USE_64_BIT_ALL
8265   return newSViv(val);
8266 #else
8267   char buf[100];
8268   int len;
8269   len = snprintf(buf, 100, \"%%\" PRId64, val);
8270   return newSVpv(buf, len);
8271 #endif
8272 }
8273
8274 #ifndef PRIu64
8275 #define PRIu64 \"llu\"
8276 #endif
8277
8278 static SV *
8279 my_newSVull(unsigned long long val) {
8280 #ifdef USE_64_BIT_ALL
8281   return newSVuv(val);
8282 #else
8283   char buf[100];
8284   int len;
8285   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8286   return newSVpv(buf, len);
8287 #endif
8288 }
8289
8290 /* http://www.perlmonks.org/?node_id=680842 */
8291 static char **
8292 XS_unpack_charPtrPtr (SV *arg) {
8293   char **ret;
8294   AV *av;
8295   I32 i;
8296
8297   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8298     croak (\"array reference expected\");
8299
8300   av = (AV *)SvRV (arg);
8301   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8302   if (!ret)
8303     croak (\"malloc failed\");
8304
8305   for (i = 0; i <= av_len (av); i++) {
8306     SV **elem = av_fetch (av, i, 0);
8307
8308     if (!elem || !*elem)
8309       croak (\"missing element in list\");
8310
8311     ret[i] = SvPV_nolen (*elem);
8312   }
8313
8314   ret[i] = NULL;
8315
8316   return ret;
8317 }
8318
8319 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8320
8321 PROTOTYPES: ENABLE
8322
8323 guestfs_h *
8324 _create ()
8325    CODE:
8326       RETVAL = guestfs_create ();
8327       if (!RETVAL)
8328         croak (\"could not create guestfs handle\");
8329       guestfs_set_error_handler (RETVAL, NULL, NULL);
8330  OUTPUT:
8331       RETVAL
8332
8333 void
8334 DESTROY (g)
8335       guestfs_h *g;
8336  PPCODE:
8337       guestfs_close (g);
8338
8339 ";
8340
8341   List.iter (
8342     fun (name, style, _, _, _, _, _) ->
8343       (match fst style with
8344        | RErr -> pr "void\n"
8345        | RInt _ -> pr "SV *\n"
8346        | RInt64 _ -> pr "SV *\n"
8347        | RBool _ -> pr "SV *\n"
8348        | RConstString _ -> pr "SV *\n"
8349        | RConstOptString _ -> pr "SV *\n"
8350        | RString _ -> pr "SV *\n"
8351        | RBufferOut _ -> pr "SV *\n"
8352        | RStringList _
8353        | RStruct _ | RStructList _
8354        | RHashtable _ ->
8355            pr "void\n" (* all lists returned implictly on the stack *)
8356       );
8357       (* Call and arguments. *)
8358       pr "%s " name;
8359       generate_c_call_args ~handle:"g" ~decl:true style;
8360       pr "\n";
8361       pr "      guestfs_h *g;\n";
8362       iteri (
8363         fun i ->
8364           function
8365           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8366               pr "      char *%s;\n" n
8367           | OptString n ->
8368               (* http://www.perlmonks.org/?node_id=554277
8369                * Note that the implicit handle argument means we have
8370                * to add 1 to the ST(x) operator.
8371                *)
8372               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8373           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8374           | Bool n -> pr "      int %s;\n" n
8375           | Int n -> pr "      int %s;\n" n
8376           | Int64 n -> pr "      int64_t %s;\n" n
8377       ) (snd style);
8378
8379       let do_cleanups () =
8380         List.iter (
8381           function
8382           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8383           | Bool _ | Int _ | Int64 _
8384           | FileIn _ | FileOut _ -> ()
8385           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8386         ) (snd style)
8387       in
8388
8389       (* Code. *)
8390       (match fst style with
8391        | RErr ->
8392            pr "PREINIT:\n";
8393            pr "      int r;\n";
8394            pr " PPCODE:\n";
8395            pr "      r = guestfs_%s " name;
8396            generate_c_call_args ~handle:"g" style;
8397            pr ";\n";
8398            do_cleanups ();
8399            pr "      if (r == -1)\n";
8400            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8401        | RInt n
8402        | RBool n ->
8403            pr "PREINIT:\n";
8404            pr "      int %s;\n" n;
8405            pr "   CODE:\n";
8406            pr "      %s = guestfs_%s " n name;
8407            generate_c_call_args ~handle:"g" style;
8408            pr ";\n";
8409            do_cleanups ();
8410            pr "      if (%s == -1)\n" n;
8411            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8412            pr "      RETVAL = newSViv (%s);\n" n;
8413            pr " OUTPUT:\n";
8414            pr "      RETVAL\n"
8415        | RInt64 n ->
8416            pr "PREINIT:\n";
8417            pr "      int64_t %s;\n" n;
8418            pr "   CODE:\n";
8419            pr "      %s = guestfs_%s " n name;
8420            generate_c_call_args ~handle:"g" style;
8421            pr ";\n";
8422            do_cleanups ();
8423            pr "      if (%s == -1)\n" n;
8424            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8425            pr "      RETVAL = my_newSVll (%s);\n" n;
8426            pr " OUTPUT:\n";
8427            pr "      RETVAL\n"
8428        | RConstString n ->
8429            pr "PREINIT:\n";
8430            pr "      const char *%s;\n" n;
8431            pr "   CODE:\n";
8432            pr "      %s = guestfs_%s " n name;
8433            generate_c_call_args ~handle:"g" style;
8434            pr ";\n";
8435            do_cleanups ();
8436            pr "      if (%s == NULL)\n" n;
8437            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8438            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8439            pr " OUTPUT:\n";
8440            pr "      RETVAL\n"
8441        | RConstOptString n ->
8442            pr "PREINIT:\n";
8443            pr "      const char *%s;\n" n;
8444            pr "   CODE:\n";
8445            pr "      %s = guestfs_%s " n name;
8446            generate_c_call_args ~handle:"g" style;
8447            pr ";\n";
8448            do_cleanups ();
8449            pr "      if (%s == NULL)\n" n;
8450            pr "        RETVAL = &PL_sv_undef;\n";
8451            pr "      else\n";
8452            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8453            pr " OUTPUT:\n";
8454            pr "      RETVAL\n"
8455        | RString n ->
8456            pr "PREINIT:\n";
8457            pr "      char *%s;\n" n;
8458            pr "   CODE:\n";
8459            pr "      %s = guestfs_%s " n name;
8460            generate_c_call_args ~handle:"g" style;
8461            pr ";\n";
8462            do_cleanups ();
8463            pr "      if (%s == NULL)\n" n;
8464            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8465            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8466            pr "      free (%s);\n" n;
8467            pr " OUTPUT:\n";
8468            pr "      RETVAL\n"
8469        | RStringList n | RHashtable n ->
8470            pr "PREINIT:\n";
8471            pr "      char **%s;\n" n;
8472            pr "      int i, n;\n";
8473            pr " PPCODE:\n";
8474            pr "      %s = guestfs_%s " n name;
8475            generate_c_call_args ~handle:"g" style;
8476            pr ";\n";
8477            do_cleanups ();
8478            pr "      if (%s == NULL)\n" n;
8479            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8480            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8481            pr "      EXTEND (SP, n);\n";
8482            pr "      for (i = 0; i < n; ++i) {\n";
8483            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8484            pr "        free (%s[i]);\n" n;
8485            pr "      }\n";
8486            pr "      free (%s);\n" n;
8487        | RStruct (n, typ) ->
8488            let cols = cols_of_struct typ in
8489            generate_perl_struct_code typ cols name style n do_cleanups
8490        | RStructList (n, typ) ->
8491            let cols = cols_of_struct typ in
8492            generate_perl_struct_list_code typ cols name style n do_cleanups
8493        | RBufferOut n ->
8494            pr "PREINIT:\n";
8495            pr "      char *%s;\n" n;
8496            pr "      size_t size;\n";
8497            pr "   CODE:\n";
8498            pr "      %s = guestfs_%s " n name;
8499            generate_c_call_args ~handle:"g" style;
8500            pr ";\n";
8501            do_cleanups ();
8502            pr "      if (%s == NULL)\n" n;
8503            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8504            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8505            pr "      free (%s);\n" n;
8506            pr " OUTPUT:\n";
8507            pr "      RETVAL\n"
8508       );
8509
8510       pr "\n"
8511   ) all_functions
8512
8513 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8514   pr "PREINIT:\n";
8515   pr "      struct guestfs_%s_list *%s;\n" typ n;
8516   pr "      int i;\n";
8517   pr "      HV *hv;\n";
8518   pr " PPCODE:\n";
8519   pr "      %s = guestfs_%s " n name;
8520   generate_c_call_args ~handle:"g" style;
8521   pr ";\n";
8522   do_cleanups ();
8523   pr "      if (%s == NULL)\n" n;
8524   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8525   pr "      EXTEND (SP, %s->len);\n" n;
8526   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8527   pr "        hv = newHV ();\n";
8528   List.iter (
8529     function
8530     | name, FString ->
8531         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8532           name (String.length name) n name
8533     | name, FUUID ->
8534         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8535           name (String.length name) n name
8536     | name, FBuffer ->
8537         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8538           name (String.length name) n name n name
8539     | name, (FBytes|FUInt64) ->
8540         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8541           name (String.length name) n name
8542     | name, FInt64 ->
8543         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8544           name (String.length name) n name
8545     | name, (FInt32|FUInt32) ->
8546         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8547           name (String.length name) n name
8548     | name, FChar ->
8549         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8550           name (String.length name) n name
8551     | name, FOptPercent ->
8552         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8553           name (String.length name) n name
8554   ) cols;
8555   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8556   pr "      }\n";
8557   pr "      guestfs_free_%s_list (%s);\n" typ n
8558
8559 and generate_perl_struct_code typ cols name style n do_cleanups =
8560   pr "PREINIT:\n";
8561   pr "      struct guestfs_%s *%s;\n" typ n;
8562   pr " PPCODE:\n";
8563   pr "      %s = guestfs_%s " n name;
8564   generate_c_call_args ~handle:"g" style;
8565   pr ";\n";
8566   do_cleanups ();
8567   pr "      if (%s == NULL)\n" n;
8568   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8569   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8570   List.iter (
8571     fun ((name, _) as col) ->
8572       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8573
8574       match col with
8575       | name, FString ->
8576           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8577             n name
8578       | name, FBuffer ->
8579           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8580             n name n name
8581       | name, FUUID ->
8582           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8583             n name
8584       | name, (FBytes|FUInt64) ->
8585           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8586             n name
8587       | name, FInt64 ->
8588           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8589             n name
8590       | name, (FInt32|FUInt32) ->
8591           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8592             n name
8593       | name, FChar ->
8594           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8595             n name
8596       | name, FOptPercent ->
8597           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8598             n name
8599   ) cols;
8600   pr "      free (%s);\n" n
8601
8602 (* Generate Sys/Guestfs.pm. *)
8603 and generate_perl_pm () =
8604   generate_header HashStyle LGPLv2plus;
8605
8606   pr "\
8607 =pod
8608
8609 =head1 NAME
8610
8611 Sys::Guestfs - Perl bindings for libguestfs
8612
8613 =head1 SYNOPSIS
8614
8615  use Sys::Guestfs;
8616
8617  my $h = Sys::Guestfs->new ();
8618  $h->add_drive ('guest.img');
8619  $h->launch ();
8620  $h->mount ('/dev/sda1', '/');
8621  $h->touch ('/hello');
8622  $h->sync ();
8623
8624 =head1 DESCRIPTION
8625
8626 The C<Sys::Guestfs> module provides a Perl XS binding to the
8627 libguestfs API for examining and modifying virtual machine
8628 disk images.
8629
8630 Amongst the things this is good for: making batch configuration
8631 changes to guests, getting disk used/free statistics (see also:
8632 virt-df), migrating between virtualization systems (see also:
8633 virt-p2v), performing partial backups, performing partial guest
8634 clones, cloning guests and changing registry/UUID/hostname info, and
8635 much else besides.
8636
8637 Libguestfs uses Linux kernel and qemu code, and can access any type of
8638 guest filesystem that Linux and qemu can, including but not limited
8639 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8640 schemes, qcow, qcow2, vmdk.
8641
8642 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8643 LVs, what filesystem is in each LV, etc.).  It can also run commands
8644 in the context of the guest.  Also you can access filesystems over
8645 FUSE.
8646
8647 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8648 functions for using libguestfs from Perl, including integration
8649 with libvirt.
8650
8651 =head1 ERRORS
8652
8653 All errors turn into calls to C<croak> (see L<Carp(3)>).
8654
8655 =head1 METHODS
8656
8657 =over 4
8658
8659 =cut
8660
8661 package Sys::Guestfs;
8662
8663 use strict;
8664 use warnings;
8665
8666 require XSLoader;
8667 XSLoader::load ('Sys::Guestfs');
8668
8669 =item $h = Sys::Guestfs->new ();
8670
8671 Create a new guestfs handle.
8672
8673 =cut
8674
8675 sub new {
8676   my $proto = shift;
8677   my $class = ref ($proto) || $proto;
8678
8679   my $self = Sys::Guestfs::_create ();
8680   bless $self, $class;
8681   return $self;
8682 }
8683
8684 ";
8685
8686   (* Actions.  We only need to print documentation for these as
8687    * they are pulled in from the XS code automatically.
8688    *)
8689   List.iter (
8690     fun (name, style, _, flags, _, _, longdesc) ->
8691       if not (List.mem NotInDocs flags) then (
8692         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8693         pr "=item ";
8694         generate_perl_prototype name style;
8695         pr "\n\n";
8696         pr "%s\n\n" longdesc;
8697         if List.mem ProtocolLimitWarning flags then
8698           pr "%s\n\n" protocol_limit_warning;
8699         if List.mem DangerWillRobinson flags then
8700           pr "%s\n\n" danger_will_robinson;
8701         match deprecation_notice flags with
8702         | None -> ()
8703         | Some txt -> pr "%s\n\n" txt
8704       )
8705   ) all_functions_sorted;
8706
8707   (* End of file. *)
8708   pr "\
8709 =cut
8710
8711 1;
8712
8713 =back
8714
8715 =head1 COPYRIGHT
8716
8717 Copyright (C) %s Red Hat Inc.
8718
8719 =head1 LICENSE
8720
8721 Please see the file COPYING.LIB for the full license.
8722
8723 =head1 SEE ALSO
8724
8725 L<guestfs(3)>,
8726 L<guestfish(1)>,
8727 L<http://libguestfs.org>,
8728 L<Sys::Guestfs::Lib(3)>.
8729
8730 =cut
8731 " copyright_years
8732
8733 and generate_perl_prototype name style =
8734   (match fst style with
8735    | RErr -> ()
8736    | RBool n
8737    | RInt n
8738    | RInt64 n
8739    | RConstString n
8740    | RConstOptString n
8741    | RString n
8742    | RBufferOut n -> pr "$%s = " n
8743    | RStruct (n,_)
8744    | RHashtable n -> pr "%%%s = " n
8745    | RStringList n
8746    | RStructList (n,_) -> pr "@%s = " n
8747   );
8748   pr "$h->%s (" name;
8749   let comma = ref false in
8750   List.iter (
8751     fun arg ->
8752       if !comma then pr ", ";
8753       comma := true;
8754       match arg with
8755       | Pathname n | Device n | Dev_or_Path n | String n
8756       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8757           pr "$%s" n
8758       | StringList n | DeviceList n ->
8759           pr "\\@%s" n
8760   ) (snd style);
8761   pr ");"
8762
8763 (* Generate Python C module. *)
8764 and generate_python_c () =
8765   generate_header CStyle LGPLv2plus;
8766
8767   pr "\
8768 #include <Python.h>
8769
8770 #include <stdio.h>
8771 #include <stdlib.h>
8772 #include <assert.h>
8773
8774 #include \"guestfs.h\"
8775
8776 typedef struct {
8777   PyObject_HEAD
8778   guestfs_h *g;
8779 } Pyguestfs_Object;
8780
8781 static guestfs_h *
8782 get_handle (PyObject *obj)
8783 {
8784   assert (obj);
8785   assert (obj != Py_None);
8786   return ((Pyguestfs_Object *) obj)->g;
8787 }
8788
8789 static PyObject *
8790 put_handle (guestfs_h *g)
8791 {
8792   assert (g);
8793   return
8794     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8795 }
8796
8797 /* This list should be freed (but not the strings) after use. */
8798 static char **
8799 get_string_list (PyObject *obj)
8800 {
8801   int i, len;
8802   char **r;
8803
8804   assert (obj);
8805
8806   if (!PyList_Check (obj)) {
8807     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8808     return NULL;
8809   }
8810
8811   len = PyList_Size (obj);
8812   r = malloc (sizeof (char *) * (len+1));
8813   if (r == NULL) {
8814     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8815     return NULL;
8816   }
8817
8818   for (i = 0; i < len; ++i)
8819     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8820   r[len] = NULL;
8821
8822   return r;
8823 }
8824
8825 static PyObject *
8826 put_string_list (char * const * const argv)
8827 {
8828   PyObject *list;
8829   int argc, i;
8830
8831   for (argc = 0; argv[argc] != NULL; ++argc)
8832     ;
8833
8834   list = PyList_New (argc);
8835   for (i = 0; i < argc; ++i)
8836     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8837
8838   return list;
8839 }
8840
8841 static PyObject *
8842 put_table (char * const * const argv)
8843 {
8844   PyObject *list, *item;
8845   int argc, i;
8846
8847   for (argc = 0; argv[argc] != NULL; ++argc)
8848     ;
8849
8850   list = PyList_New (argc >> 1);
8851   for (i = 0; i < argc; i += 2) {
8852     item = PyTuple_New (2);
8853     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8854     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8855     PyList_SetItem (list, i >> 1, item);
8856   }
8857
8858   return list;
8859 }
8860
8861 static void
8862 free_strings (char **argv)
8863 {
8864   int argc;
8865
8866   for (argc = 0; argv[argc] != NULL; ++argc)
8867     free (argv[argc]);
8868   free (argv);
8869 }
8870
8871 static PyObject *
8872 py_guestfs_create (PyObject *self, PyObject *args)
8873 {
8874   guestfs_h *g;
8875
8876   g = guestfs_create ();
8877   if (g == NULL) {
8878     PyErr_SetString (PyExc_RuntimeError,
8879                      \"guestfs.create: failed to allocate handle\");
8880     return NULL;
8881   }
8882   guestfs_set_error_handler (g, NULL, NULL);
8883   return put_handle (g);
8884 }
8885
8886 static PyObject *
8887 py_guestfs_close (PyObject *self, PyObject *args)
8888 {
8889   PyObject *py_g;
8890   guestfs_h *g;
8891
8892   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8893     return NULL;
8894   g = get_handle (py_g);
8895
8896   guestfs_close (g);
8897
8898   Py_INCREF (Py_None);
8899   return Py_None;
8900 }
8901
8902 ";
8903
8904   let emit_put_list_function typ =
8905     pr "static PyObject *\n";
8906     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8907     pr "{\n";
8908     pr "  PyObject *list;\n";
8909     pr "  int i;\n";
8910     pr "\n";
8911     pr "  list = PyList_New (%ss->len);\n" typ;
8912     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8913     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8914     pr "  return list;\n";
8915     pr "};\n";
8916     pr "\n"
8917   in
8918
8919   (* Structures, turned into Python dictionaries. *)
8920   List.iter (
8921     fun (typ, cols) ->
8922       pr "static PyObject *\n";
8923       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8924       pr "{\n";
8925       pr "  PyObject *dict;\n";
8926       pr "\n";
8927       pr "  dict = PyDict_New ();\n";
8928       List.iter (
8929         function
8930         | name, FString ->
8931             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8932             pr "                        PyString_FromString (%s->%s));\n"
8933               typ name
8934         | name, FBuffer ->
8935             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8936             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8937               typ name typ name
8938         | name, FUUID ->
8939             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8940             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8941               typ name
8942         | name, (FBytes|FUInt64) ->
8943             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8944             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8945               typ name
8946         | name, FInt64 ->
8947             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8948             pr "                        PyLong_FromLongLong (%s->%s));\n"
8949               typ name
8950         | name, FUInt32 ->
8951             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8952             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8953               typ name
8954         | name, FInt32 ->
8955             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8956             pr "                        PyLong_FromLong (%s->%s));\n"
8957               typ name
8958         | name, FOptPercent ->
8959             pr "  if (%s->%s >= 0)\n" typ name;
8960             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8961             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8962               typ name;
8963             pr "  else {\n";
8964             pr "    Py_INCREF (Py_None);\n";
8965             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8966             pr "  }\n"
8967         | name, FChar ->
8968             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8969             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8970       ) cols;
8971       pr "  return dict;\n";
8972       pr "};\n";
8973       pr "\n";
8974
8975   ) structs;
8976
8977   (* Emit a put_TYPE_list function definition only if that function is used. *)
8978   List.iter (
8979     function
8980     | typ, (RStructListOnly | RStructAndList) ->
8981         (* generate the function for typ *)
8982         emit_put_list_function typ
8983     | typ, _ -> () (* empty *)
8984   ) (rstructs_used_by all_functions);
8985
8986   (* Python wrapper functions. *)
8987   List.iter (
8988     fun (name, style, _, _, _, _, _) ->
8989       pr "static PyObject *\n";
8990       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
8991       pr "{\n";
8992
8993       pr "  PyObject *py_g;\n";
8994       pr "  guestfs_h *g;\n";
8995       pr "  PyObject *py_r;\n";
8996
8997       let error_code =
8998         match fst style with
8999         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9000         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9001         | RConstString _ | RConstOptString _ ->
9002             pr "  const char *r;\n"; "NULL"
9003         | RString _ -> pr "  char *r;\n"; "NULL"
9004         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9005         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9006         | RStructList (_, typ) ->
9007             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9008         | RBufferOut _ ->
9009             pr "  char *r;\n";
9010             pr "  size_t size;\n";
9011             "NULL" in
9012
9013       List.iter (
9014         function
9015         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9016             pr "  const char *%s;\n" n
9017         | OptString n -> pr "  const char *%s;\n" n
9018         | StringList n | DeviceList n ->
9019             pr "  PyObject *py_%s;\n" n;
9020             pr "  char **%s;\n" n
9021         | Bool n -> pr "  int %s;\n" n
9022         | Int n -> pr "  int %s;\n" n
9023         | Int64 n -> pr "  long long %s;\n" n
9024       ) (snd style);
9025
9026       pr "\n";
9027
9028       (* Convert the parameters. *)
9029       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
9030       List.iter (
9031         function
9032         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
9033         | OptString _ -> pr "z"
9034         | StringList _ | DeviceList _ -> pr "O"
9035         | Bool _ -> pr "i" (* XXX Python has booleans? *)
9036         | Int _ -> pr "i"
9037         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
9038                              * emulate C's int/long/long long in Python?
9039                              *)
9040       ) (snd style);
9041       pr ":guestfs_%s\",\n" name;
9042       pr "                         &py_g";
9043       List.iter (
9044         function
9045         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
9046         | OptString n -> pr ", &%s" n
9047         | StringList n | DeviceList n -> pr ", &py_%s" n
9048         | Bool n -> pr ", &%s" n
9049         | Int n -> pr ", &%s" n
9050         | Int64 n -> pr ", &%s" n
9051       ) (snd style);
9052
9053       pr "))\n";
9054       pr "    return NULL;\n";
9055
9056       pr "  g = get_handle (py_g);\n";
9057       List.iter (
9058         function
9059         | Pathname _ | Device _ | Dev_or_Path _ | String _
9060         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9061         | StringList n | DeviceList n ->
9062             pr "  %s = get_string_list (py_%s);\n" n n;
9063             pr "  if (!%s) return NULL;\n" n
9064       ) (snd style);
9065
9066       pr "\n";
9067
9068       pr "  r = guestfs_%s " name;
9069       generate_c_call_args ~handle:"g" style;
9070       pr ";\n";
9071
9072       List.iter (
9073         function
9074         | Pathname _ | Device _ | Dev_or_Path _ | String _
9075         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9076         | StringList n | DeviceList n ->
9077             pr "  free (%s);\n" n
9078       ) (snd style);
9079
9080       pr "  if (r == %s) {\n" error_code;
9081       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9082       pr "    return NULL;\n";
9083       pr "  }\n";
9084       pr "\n";
9085
9086       (match fst style with
9087        | RErr ->
9088            pr "  Py_INCREF (Py_None);\n";
9089            pr "  py_r = Py_None;\n"
9090        | RInt _
9091        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9092        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9093        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9094        | RConstOptString _ ->
9095            pr "  if (r)\n";
9096            pr "    py_r = PyString_FromString (r);\n";
9097            pr "  else {\n";
9098            pr "    Py_INCREF (Py_None);\n";
9099            pr "    py_r = Py_None;\n";
9100            pr "  }\n"
9101        | RString _ ->
9102            pr "  py_r = PyString_FromString (r);\n";
9103            pr "  free (r);\n"
9104        | RStringList _ ->
9105            pr "  py_r = put_string_list (r);\n";
9106            pr "  free_strings (r);\n"
9107        | RStruct (_, typ) ->
9108            pr "  py_r = put_%s (r);\n" typ;
9109            pr "  guestfs_free_%s (r);\n" typ
9110        | RStructList (_, typ) ->
9111            pr "  py_r = put_%s_list (r);\n" typ;
9112            pr "  guestfs_free_%s_list (r);\n" typ
9113        | RHashtable n ->
9114            pr "  py_r = put_table (r);\n";
9115            pr "  free_strings (r);\n"
9116        | RBufferOut _ ->
9117            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9118            pr "  free (r);\n"
9119       );
9120
9121       pr "  return py_r;\n";
9122       pr "}\n";
9123       pr "\n"
9124   ) all_functions;
9125
9126   (* Table of functions. *)
9127   pr "static PyMethodDef methods[] = {\n";
9128   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9129   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9130   List.iter (
9131     fun (name, _, _, _, _, _, _) ->
9132       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9133         name name
9134   ) all_functions;
9135   pr "  { NULL, NULL, 0, NULL }\n";
9136   pr "};\n";
9137   pr "\n";
9138
9139   (* Init function. *)
9140   pr "\
9141 void
9142 initlibguestfsmod (void)
9143 {
9144   static int initialized = 0;
9145
9146   if (initialized) return;
9147   Py_InitModule ((char *) \"libguestfsmod\", methods);
9148   initialized = 1;
9149 }
9150 "
9151
9152 (* Generate Python module. *)
9153 and generate_python_py () =
9154   generate_header HashStyle LGPLv2plus;
9155
9156   pr "\
9157 u\"\"\"Python bindings for libguestfs
9158
9159 import guestfs
9160 g = guestfs.GuestFS ()
9161 g.add_drive (\"guest.img\")
9162 g.launch ()
9163 parts = g.list_partitions ()
9164
9165 The guestfs module provides a Python binding to the libguestfs API
9166 for examining and modifying virtual machine disk images.
9167
9168 Amongst the things this is good for: making batch configuration
9169 changes to guests, getting disk used/free statistics (see also:
9170 virt-df), migrating between virtualization systems (see also:
9171 virt-p2v), performing partial backups, performing partial guest
9172 clones, cloning guests and changing registry/UUID/hostname info, and
9173 much else besides.
9174
9175 Libguestfs uses Linux kernel and qemu code, and can access any type of
9176 guest filesystem that Linux and qemu can, including but not limited
9177 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9178 schemes, qcow, qcow2, vmdk.
9179
9180 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9181 LVs, what filesystem is in each LV, etc.).  It can also run commands
9182 in the context of the guest.  Also you can access filesystems over
9183 FUSE.
9184
9185 Errors which happen while using the API are turned into Python
9186 RuntimeError exceptions.
9187
9188 To create a guestfs handle you usually have to perform the following
9189 sequence of calls:
9190
9191 # Create the handle, call add_drive at least once, and possibly
9192 # several times if the guest has multiple block devices:
9193 g = guestfs.GuestFS ()
9194 g.add_drive (\"guest.img\")
9195
9196 # Launch the qemu subprocess and wait for it to become ready:
9197 g.launch ()
9198
9199 # Now you can issue commands, for example:
9200 logvols = g.lvs ()
9201
9202 \"\"\"
9203
9204 import libguestfsmod
9205
9206 class GuestFS:
9207     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9208
9209     def __init__ (self):
9210         \"\"\"Create a new libguestfs handle.\"\"\"
9211         self._o = libguestfsmod.create ()
9212
9213     def __del__ (self):
9214         libguestfsmod.close (self._o)
9215
9216 ";
9217
9218   List.iter (
9219     fun (name, style, _, flags, _, _, longdesc) ->
9220       pr "    def %s " name;
9221       generate_py_call_args ~handle:"self" (snd style);
9222       pr ":\n";
9223
9224       if not (List.mem NotInDocs flags) then (
9225         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9226         let doc =
9227           match fst style with
9228           | RErr | RInt _ | RInt64 _ | RBool _
9229           | RConstOptString _ | RConstString _
9230           | RString _ | RBufferOut _ -> doc
9231           | RStringList _ ->
9232               doc ^ "\n\nThis function returns a list of strings."
9233           | RStruct (_, typ) ->
9234               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9235           | RStructList (_, typ) ->
9236               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9237           | RHashtable _ ->
9238               doc ^ "\n\nThis function returns a dictionary." in
9239         let doc =
9240           if List.mem ProtocolLimitWarning flags then
9241             doc ^ "\n\n" ^ protocol_limit_warning
9242           else doc in
9243         let doc =
9244           if List.mem DangerWillRobinson flags then
9245             doc ^ "\n\n" ^ danger_will_robinson
9246           else doc in
9247         let doc =
9248           match deprecation_notice flags with
9249           | None -> doc
9250           | Some txt -> doc ^ "\n\n" ^ txt in
9251         let doc = pod2text ~width:60 name doc in
9252         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9253         let doc = String.concat "\n        " doc in
9254         pr "        u\"\"\"%s\"\"\"\n" doc;
9255       );
9256       pr "        return libguestfsmod.%s " name;
9257       generate_py_call_args ~handle:"self._o" (snd style);
9258       pr "\n";
9259       pr "\n";
9260   ) all_functions
9261
9262 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9263 and generate_py_call_args ~handle args =
9264   pr "(%s" handle;
9265   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9266   pr ")"
9267
9268 (* Useful if you need the longdesc POD text as plain text.  Returns a
9269  * list of lines.
9270  *
9271  * Because this is very slow (the slowest part of autogeneration),
9272  * we memoize the results.
9273  *)
9274 and pod2text ~width name longdesc =
9275   let key = width, name, longdesc in
9276   try Hashtbl.find pod2text_memo key
9277   with Not_found ->
9278     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9279     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9280     close_out chan;
9281     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9282     let chan = open_process_in cmd in
9283     let lines = ref [] in
9284     let rec loop i =
9285       let line = input_line chan in
9286       if i = 1 then             (* discard the first line of output *)
9287         loop (i+1)
9288       else (
9289         let line = triml line in
9290         lines := line :: !lines;
9291         loop (i+1)
9292       ) in
9293     let lines = try loop 1 with End_of_file -> List.rev !lines in
9294     unlink filename;
9295     (match close_process_in chan with
9296      | WEXITED 0 -> ()
9297      | WEXITED i ->
9298          failwithf "pod2text: process exited with non-zero status (%d)" i
9299      | WSIGNALED i | WSTOPPED i ->
9300          failwithf "pod2text: process signalled or stopped by signal %d" i
9301     );
9302     Hashtbl.add pod2text_memo key lines;
9303     pod2text_memo_updated ();
9304     lines
9305
9306 (* Generate ruby bindings. *)
9307 and generate_ruby_c () =
9308   generate_header CStyle LGPLv2plus;
9309
9310   pr "\
9311 #include <stdio.h>
9312 #include <stdlib.h>
9313
9314 #include <ruby.h>
9315
9316 #include \"guestfs.h\"
9317
9318 #include \"extconf.h\"
9319
9320 /* For Ruby < 1.9 */
9321 #ifndef RARRAY_LEN
9322 #define RARRAY_LEN(r) (RARRAY((r))->len)
9323 #endif
9324
9325 static VALUE m_guestfs;                 /* guestfs module */
9326 static VALUE c_guestfs;                 /* guestfs_h handle */
9327 static VALUE e_Error;                   /* used for all errors */
9328
9329 static void ruby_guestfs_free (void *p)
9330 {
9331   if (!p) return;
9332   guestfs_close ((guestfs_h *) p);
9333 }
9334
9335 static VALUE ruby_guestfs_create (VALUE m)
9336 {
9337   guestfs_h *g;
9338
9339   g = guestfs_create ();
9340   if (!g)
9341     rb_raise (e_Error, \"failed to create guestfs handle\");
9342
9343   /* Don't print error messages to stderr by default. */
9344   guestfs_set_error_handler (g, NULL, NULL);
9345
9346   /* Wrap it, and make sure the close function is called when the
9347    * handle goes away.
9348    */
9349   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9350 }
9351
9352 static VALUE ruby_guestfs_close (VALUE gv)
9353 {
9354   guestfs_h *g;
9355   Data_Get_Struct (gv, guestfs_h, g);
9356
9357   ruby_guestfs_free (g);
9358   DATA_PTR (gv) = NULL;
9359
9360   return Qnil;
9361 }
9362
9363 ";
9364
9365   List.iter (
9366     fun (name, style, _, _, _, _, _) ->
9367       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9368       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9369       pr ")\n";
9370       pr "{\n";
9371       pr "  guestfs_h *g;\n";
9372       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9373       pr "  if (!g)\n";
9374       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9375         name;
9376       pr "\n";
9377
9378       List.iter (
9379         function
9380         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9381             pr "  Check_Type (%sv, T_STRING);\n" n;
9382             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9383             pr "  if (!%s)\n" n;
9384             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9385             pr "              \"%s\", \"%s\");\n" n name
9386         | OptString n ->
9387             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9388         | StringList n | DeviceList n ->
9389             pr "  char **%s;\n" n;
9390             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9391             pr "  {\n";
9392             pr "    int i, len;\n";
9393             pr "    len = RARRAY_LEN (%sv);\n" n;
9394             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9395               n;
9396             pr "    for (i = 0; i < len; ++i) {\n";
9397             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9398             pr "      %s[i] = StringValueCStr (v);\n" n;
9399             pr "    }\n";
9400             pr "    %s[len] = NULL;\n" n;
9401             pr "  }\n";
9402         | Bool n ->
9403             pr "  int %s = RTEST (%sv);\n" n n
9404         | Int n ->
9405             pr "  int %s = NUM2INT (%sv);\n" n n
9406         | Int64 n ->
9407             pr "  long long %s = NUM2LL (%sv);\n" n n
9408       ) (snd style);
9409       pr "\n";
9410
9411       let error_code =
9412         match fst style with
9413         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9414         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9415         | RConstString _ | RConstOptString _ ->
9416             pr "  const char *r;\n"; "NULL"
9417         | RString _ -> pr "  char *r;\n"; "NULL"
9418         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9419         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9420         | RStructList (_, typ) ->
9421             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9422         | RBufferOut _ ->
9423             pr "  char *r;\n";
9424             pr "  size_t size;\n";
9425             "NULL" in
9426       pr "\n";
9427
9428       pr "  r = guestfs_%s " name;
9429       generate_c_call_args ~handle:"g" style;
9430       pr ";\n";
9431
9432       List.iter (
9433         function
9434         | Pathname _ | Device _ | Dev_or_Path _ | String _
9435         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9436         | StringList n | DeviceList n ->
9437             pr "  free (%s);\n" n
9438       ) (snd style);
9439
9440       pr "  if (r == %s)\n" error_code;
9441       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9442       pr "\n";
9443
9444       (match fst style with
9445        | RErr ->
9446            pr "  return Qnil;\n"
9447        | RInt _ | RBool _ ->
9448            pr "  return INT2NUM (r);\n"
9449        | RInt64 _ ->
9450            pr "  return ULL2NUM (r);\n"
9451        | RConstString _ ->
9452            pr "  return rb_str_new2 (r);\n";
9453        | RConstOptString _ ->
9454            pr "  if (r)\n";
9455            pr "    return rb_str_new2 (r);\n";
9456            pr "  else\n";
9457            pr "    return Qnil;\n";
9458        | RString _ ->
9459            pr "  VALUE rv = rb_str_new2 (r);\n";
9460            pr "  free (r);\n";
9461            pr "  return rv;\n";
9462        | RStringList _ ->
9463            pr "  int i, len = 0;\n";
9464            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9465            pr "  VALUE rv = rb_ary_new2 (len);\n";
9466            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9467            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9468            pr "    free (r[i]);\n";
9469            pr "  }\n";
9470            pr "  free (r);\n";
9471            pr "  return rv;\n"
9472        | RStruct (_, typ) ->
9473            let cols = cols_of_struct typ in
9474            generate_ruby_struct_code typ cols
9475        | RStructList (_, typ) ->
9476            let cols = cols_of_struct typ in
9477            generate_ruby_struct_list_code typ cols
9478        | RHashtable _ ->
9479            pr "  VALUE rv = rb_hash_new ();\n";
9480            pr "  int i;\n";
9481            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9482            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9483            pr "    free (r[i]);\n";
9484            pr "    free (r[i+1]);\n";
9485            pr "  }\n";
9486            pr "  free (r);\n";
9487            pr "  return rv;\n"
9488        | RBufferOut _ ->
9489            pr "  VALUE rv = rb_str_new (r, size);\n";
9490            pr "  free (r);\n";
9491            pr "  return rv;\n";
9492       );
9493
9494       pr "}\n";
9495       pr "\n"
9496   ) all_functions;
9497
9498   pr "\
9499 /* Initialize the module. */
9500 void Init__guestfs ()
9501 {
9502   m_guestfs = rb_define_module (\"Guestfs\");
9503   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9504   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9505
9506   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9507   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9508
9509 ";
9510   (* Define the rest of the methods. *)
9511   List.iter (
9512     fun (name, style, _, _, _, _, _) ->
9513       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9514       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9515   ) all_functions;
9516
9517   pr "}\n"
9518
9519 (* Ruby code to return a struct. *)
9520 and generate_ruby_struct_code typ cols =
9521   pr "  VALUE rv = rb_hash_new ();\n";
9522   List.iter (
9523     function
9524     | name, FString ->
9525         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9526     | name, FBuffer ->
9527         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9528     | name, FUUID ->
9529         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9530     | name, (FBytes|FUInt64) ->
9531         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9532     | name, FInt64 ->
9533         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9534     | name, FUInt32 ->
9535         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9536     | name, FInt32 ->
9537         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9538     | name, FOptPercent ->
9539         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9540     | name, FChar -> (* XXX wrong? *)
9541         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9542   ) cols;
9543   pr "  guestfs_free_%s (r);\n" typ;
9544   pr "  return rv;\n"
9545
9546 (* Ruby code to return a struct list. *)
9547 and generate_ruby_struct_list_code typ cols =
9548   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9549   pr "  int i;\n";
9550   pr "  for (i = 0; i < r->len; ++i) {\n";
9551   pr "    VALUE hv = rb_hash_new ();\n";
9552   List.iter (
9553     function
9554     | name, FString ->
9555         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9556     | name, FBuffer ->
9557         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
9558     | name, FUUID ->
9559         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9560     | name, (FBytes|FUInt64) ->
9561         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9562     | name, FInt64 ->
9563         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9564     | name, FUInt32 ->
9565         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9566     | name, FInt32 ->
9567         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9568     | name, FOptPercent ->
9569         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9570     | name, FChar -> (* XXX wrong? *)
9571         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9572   ) cols;
9573   pr "    rb_ary_push (rv, hv);\n";
9574   pr "  }\n";
9575   pr "  guestfs_free_%s_list (r);\n" typ;
9576   pr "  return rv;\n"
9577
9578 (* Generate Java bindings GuestFS.java file. *)
9579 and generate_java_java () =
9580   generate_header CStyle LGPLv2plus;
9581
9582   pr "\
9583 package com.redhat.et.libguestfs;
9584
9585 import java.util.HashMap;
9586 import com.redhat.et.libguestfs.LibGuestFSException;
9587 import com.redhat.et.libguestfs.PV;
9588 import com.redhat.et.libguestfs.VG;
9589 import com.redhat.et.libguestfs.LV;
9590 import com.redhat.et.libguestfs.Stat;
9591 import com.redhat.et.libguestfs.StatVFS;
9592 import com.redhat.et.libguestfs.IntBool;
9593 import com.redhat.et.libguestfs.Dirent;
9594
9595 /**
9596  * The GuestFS object is a libguestfs handle.
9597  *
9598  * @author rjones
9599  */
9600 public class GuestFS {
9601   // Load the native code.
9602   static {
9603     System.loadLibrary (\"guestfs_jni\");
9604   }
9605
9606   /**
9607    * The native guestfs_h pointer.
9608    */
9609   long g;
9610
9611   /**
9612    * Create a libguestfs handle.
9613    *
9614    * @throws LibGuestFSException
9615    */
9616   public GuestFS () throws LibGuestFSException
9617   {
9618     g = _create ();
9619   }
9620   private native long _create () throws LibGuestFSException;
9621
9622   /**
9623    * Close a libguestfs handle.
9624    *
9625    * You can also leave handles to be collected by the garbage
9626    * collector, but this method ensures that the resources used
9627    * by the handle are freed up immediately.  If you call any
9628    * other methods after closing the handle, you will get an
9629    * exception.
9630    *
9631    * @throws LibGuestFSException
9632    */
9633   public void close () throws LibGuestFSException
9634   {
9635     if (g != 0)
9636       _close (g);
9637     g = 0;
9638   }
9639   private native void _close (long g) throws LibGuestFSException;
9640
9641   public void finalize () throws LibGuestFSException
9642   {
9643     close ();
9644   }
9645
9646 ";
9647
9648   List.iter (
9649     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9650       if not (List.mem NotInDocs flags); then (
9651         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9652         let doc =
9653           if List.mem ProtocolLimitWarning flags then
9654             doc ^ "\n\n" ^ protocol_limit_warning
9655           else doc in
9656         let doc =
9657           if List.mem DangerWillRobinson flags then
9658             doc ^ "\n\n" ^ danger_will_robinson
9659           else doc in
9660         let doc =
9661           match deprecation_notice flags with
9662           | None -> doc
9663           | Some txt -> doc ^ "\n\n" ^ txt in
9664         let doc = pod2text ~width:60 name doc in
9665         let doc = List.map (            (* RHBZ#501883 *)
9666           function
9667           | "" -> "<p>"
9668           | nonempty -> nonempty
9669         ) doc in
9670         let doc = String.concat "\n   * " doc in
9671
9672         pr "  /**\n";
9673         pr "   * %s\n" shortdesc;
9674         pr "   * <p>\n";
9675         pr "   * %s\n" doc;
9676         pr "   * @throws LibGuestFSException\n";
9677         pr "   */\n";
9678         pr "  ";
9679       );
9680       generate_java_prototype ~public:true ~semicolon:false name style;
9681       pr "\n";
9682       pr "  {\n";
9683       pr "    if (g == 0)\n";
9684       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9685         name;
9686       pr "    ";
9687       if fst style <> RErr then pr "return ";
9688       pr "_%s " name;
9689       generate_java_call_args ~handle:"g" (snd style);
9690       pr ";\n";
9691       pr "  }\n";
9692       pr "  ";
9693       generate_java_prototype ~privat:true ~native:true name style;
9694       pr "\n";
9695       pr "\n";
9696   ) all_functions;
9697
9698   pr "}\n"
9699
9700 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9701 and generate_java_call_args ~handle args =
9702   pr "(%s" handle;
9703   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9704   pr ")"
9705
9706 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9707     ?(semicolon=true) name style =
9708   if privat then pr "private ";
9709   if public then pr "public ";
9710   if native then pr "native ";
9711
9712   (* return type *)
9713   (match fst style with
9714    | RErr -> pr "void ";
9715    | RInt _ -> pr "int ";
9716    | RInt64 _ -> pr "long ";
9717    | RBool _ -> pr "boolean ";
9718    | RConstString _ | RConstOptString _ | RString _
9719    | RBufferOut _ -> pr "String ";
9720    | RStringList _ -> pr "String[] ";
9721    | RStruct (_, typ) ->
9722        let name = java_name_of_struct typ in
9723        pr "%s " name;
9724    | RStructList (_, typ) ->
9725        let name = java_name_of_struct typ in
9726        pr "%s[] " name;
9727    | RHashtable _ -> pr "HashMap<String,String> ";
9728   );
9729
9730   if native then pr "_%s " name else pr "%s " name;
9731   pr "(";
9732   let needs_comma = ref false in
9733   if native then (
9734     pr "long g";
9735     needs_comma := true
9736   );
9737
9738   (* args *)
9739   List.iter (
9740     fun arg ->
9741       if !needs_comma then pr ", ";
9742       needs_comma := true;
9743
9744       match arg with
9745       | Pathname n
9746       | Device n | Dev_or_Path n
9747       | String n
9748       | OptString n
9749       | FileIn n
9750       | FileOut n ->
9751           pr "String %s" n
9752       | StringList n | DeviceList n ->
9753           pr "String[] %s" n
9754       | Bool n ->
9755           pr "boolean %s" n
9756       | Int n ->
9757           pr "int %s" n
9758       | Int64 n ->
9759           pr "long %s" n
9760   ) (snd style);
9761
9762   pr ")\n";
9763   pr "    throws LibGuestFSException";
9764   if semicolon then pr ";"
9765
9766 and generate_java_struct jtyp cols () =
9767   generate_header CStyle LGPLv2plus;
9768
9769   pr "\
9770 package com.redhat.et.libguestfs;
9771
9772 /**
9773  * Libguestfs %s structure.
9774  *
9775  * @author rjones
9776  * @see GuestFS
9777  */
9778 public class %s {
9779 " jtyp jtyp;
9780
9781   List.iter (
9782     function
9783     | name, FString
9784     | name, FUUID
9785     | name, FBuffer -> pr "  public String %s;\n" name
9786     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9787     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9788     | name, FChar -> pr "  public char %s;\n" name
9789     | name, FOptPercent ->
9790         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9791         pr "  public float %s;\n" name
9792   ) cols;
9793
9794   pr "}\n"
9795
9796 and generate_java_c () =
9797   generate_header CStyle LGPLv2plus;
9798
9799   pr "\
9800 #include <stdio.h>
9801 #include <stdlib.h>
9802 #include <string.h>
9803
9804 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9805 #include \"guestfs.h\"
9806
9807 /* Note that this function returns.  The exception is not thrown
9808  * until after the wrapper function returns.
9809  */
9810 static void
9811 throw_exception (JNIEnv *env, const char *msg)
9812 {
9813   jclass cl;
9814   cl = (*env)->FindClass (env,
9815                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9816   (*env)->ThrowNew (env, cl, msg);
9817 }
9818
9819 JNIEXPORT jlong JNICALL
9820 Java_com_redhat_et_libguestfs_GuestFS__1create
9821   (JNIEnv *env, jobject obj)
9822 {
9823   guestfs_h *g;
9824
9825   g = guestfs_create ();
9826   if (g == NULL) {
9827     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9828     return 0;
9829   }
9830   guestfs_set_error_handler (g, NULL, NULL);
9831   return (jlong) (long) g;
9832 }
9833
9834 JNIEXPORT void JNICALL
9835 Java_com_redhat_et_libguestfs_GuestFS__1close
9836   (JNIEnv *env, jobject obj, jlong jg)
9837 {
9838   guestfs_h *g = (guestfs_h *) (long) jg;
9839   guestfs_close (g);
9840 }
9841
9842 ";
9843
9844   List.iter (
9845     fun (name, style, _, _, _, _, _) ->
9846       pr "JNIEXPORT ";
9847       (match fst style with
9848        | RErr -> pr "void ";
9849        | RInt _ -> pr "jint ";
9850        | RInt64 _ -> pr "jlong ";
9851        | RBool _ -> pr "jboolean ";
9852        | RConstString _ | RConstOptString _ | RString _
9853        | RBufferOut _ -> pr "jstring ";
9854        | RStruct _ | RHashtable _ ->
9855            pr "jobject ";
9856        | RStringList _ | RStructList _ ->
9857            pr "jobjectArray ";
9858       );
9859       pr "JNICALL\n";
9860       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9861       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9862       pr "\n";
9863       pr "  (JNIEnv *env, jobject obj, jlong jg";
9864       List.iter (
9865         function
9866         | Pathname n
9867         | Device n | Dev_or_Path n
9868         | String n
9869         | OptString n
9870         | FileIn n
9871         | FileOut n ->
9872             pr ", jstring j%s" n
9873         | StringList n | DeviceList n ->
9874             pr ", jobjectArray j%s" n
9875         | Bool n ->
9876             pr ", jboolean j%s" n
9877         | Int n ->
9878             pr ", jint j%s" n
9879         | Int64 n ->
9880             pr ", jlong j%s" n
9881       ) (snd style);
9882       pr ")\n";
9883       pr "{\n";
9884       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9885       let error_code, no_ret =
9886         match fst style with
9887         | RErr -> pr "  int r;\n"; "-1", ""
9888         | RBool _
9889         | RInt _ -> pr "  int r;\n"; "-1", "0"
9890         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9891         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9892         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9893         | RString _ ->
9894             pr "  jstring jr;\n";
9895             pr "  char *r;\n"; "NULL", "NULL"
9896         | RStringList _ ->
9897             pr "  jobjectArray jr;\n";
9898             pr "  int r_len;\n";
9899             pr "  jclass cl;\n";
9900             pr "  jstring jstr;\n";
9901             pr "  char **r;\n"; "NULL", "NULL"
9902         | RStruct (_, typ) ->
9903             pr "  jobject jr;\n";
9904             pr "  jclass cl;\n";
9905             pr "  jfieldID fl;\n";
9906             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9907         | RStructList (_, typ) ->
9908             pr "  jobjectArray jr;\n";
9909             pr "  jclass cl;\n";
9910             pr "  jfieldID fl;\n";
9911             pr "  jobject jfl;\n";
9912             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9913         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9914         | RBufferOut _ ->
9915             pr "  jstring jr;\n";
9916             pr "  char *r;\n";
9917             pr "  size_t size;\n";
9918             "NULL", "NULL" in
9919       List.iter (
9920         function
9921         | Pathname n
9922         | Device n | Dev_or_Path n
9923         | String n
9924         | OptString n
9925         | FileIn n
9926         | FileOut n ->
9927             pr "  const char *%s;\n" n
9928         | StringList n | DeviceList n ->
9929             pr "  int %s_len;\n" n;
9930             pr "  const char **%s;\n" n
9931         | Bool n
9932         | Int n ->
9933             pr "  int %s;\n" n
9934         | Int64 n ->
9935             pr "  int64_t %s;\n" n
9936       ) (snd style);
9937
9938       let needs_i =
9939         (match fst style with
9940          | RStringList _ | RStructList _ -> true
9941          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9942          | RConstOptString _
9943          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9944           List.exists (function
9945                        | StringList _ -> true
9946                        | DeviceList _ -> true
9947                        | _ -> false) (snd style) in
9948       if needs_i then
9949         pr "  int i;\n";
9950
9951       pr "\n";
9952
9953       (* Get the parameters. *)
9954       List.iter (
9955         function
9956         | Pathname n
9957         | Device n | Dev_or_Path n
9958         | String n
9959         | FileIn n
9960         | FileOut n ->
9961             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9962         | OptString n ->
9963             (* This is completely undocumented, but Java null becomes
9964              * a NULL parameter.
9965              *)
9966             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9967         | StringList n | DeviceList n ->
9968             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9969             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9970             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9971             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9972               n;
9973             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9974             pr "  }\n";
9975             pr "  %s[%s_len] = NULL;\n" n n;
9976         | Bool n
9977         | Int n
9978         | Int64 n ->
9979             pr "  %s = j%s;\n" n n
9980       ) (snd style);
9981
9982       (* Make the call. *)
9983       pr "  r = guestfs_%s " name;
9984       generate_c_call_args ~handle:"g" style;
9985       pr ";\n";
9986
9987       (* Release the parameters. *)
9988       List.iter (
9989         function
9990         | Pathname n
9991         | Device n | Dev_or_Path n
9992         | String n
9993         | FileIn n
9994         | FileOut n ->
9995             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9996         | OptString n ->
9997             pr "  if (j%s)\n" n;
9998             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9999         | StringList n | DeviceList n ->
10000             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
10001             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
10002               n;
10003             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
10004             pr "  }\n";
10005             pr "  free (%s);\n" n
10006         | Bool n
10007         | Int n
10008         | Int64 n -> ()
10009       ) (snd style);
10010
10011       (* Check for errors. *)
10012       pr "  if (r == %s) {\n" error_code;
10013       pr "    throw_exception (env, guestfs_last_error (g));\n";
10014       pr "    return %s;\n" no_ret;
10015       pr "  }\n";
10016
10017       (* Return value. *)
10018       (match fst style with
10019        | RErr -> ()
10020        | RInt _ -> pr "  return (jint) r;\n"
10021        | RBool _ -> pr "  return (jboolean) r;\n"
10022        | RInt64 _ -> pr "  return (jlong) r;\n"
10023        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
10024        | RConstOptString _ ->
10025            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
10026        | RString _ ->
10027            pr "  jr = (*env)->NewStringUTF (env, r);\n";
10028            pr "  free (r);\n";
10029            pr "  return jr;\n"
10030        | RStringList _ ->
10031            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
10032            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
10033            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
10034            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
10035            pr "  for (i = 0; i < r_len; ++i) {\n";
10036            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
10037            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
10038            pr "    free (r[i]);\n";
10039            pr "  }\n";
10040            pr "  free (r);\n";
10041            pr "  return jr;\n"
10042        | RStruct (_, typ) ->
10043            let jtyp = java_name_of_struct typ in
10044            let cols = cols_of_struct typ in
10045            generate_java_struct_return typ jtyp cols
10046        | RStructList (_, typ) ->
10047            let jtyp = java_name_of_struct typ in
10048            let cols = cols_of_struct typ in
10049            generate_java_struct_list_return typ jtyp cols
10050        | RHashtable _ ->
10051            (* XXX *)
10052            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
10053            pr "  return NULL;\n"
10054        | RBufferOut _ ->
10055            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
10056            pr "  free (r);\n";
10057            pr "  return jr;\n"
10058       );
10059
10060       pr "}\n";
10061       pr "\n"
10062   ) all_functions
10063
10064 and generate_java_struct_return typ jtyp cols =
10065   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10066   pr "  jr = (*env)->AllocObject (env, cl);\n";
10067   List.iter (
10068     function
10069     | name, FString ->
10070         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10071         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10072     | name, FUUID ->
10073         pr "  {\n";
10074         pr "    char s[33];\n";
10075         pr "    memcpy (s, r->%s, 32);\n" name;
10076         pr "    s[32] = 0;\n";
10077         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10078         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10079         pr "  }\n";
10080     | name, FBuffer ->
10081         pr "  {\n";
10082         pr "    int len = r->%s_len;\n" name;
10083         pr "    char s[len+1];\n";
10084         pr "    memcpy (s, r->%s, len);\n" name;
10085         pr "    s[len] = 0;\n";
10086         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10087         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10088         pr "  }\n";
10089     | name, (FBytes|FUInt64|FInt64) ->
10090         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10091         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10092     | name, (FUInt32|FInt32) ->
10093         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10094         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10095     | name, FOptPercent ->
10096         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10097         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10098     | name, FChar ->
10099         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10100         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10101   ) cols;
10102   pr "  free (r);\n";
10103   pr "  return jr;\n"
10104
10105 and generate_java_struct_list_return typ jtyp cols =
10106   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10107   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10108   pr "  for (i = 0; i < r->len; ++i) {\n";
10109   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10110   List.iter (
10111     function
10112     | name, FString ->
10113         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10114         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10115     | name, FUUID ->
10116         pr "    {\n";
10117         pr "      char s[33];\n";
10118         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10119         pr "      s[32] = 0;\n";
10120         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10121         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10122         pr "    }\n";
10123     | name, FBuffer ->
10124         pr "    {\n";
10125         pr "      int len = r->val[i].%s_len;\n" name;
10126         pr "      char s[len+1];\n";
10127         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10128         pr "      s[len] = 0;\n";
10129         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10130         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10131         pr "    }\n";
10132     | name, (FBytes|FUInt64|FInt64) ->
10133         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10134         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10135     | name, (FUInt32|FInt32) ->
10136         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10137         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10138     | name, FOptPercent ->
10139         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10140         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10141     | name, FChar ->
10142         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10143         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10144   ) cols;
10145   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10146   pr "  }\n";
10147   pr "  guestfs_free_%s_list (r);\n" typ;
10148   pr "  return jr;\n"
10149
10150 and generate_java_makefile_inc () =
10151   generate_header HashStyle GPLv2plus;
10152
10153   pr "java_built_sources = \\\n";
10154   List.iter (
10155     fun (typ, jtyp) ->
10156         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10157   ) java_structs;
10158   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10159
10160 and generate_haskell_hs () =
10161   generate_header HaskellStyle LGPLv2plus;
10162
10163   (* XXX We only know how to generate partial FFI for Haskell
10164    * at the moment.  Please help out!
10165    *)
10166   let can_generate style =
10167     match style with
10168     | RErr, _
10169     | RInt _, _
10170     | RInt64 _, _ -> true
10171     | RBool _, _
10172     | RConstString _, _
10173     | RConstOptString _, _
10174     | RString _, _
10175     | RStringList _, _
10176     | RStruct _, _
10177     | RStructList _, _
10178     | RHashtable _, _
10179     | RBufferOut _, _ -> false in
10180
10181   pr "\
10182 {-# INCLUDE <guestfs.h> #-}
10183 {-# LANGUAGE ForeignFunctionInterface #-}
10184
10185 module Guestfs (
10186   create";
10187
10188   (* List out the names of the actions we want to export. *)
10189   List.iter (
10190     fun (name, style, _, _, _, _, _) ->
10191       if can_generate style then pr ",\n  %s" name
10192   ) all_functions;
10193
10194   pr "
10195   ) where
10196
10197 -- Unfortunately some symbols duplicate ones already present
10198 -- in Prelude.  We don't know which, so we hard-code a list
10199 -- here.
10200 import Prelude hiding (truncate)
10201
10202 import Foreign
10203 import Foreign.C
10204 import Foreign.C.Types
10205 import IO
10206 import Control.Exception
10207 import Data.Typeable
10208
10209 data GuestfsS = GuestfsS            -- represents the opaque C struct
10210 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10211 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10212
10213 -- XXX define properly later XXX
10214 data PV = PV
10215 data VG = VG
10216 data LV = LV
10217 data IntBool = IntBool
10218 data Stat = Stat
10219 data StatVFS = StatVFS
10220 data Hashtable = Hashtable
10221
10222 foreign import ccall unsafe \"guestfs_create\" c_create
10223   :: IO GuestfsP
10224 foreign import ccall unsafe \"&guestfs_close\" c_close
10225   :: FunPtr (GuestfsP -> IO ())
10226 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10227   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10228
10229 create :: IO GuestfsH
10230 create = do
10231   p <- c_create
10232   c_set_error_handler p nullPtr nullPtr
10233   h <- newForeignPtr c_close p
10234   return h
10235
10236 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10237   :: GuestfsP -> IO CString
10238
10239 -- last_error :: GuestfsH -> IO (Maybe String)
10240 -- last_error h = do
10241 --   str <- withForeignPtr h (\\p -> c_last_error p)
10242 --   maybePeek peekCString str
10243
10244 last_error :: GuestfsH -> IO (String)
10245 last_error h = do
10246   str <- withForeignPtr h (\\p -> c_last_error p)
10247   if (str == nullPtr)
10248     then return \"no error\"
10249     else peekCString str
10250
10251 ";
10252
10253   (* Generate wrappers for each foreign function. *)
10254   List.iter (
10255     fun (name, style, _, _, _, _, _) ->
10256       if can_generate style then (
10257         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10258         pr "  :: ";
10259         generate_haskell_prototype ~handle:"GuestfsP" style;
10260         pr "\n";
10261         pr "\n";
10262         pr "%s :: " name;
10263         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10264         pr "\n";
10265         pr "%s %s = do\n" name
10266           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10267         pr "  r <- ";
10268         (* Convert pointer arguments using with* functions. *)
10269         List.iter (
10270           function
10271           | FileIn n
10272           | FileOut n
10273           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10274           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10275           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10276           | Bool _ | Int _ | Int64 _ -> ()
10277         ) (snd style);
10278         (* Convert integer arguments. *)
10279         let args =
10280           List.map (
10281             function
10282             | Bool n -> sprintf "(fromBool %s)" n
10283             | Int n -> sprintf "(fromIntegral %s)" n
10284             | Int64 n -> sprintf "(fromIntegral %s)" n
10285             | FileIn n | FileOut n
10286             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10287           ) (snd style) in
10288         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10289           (String.concat " " ("p" :: args));
10290         (match fst style with
10291          | RErr | RInt _ | RInt64 _ | RBool _ ->
10292              pr "  if (r == -1)\n";
10293              pr "    then do\n";
10294              pr "      err <- last_error h\n";
10295              pr "      fail err\n";
10296          | RConstString _ | RConstOptString _ | RString _
10297          | RStringList _ | RStruct _
10298          | RStructList _ | RHashtable _ | RBufferOut _ ->
10299              pr "  if (r == nullPtr)\n";
10300              pr "    then do\n";
10301              pr "      err <- last_error h\n";
10302              pr "      fail err\n";
10303         );
10304         (match fst style with
10305          | RErr ->
10306              pr "    else return ()\n"
10307          | RInt _ ->
10308              pr "    else return (fromIntegral r)\n"
10309          | RInt64 _ ->
10310              pr "    else return (fromIntegral r)\n"
10311          | RBool _ ->
10312              pr "    else return (toBool r)\n"
10313          | RConstString _
10314          | RConstOptString _
10315          | RString _
10316          | RStringList _
10317          | RStruct _
10318          | RStructList _
10319          | RHashtable _
10320          | RBufferOut _ ->
10321              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10322         );
10323         pr "\n";
10324       )
10325   ) all_functions
10326
10327 and generate_haskell_prototype ~handle ?(hs = false) style =
10328   pr "%s -> " handle;
10329   let string = if hs then "String" else "CString" in
10330   let int = if hs then "Int" else "CInt" in
10331   let bool = if hs then "Bool" else "CInt" in
10332   let int64 = if hs then "Integer" else "Int64" in
10333   List.iter (
10334     fun arg ->
10335       (match arg with
10336        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10337        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10338        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10339        | Bool _ -> pr "%s" bool
10340        | Int _ -> pr "%s" int
10341        | Int64 _ -> pr "%s" int
10342        | FileIn _ -> pr "%s" string
10343        | FileOut _ -> pr "%s" string
10344       );
10345       pr " -> ";
10346   ) (snd style);
10347   pr "IO (";
10348   (match fst style with
10349    | RErr -> if not hs then pr "CInt"
10350    | RInt _ -> pr "%s" int
10351    | RInt64 _ -> pr "%s" int64
10352    | RBool _ -> pr "%s" bool
10353    | RConstString _ -> pr "%s" string
10354    | RConstOptString _ -> pr "Maybe %s" string
10355    | RString _ -> pr "%s" string
10356    | RStringList _ -> pr "[%s]" string
10357    | RStruct (_, typ) ->
10358        let name = java_name_of_struct typ in
10359        pr "%s" name
10360    | RStructList (_, typ) ->
10361        let name = java_name_of_struct typ in
10362        pr "[%s]" name
10363    | RHashtable _ -> pr "Hashtable"
10364    | RBufferOut _ -> pr "%s" string
10365   );
10366   pr ")"
10367
10368 and generate_csharp () =
10369   generate_header CPlusPlusStyle LGPLv2plus;
10370
10371   (* XXX Make this configurable by the C# assembly users. *)
10372   let library = "libguestfs.so.0" in
10373
10374   pr "\
10375 // These C# bindings are highly experimental at present.
10376 //
10377 // Firstly they only work on Linux (ie. Mono).  In order to get them
10378 // to work on Windows (ie. .Net) you would need to port the library
10379 // itself to Windows first.
10380 //
10381 // The second issue is that some calls are known to be incorrect and
10382 // can cause Mono to segfault.  Particularly: calls which pass or
10383 // return string[], or return any structure value.  This is because
10384 // we haven't worked out the correct way to do this from C#.
10385 //
10386 // The third issue is that when compiling you get a lot of warnings.
10387 // We are not sure whether the warnings are important or not.
10388 //
10389 // Fourthly we do not routinely build or test these bindings as part
10390 // of the make && make check cycle, which means that regressions might
10391 // go unnoticed.
10392 //
10393 // Suggestions and patches are welcome.
10394
10395 // To compile:
10396 //
10397 // gmcs Libguestfs.cs
10398 // mono Libguestfs.exe
10399 //
10400 // (You'll probably want to add a Test class / static main function
10401 // otherwise this won't do anything useful).
10402
10403 using System;
10404 using System.IO;
10405 using System.Runtime.InteropServices;
10406 using System.Runtime.Serialization;
10407 using System.Collections;
10408
10409 namespace Guestfs
10410 {
10411   class Error : System.ApplicationException
10412   {
10413     public Error (string message) : base (message) {}
10414     protected Error (SerializationInfo info, StreamingContext context) {}
10415   }
10416
10417   class Guestfs
10418   {
10419     IntPtr _handle;
10420
10421     [DllImport (\"%s\")]
10422     static extern IntPtr guestfs_create ();
10423
10424     public Guestfs ()
10425     {
10426       _handle = guestfs_create ();
10427       if (_handle == IntPtr.Zero)
10428         throw new Error (\"could not create guestfs handle\");
10429     }
10430
10431     [DllImport (\"%s\")]
10432     static extern void guestfs_close (IntPtr h);
10433
10434     ~Guestfs ()
10435     {
10436       guestfs_close (_handle);
10437     }
10438
10439     [DllImport (\"%s\")]
10440     static extern string guestfs_last_error (IntPtr h);
10441
10442 " library library library;
10443
10444   (* Generate C# structure bindings.  We prefix struct names with
10445    * underscore because C# cannot have conflicting struct names and
10446    * method names (eg. "class stat" and "stat").
10447    *)
10448   List.iter (
10449     fun (typ, cols) ->
10450       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10451       pr "    public class _%s {\n" typ;
10452       List.iter (
10453         function
10454         | name, FChar -> pr "      char %s;\n" name
10455         | name, FString -> pr "      string %s;\n" name
10456         | name, FBuffer ->
10457             pr "      uint %s_len;\n" name;
10458             pr "      string %s;\n" name
10459         | name, FUUID ->
10460             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10461             pr "      string %s;\n" name
10462         | name, FUInt32 -> pr "      uint %s;\n" name
10463         | name, FInt32 -> pr "      int %s;\n" name
10464         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10465         | name, FInt64 -> pr "      long %s;\n" name
10466         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10467       ) cols;
10468       pr "    }\n";
10469       pr "\n"
10470   ) structs;
10471
10472   (* Generate C# function bindings. *)
10473   List.iter (
10474     fun (name, style, _, _, _, shortdesc, _) ->
10475       let rec csharp_return_type () =
10476         match fst style with
10477         | RErr -> "void"
10478         | RBool n -> "bool"
10479         | RInt n -> "int"
10480         | RInt64 n -> "long"
10481         | RConstString n
10482         | RConstOptString n
10483         | RString n
10484         | RBufferOut n -> "string"
10485         | RStruct (_,n) -> "_" ^ n
10486         | RHashtable n -> "Hashtable"
10487         | RStringList n -> "string[]"
10488         | RStructList (_,n) -> sprintf "_%s[]" n
10489
10490       and c_return_type () =
10491         match fst style with
10492         | RErr
10493         | RBool _
10494         | RInt _ -> "int"
10495         | RInt64 _ -> "long"
10496         | RConstString _
10497         | RConstOptString _
10498         | RString _
10499         | RBufferOut _ -> "string"
10500         | RStruct (_,n) -> "_" ^ n
10501         | RHashtable _
10502         | RStringList _ -> "string[]"
10503         | RStructList (_,n) -> sprintf "_%s[]" n
10504
10505       and c_error_comparison () =
10506         match fst style with
10507         | RErr
10508         | RBool _
10509         | RInt _
10510         | RInt64 _ -> "== -1"
10511         | RConstString _
10512         | RConstOptString _
10513         | RString _
10514         | RBufferOut _
10515         | RStruct (_,_)
10516         | RHashtable _
10517         | RStringList _
10518         | RStructList (_,_) -> "== null"
10519
10520       and generate_extern_prototype () =
10521         pr "    static extern %s guestfs_%s (IntPtr h"
10522           (c_return_type ()) name;
10523         List.iter (
10524           function
10525           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10526           | FileIn n | FileOut n ->
10527               pr ", [In] string %s" n
10528           | StringList n | DeviceList n ->
10529               pr ", [In] string[] %s" n
10530           | Bool n ->
10531               pr ", bool %s" n
10532           | Int n ->
10533               pr ", int %s" n
10534           | Int64 n ->
10535               pr ", long %s" n
10536         ) (snd style);
10537         pr ");\n"
10538
10539       and generate_public_prototype () =
10540         pr "    public %s %s (" (csharp_return_type ()) name;
10541         let comma = ref false in
10542         let next () =
10543           if !comma then pr ", ";
10544           comma := true
10545         in
10546         List.iter (
10547           function
10548           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10549           | FileIn n | FileOut n ->
10550               next (); pr "string %s" n
10551           | StringList n | DeviceList n ->
10552               next (); pr "string[] %s" n
10553           | Bool n ->
10554               next (); pr "bool %s" n
10555           | Int n ->
10556               next (); pr "int %s" n
10557           | Int64 n ->
10558               next (); pr "long %s" n
10559         ) (snd style);
10560         pr ")\n"
10561
10562       and generate_call () =
10563         pr "guestfs_%s (_handle" name;
10564         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10565         pr ");\n";
10566       in
10567
10568       pr "    [DllImport (\"%s\")]\n" library;
10569       generate_extern_prototype ();
10570       pr "\n";
10571       pr "    /// <summary>\n";
10572       pr "    /// %s\n" shortdesc;
10573       pr "    /// </summary>\n";
10574       generate_public_prototype ();
10575       pr "    {\n";
10576       pr "      %s r;\n" (c_return_type ());
10577       pr "      r = ";
10578       generate_call ();
10579       pr "      if (r %s)\n" (c_error_comparison ());
10580       pr "        throw new Error (guestfs_last_error (_handle));\n";
10581       (match fst style with
10582        | RErr -> ()
10583        | RBool _ ->
10584            pr "      return r != 0 ? true : false;\n"
10585        | RHashtable _ ->
10586            pr "      Hashtable rr = new Hashtable ();\n";
10587            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10588            pr "        rr.Add (r[i], r[i+1]);\n";
10589            pr "      return rr;\n"
10590        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10591        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10592        | RStructList _ ->
10593            pr "      return r;\n"
10594       );
10595       pr "    }\n";
10596       pr "\n";
10597   ) all_functions_sorted;
10598
10599   pr "  }
10600 }
10601 "
10602
10603 and generate_bindtests () =
10604   generate_header CStyle LGPLv2plus;
10605
10606   pr "\
10607 #include <stdio.h>
10608 #include <stdlib.h>
10609 #include <inttypes.h>
10610 #include <string.h>
10611
10612 #include \"guestfs.h\"
10613 #include \"guestfs-internal.h\"
10614 #include \"guestfs-internal-actions.h\"
10615 #include \"guestfs_protocol.h\"
10616
10617 #define error guestfs_error
10618 #define safe_calloc guestfs_safe_calloc
10619 #define safe_malloc guestfs_safe_malloc
10620
10621 static void
10622 print_strings (char *const *argv)
10623 {
10624   int argc;
10625
10626   printf (\"[\");
10627   for (argc = 0; argv[argc] != NULL; ++argc) {
10628     if (argc > 0) printf (\", \");
10629     printf (\"\\\"%%s\\\"\", argv[argc]);
10630   }
10631   printf (\"]\\n\");
10632 }
10633
10634 /* The test0 function prints its parameters to stdout. */
10635 ";
10636
10637   let test0, tests =
10638     match test_functions with
10639     | [] -> assert false
10640     | test0 :: tests -> test0, tests in
10641
10642   let () =
10643     let (name, style, _, _, _, _, _) = test0 in
10644     generate_prototype ~extern:false ~semicolon:false ~newline:true
10645       ~handle:"g" ~prefix:"guestfs__" name style;
10646     pr "{\n";
10647     List.iter (
10648       function
10649       | Pathname n
10650       | Device n | Dev_or_Path n
10651       | String n
10652       | FileIn n
10653       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10654       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10655       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10656       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10657       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10658       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10659     ) (snd style);
10660     pr "  /* Java changes stdout line buffering so we need this: */\n";
10661     pr "  fflush (stdout);\n";
10662     pr "  return 0;\n";
10663     pr "}\n";
10664     pr "\n" in
10665
10666   List.iter (
10667     fun (name, style, _, _, _, _, _) ->
10668       if String.sub name (String.length name - 3) 3 <> "err" then (
10669         pr "/* Test normal return. */\n";
10670         generate_prototype ~extern:false ~semicolon:false ~newline:true
10671           ~handle:"g" ~prefix:"guestfs__" name style;
10672         pr "{\n";
10673         (match fst style with
10674          | RErr ->
10675              pr "  return 0;\n"
10676          | RInt _ ->
10677              pr "  int r;\n";
10678              pr "  sscanf (val, \"%%d\", &r);\n";
10679              pr "  return r;\n"
10680          | RInt64 _ ->
10681              pr "  int64_t r;\n";
10682              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10683              pr "  return r;\n"
10684          | RBool _ ->
10685              pr "  return STREQ (val, \"true\");\n"
10686          | RConstString _
10687          | RConstOptString _ ->
10688              (* Can't return the input string here.  Return a static
10689               * string so we ensure we get a segfault if the caller
10690               * tries to free it.
10691               *)
10692              pr "  return \"static string\";\n"
10693          | RString _ ->
10694              pr "  return strdup (val);\n"
10695          | RStringList _ ->
10696              pr "  char **strs;\n";
10697              pr "  int n, i;\n";
10698              pr "  sscanf (val, \"%%d\", &n);\n";
10699              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10700              pr "  for (i = 0; i < n; ++i) {\n";
10701              pr "    strs[i] = safe_malloc (g, 16);\n";
10702              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10703              pr "  }\n";
10704              pr "  strs[n] = NULL;\n";
10705              pr "  return strs;\n"
10706          | RStruct (_, typ) ->
10707              pr "  struct guestfs_%s *r;\n" typ;
10708              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10709              pr "  return r;\n"
10710          | RStructList (_, typ) ->
10711              pr "  struct guestfs_%s_list *r;\n" typ;
10712              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10713              pr "  sscanf (val, \"%%d\", &r->len);\n";
10714              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10715              pr "  return r;\n"
10716          | RHashtable _ ->
10717              pr "  char **strs;\n";
10718              pr "  int n, i;\n";
10719              pr "  sscanf (val, \"%%d\", &n);\n";
10720              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10721              pr "  for (i = 0; i < n; ++i) {\n";
10722              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10723              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10724              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10725              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10726              pr "  }\n";
10727              pr "  strs[n*2] = NULL;\n";
10728              pr "  return strs;\n"
10729          | RBufferOut _ ->
10730              pr "  return strdup (val);\n"
10731         );
10732         pr "}\n";
10733         pr "\n"
10734       ) else (
10735         pr "/* Test error return. */\n";
10736         generate_prototype ~extern:false ~semicolon:false ~newline:true
10737           ~handle:"g" ~prefix:"guestfs__" name style;
10738         pr "{\n";
10739         pr "  error (g, \"error\");\n";
10740         (match fst style with
10741          | RErr | RInt _ | RInt64 _ | RBool _ ->
10742              pr "  return -1;\n"
10743          | RConstString _ | RConstOptString _
10744          | RString _ | RStringList _ | RStruct _
10745          | RStructList _
10746          | RHashtable _
10747          | RBufferOut _ ->
10748              pr "  return NULL;\n"
10749         );
10750         pr "}\n";
10751         pr "\n"
10752       )
10753   ) tests
10754
10755 and generate_ocaml_bindtests () =
10756   generate_header OCamlStyle GPLv2plus;
10757
10758   pr "\
10759 let () =
10760   let g = Guestfs.create () in
10761 ";
10762
10763   let mkargs args =
10764     String.concat " " (
10765       List.map (
10766         function
10767         | CallString s -> "\"" ^ s ^ "\""
10768         | CallOptString None -> "None"
10769         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10770         | CallStringList xs ->
10771             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10772         | CallInt i when i >= 0 -> string_of_int i
10773         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10774         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10775         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10776         | CallBool b -> string_of_bool b
10777       ) args
10778     )
10779   in
10780
10781   generate_lang_bindtests (
10782     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10783   );
10784
10785   pr "print_endline \"EOF\"\n"
10786
10787 and generate_perl_bindtests () =
10788   pr "#!/usr/bin/perl -w\n";
10789   generate_header HashStyle GPLv2plus;
10790
10791   pr "\
10792 use strict;
10793
10794 use Sys::Guestfs;
10795
10796 my $g = Sys::Guestfs->new ();
10797 ";
10798
10799   let mkargs args =
10800     String.concat ", " (
10801       List.map (
10802         function
10803         | CallString s -> "\"" ^ s ^ "\""
10804         | CallOptString None -> "undef"
10805         | CallOptString (Some s) -> sprintf "\"%s\"" s
10806         | CallStringList xs ->
10807             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10808         | CallInt i -> string_of_int i
10809         | CallInt64 i -> Int64.to_string i
10810         | CallBool b -> if b then "1" else "0"
10811       ) args
10812     )
10813   in
10814
10815   generate_lang_bindtests (
10816     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10817   );
10818
10819   pr "print \"EOF\\n\"\n"
10820
10821 and generate_python_bindtests () =
10822   generate_header HashStyle GPLv2plus;
10823
10824   pr "\
10825 import guestfs
10826
10827 g = guestfs.GuestFS ()
10828 ";
10829
10830   let mkargs args =
10831     String.concat ", " (
10832       List.map (
10833         function
10834         | CallString s -> "\"" ^ s ^ "\""
10835         | CallOptString None -> "None"
10836         | CallOptString (Some s) -> sprintf "\"%s\"" s
10837         | CallStringList xs ->
10838             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10839         | CallInt i -> string_of_int i
10840         | CallInt64 i -> Int64.to_string i
10841         | CallBool b -> if b then "1" else "0"
10842       ) args
10843     )
10844   in
10845
10846   generate_lang_bindtests (
10847     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10848   );
10849
10850   pr "print \"EOF\"\n"
10851
10852 and generate_ruby_bindtests () =
10853   generate_header HashStyle GPLv2plus;
10854
10855   pr "\
10856 require 'guestfs'
10857
10858 g = Guestfs::create()
10859 ";
10860
10861   let mkargs args =
10862     String.concat ", " (
10863       List.map (
10864         function
10865         | CallString s -> "\"" ^ s ^ "\""
10866         | CallOptString None -> "nil"
10867         | CallOptString (Some s) -> sprintf "\"%s\"" s
10868         | CallStringList xs ->
10869             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10870         | CallInt i -> string_of_int i
10871         | CallInt64 i -> Int64.to_string i
10872         | CallBool b -> string_of_bool b
10873       ) args
10874     )
10875   in
10876
10877   generate_lang_bindtests (
10878     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10879   );
10880
10881   pr "print \"EOF\\n\"\n"
10882
10883 and generate_java_bindtests () =
10884   generate_header CStyle GPLv2plus;
10885
10886   pr "\
10887 import com.redhat.et.libguestfs.*;
10888
10889 public class Bindtests {
10890     public static void main (String[] argv)
10891     {
10892         try {
10893             GuestFS g = new GuestFS ();
10894 ";
10895
10896   let mkargs args =
10897     String.concat ", " (
10898       List.map (
10899         function
10900         | CallString s -> "\"" ^ s ^ "\""
10901         | CallOptString None -> "null"
10902         | CallOptString (Some s) -> sprintf "\"%s\"" s
10903         | CallStringList xs ->
10904             "new String[]{" ^
10905               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10906         | CallInt i -> string_of_int i
10907         | CallInt64 i -> Int64.to_string i
10908         | CallBool b -> string_of_bool b
10909       ) args
10910     )
10911   in
10912
10913   generate_lang_bindtests (
10914     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10915   );
10916
10917   pr "
10918             System.out.println (\"EOF\");
10919         }
10920         catch (Exception exn) {
10921             System.err.println (exn);
10922             System.exit (1);
10923         }
10924     }
10925 }
10926 "
10927
10928 and generate_haskell_bindtests () =
10929   generate_header HaskellStyle GPLv2plus;
10930
10931   pr "\
10932 module Bindtests where
10933 import qualified Guestfs
10934
10935 main = do
10936   g <- Guestfs.create
10937 ";
10938
10939   let mkargs args =
10940     String.concat " " (
10941       List.map (
10942         function
10943         | CallString s -> "\"" ^ s ^ "\""
10944         | CallOptString None -> "Nothing"
10945         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10946         | CallStringList xs ->
10947             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10948         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10949         | CallInt i -> string_of_int i
10950         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10951         | CallInt64 i -> Int64.to_string i
10952         | CallBool true -> "True"
10953         | CallBool false -> "False"
10954       ) args
10955     )
10956   in
10957
10958   generate_lang_bindtests (
10959     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10960   );
10961
10962   pr "  putStrLn \"EOF\"\n"
10963
10964 (* Language-independent bindings tests - we do it this way to
10965  * ensure there is parity in testing bindings across all languages.
10966  *)
10967 and generate_lang_bindtests call =
10968   call "test0" [CallString "abc"; CallOptString (Some "def");
10969                 CallStringList []; CallBool false;
10970                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10971   call "test0" [CallString "abc"; CallOptString None;
10972                 CallStringList []; CallBool false;
10973                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10974   call "test0" [CallString ""; CallOptString (Some "def");
10975                 CallStringList []; CallBool false;
10976                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10977   call "test0" [CallString ""; CallOptString (Some "");
10978                 CallStringList []; CallBool false;
10979                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10980   call "test0" [CallString "abc"; CallOptString (Some "def");
10981                 CallStringList ["1"]; CallBool false;
10982                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10983   call "test0" [CallString "abc"; CallOptString (Some "def");
10984                 CallStringList ["1"; "2"]; CallBool false;
10985                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10986   call "test0" [CallString "abc"; CallOptString (Some "def");
10987                 CallStringList ["1"]; CallBool true;
10988                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10989   call "test0" [CallString "abc"; CallOptString (Some "def");
10990                 CallStringList ["1"]; CallBool false;
10991                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
10992   call "test0" [CallString "abc"; CallOptString (Some "def");
10993                 CallStringList ["1"]; CallBool false;
10994                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
10995   call "test0" [CallString "abc"; CallOptString (Some "def");
10996                 CallStringList ["1"]; CallBool false;
10997                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
10998   call "test0" [CallString "abc"; CallOptString (Some "def");
10999                 CallStringList ["1"]; CallBool false;
11000                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
11001   call "test0" [CallString "abc"; CallOptString (Some "def");
11002                 CallStringList ["1"]; CallBool false;
11003                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
11004   call "test0" [CallString "abc"; CallOptString (Some "def");
11005                 CallStringList ["1"]; CallBool false;
11006                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
11007
11008 (* XXX Add here tests of the return and error functions. *)
11009
11010 (* Code to generator bindings for virt-inspector.  Currently only
11011  * implemented for OCaml code (for virt-p2v 2.0).
11012  *)
11013 let rng_input = "inspector/virt-inspector.rng"
11014
11015 (* Read the input file and parse it into internal structures.  This is
11016  * by no means a complete RELAX NG parser, but is just enough to be
11017  * able to parse the specific input file.
11018  *)
11019 type rng =
11020   | Element of string * rng list        (* <element name=name/> *)
11021   | Attribute of string * rng list        (* <attribute name=name/> *)
11022   | Interleave of rng list                (* <interleave/> *)
11023   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
11024   | OneOrMore of rng                        (* <oneOrMore/> *)
11025   | Optional of rng                        (* <optional/> *)
11026   | Choice of string list                (* <choice><value/>*</choice> *)
11027   | Value of string                        (* <value>str</value> *)
11028   | Text                                (* <text/> *)
11029
11030 let rec string_of_rng = function
11031   | Element (name, xs) ->
11032       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11033   | Attribute (name, xs) ->
11034       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
11035   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
11036   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
11037   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
11038   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
11039   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
11040   | Value value -> "Value \"" ^ value ^ "\""
11041   | Text -> "Text"
11042
11043 and string_of_rng_list xs =
11044   String.concat ", " (List.map string_of_rng xs)
11045
11046 let rec parse_rng ?defines context = function
11047   | [] -> []
11048   | Xml.Element ("element", ["name", name], children) :: rest ->
11049       Element (name, parse_rng ?defines context children)
11050       :: parse_rng ?defines context rest
11051   | Xml.Element ("attribute", ["name", name], children) :: rest ->
11052       Attribute (name, parse_rng ?defines context children)
11053       :: parse_rng ?defines context rest
11054   | Xml.Element ("interleave", [], children) :: rest ->
11055       Interleave (parse_rng ?defines context children)
11056       :: parse_rng ?defines context rest
11057   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
11058       let rng = parse_rng ?defines context [child] in
11059       (match rng with
11060        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
11061        | _ ->
11062            failwithf "%s: <zeroOrMore> contains more than one child element"
11063              context
11064       )
11065   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11066       let rng = parse_rng ?defines context [child] in
11067       (match rng with
11068        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11069        | _ ->
11070            failwithf "%s: <oneOrMore> contains more than one child element"
11071              context
11072       )
11073   | Xml.Element ("optional", [], [child]) :: rest ->
11074       let rng = parse_rng ?defines context [child] in
11075       (match rng with
11076        | [child] -> Optional child :: parse_rng ?defines context rest
11077        | _ ->
11078            failwithf "%s: <optional> contains more than one child element"
11079              context
11080       )
11081   | Xml.Element ("choice", [], children) :: rest ->
11082       let values = List.map (
11083         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11084         | _ ->
11085             failwithf "%s: can't handle anything except <value> in <choice>"
11086               context
11087       ) children in
11088       Choice values
11089       :: parse_rng ?defines context rest
11090   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11091       Value value :: parse_rng ?defines context rest
11092   | Xml.Element ("text", [], []) :: rest ->
11093       Text :: parse_rng ?defines context rest
11094   | Xml.Element ("ref", ["name", name], []) :: rest ->
11095       (* Look up the reference.  Because of limitations in this parser,
11096        * we can't handle arbitrarily nested <ref> yet.  You can only
11097        * use <ref> from inside <start>.
11098        *)
11099       (match defines with
11100        | None ->
11101            failwithf "%s: contains <ref>, but no refs are defined yet" context
11102        | Some map ->
11103            let rng = StringMap.find name map in
11104            rng @ parse_rng ?defines context rest
11105       )
11106   | x :: _ ->
11107       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11108
11109 let grammar =
11110   let xml = Xml.parse_file rng_input in
11111   match xml with
11112   | Xml.Element ("grammar", _,
11113                  Xml.Element ("start", _, gram) :: defines) ->
11114       (* The <define/> elements are referenced in the <start> section,
11115        * so build a map of those first.
11116        *)
11117       let defines = List.fold_left (
11118         fun map ->
11119           function Xml.Element ("define", ["name", name], defn) ->
11120             StringMap.add name defn map
11121           | _ ->
11122               failwithf "%s: expected <define name=name/>" rng_input
11123       ) StringMap.empty defines in
11124       let defines = StringMap.mapi parse_rng defines in
11125
11126       (* Parse the <start> clause, passing the defines. *)
11127       parse_rng ~defines "<start>" gram
11128   | _ ->
11129       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11130         rng_input
11131
11132 let name_of_field = function
11133   | Element (name, _) | Attribute (name, _)
11134   | ZeroOrMore (Element (name, _))
11135   | OneOrMore (Element (name, _))
11136   | Optional (Element (name, _)) -> name
11137   | Optional (Attribute (name, _)) -> name
11138   | Text -> (* an unnamed field in an element *)
11139       "data"
11140   | rng ->
11141       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11142
11143 (* At the moment this function only generates OCaml types.  However we
11144  * should parameterize it later so it can generate types/structs in a
11145  * variety of languages.
11146  *)
11147 let generate_types xs =
11148   (* A simple type is one that can be printed out directly, eg.
11149    * "string option".  A complex type is one which has a name and has
11150    * to be defined via another toplevel definition, eg. a struct.
11151    *
11152    * generate_type generates code for either simple or complex types.
11153    * In the simple case, it returns the string ("string option").  In
11154    * the complex case, it returns the name ("mountpoint").  In the
11155    * complex case it has to print out the definition before returning,
11156    * so it should only be called when we are at the beginning of a
11157    * new line (BOL context).
11158    *)
11159   let rec generate_type = function
11160     | Text ->                                (* string *)
11161         "string", true
11162     | Choice values ->                        (* [`val1|`val2|...] *)
11163         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11164     | ZeroOrMore rng ->                        (* <rng> list *)
11165         let t, is_simple = generate_type rng in
11166         t ^ " list (* 0 or more *)", is_simple
11167     | OneOrMore rng ->                        (* <rng> list *)
11168         let t, is_simple = generate_type rng in
11169         t ^ " list (* 1 or more *)", is_simple
11170                                         (* virt-inspector hack: bool *)
11171     | Optional (Attribute (name, [Value "1"])) ->
11172         "bool", true
11173     | Optional rng ->                        (* <rng> list *)
11174         let t, is_simple = generate_type rng in
11175         t ^ " option", is_simple
11176                                         (* type name = { fields ... } *)
11177     | Element (name, fields) when is_attrs_interleave fields ->
11178         generate_type_struct name (get_attrs_interleave fields)
11179     | Element (name, [field])                (* type name = field *)
11180     | Attribute (name, [field]) ->
11181         let t, is_simple = generate_type field in
11182         if is_simple then (t, true)
11183         else (
11184           pr "type %s = %s\n" name t;
11185           name, false
11186         )
11187     | Element (name, fields) ->              (* type name = { fields ... } *)
11188         generate_type_struct name fields
11189     | rng ->
11190         failwithf "generate_type failed at: %s" (string_of_rng rng)
11191
11192   and is_attrs_interleave = function
11193     | [Interleave _] -> true
11194     | Attribute _ :: fields -> is_attrs_interleave fields
11195     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11196     | _ -> false
11197
11198   and get_attrs_interleave = function
11199     | [Interleave fields] -> fields
11200     | ((Attribute _) as field) :: fields
11201     | ((Optional (Attribute _)) as field) :: fields ->
11202         field :: get_attrs_interleave fields
11203     | _ -> assert false
11204
11205   and generate_types xs =
11206     List.iter (fun x -> ignore (generate_type x)) xs
11207
11208   and generate_type_struct name fields =
11209     (* Calculate the types of the fields first.  We have to do this
11210      * before printing anything so we are still in BOL context.
11211      *)
11212     let types = List.map fst (List.map generate_type fields) in
11213
11214     (* Special case of a struct containing just a string and another
11215      * field.  Turn it into an assoc list.
11216      *)
11217     match types with
11218     | ["string"; other] ->
11219         let fname1, fname2 =
11220           match fields with
11221           | [f1; f2] -> name_of_field f1, name_of_field f2
11222           | _ -> assert false in
11223         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11224         name, false
11225
11226     | types ->
11227         pr "type %s = {\n" name;
11228         List.iter (
11229           fun (field, ftype) ->
11230             let fname = name_of_field field in
11231             pr "  %s_%s : %s;\n" name fname ftype
11232         ) (List.combine fields types);
11233         pr "}\n";
11234         (* Return the name of this type, and
11235          * false because it's not a simple type.
11236          *)
11237         name, false
11238   in
11239
11240   generate_types xs
11241
11242 let generate_parsers xs =
11243   (* As for generate_type above, generate_parser makes a parser for
11244    * some type, and returns the name of the parser it has generated.
11245    * Because it (may) need to print something, it should always be
11246    * called in BOL context.
11247    *)
11248   let rec generate_parser = function
11249     | Text ->                                (* string *)
11250         "string_child_or_empty"
11251     | Choice values ->                        (* [`val1|`val2|...] *)
11252         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11253           (String.concat "|"
11254              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11255     | ZeroOrMore rng ->                        (* <rng> list *)
11256         let pa = generate_parser rng in
11257         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11258     | OneOrMore rng ->                        (* <rng> list *)
11259         let pa = generate_parser rng in
11260         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11261                                         (* virt-inspector hack: bool *)
11262     | Optional (Attribute (name, [Value "1"])) ->
11263         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11264     | Optional rng ->                        (* <rng> list *)
11265         let pa = generate_parser rng in
11266         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11267                                         (* type name = { fields ... } *)
11268     | Element (name, fields) when is_attrs_interleave fields ->
11269         generate_parser_struct name (get_attrs_interleave fields)
11270     | Element (name, [field]) ->        (* type name = field *)
11271         let pa = generate_parser field in
11272         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11273         pr "let %s =\n" parser_name;
11274         pr "  %s\n" pa;
11275         pr "let parse_%s = %s\n" name parser_name;
11276         parser_name
11277     | Attribute (name, [field]) ->
11278         let pa = generate_parser field in
11279         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11280         pr "let %s =\n" parser_name;
11281         pr "  %s\n" pa;
11282         pr "let parse_%s = %s\n" name parser_name;
11283         parser_name
11284     | Element (name, fields) ->              (* type name = { fields ... } *)
11285         generate_parser_struct name ([], fields)
11286     | rng ->
11287         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11288
11289   and is_attrs_interleave = function
11290     | [Interleave _] -> true
11291     | Attribute _ :: fields -> is_attrs_interleave fields
11292     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11293     | _ -> false
11294
11295   and get_attrs_interleave = function
11296     | [Interleave fields] -> [], fields
11297     | ((Attribute _) as field) :: fields
11298     | ((Optional (Attribute _)) as field) :: fields ->
11299         let attrs, interleaves = get_attrs_interleave fields in
11300         (field :: attrs), interleaves
11301     | _ -> assert false
11302
11303   and generate_parsers xs =
11304     List.iter (fun x -> ignore (generate_parser x)) xs
11305
11306   and generate_parser_struct name (attrs, interleaves) =
11307     (* Generate parsers for the fields first.  We have to do this
11308      * before printing anything so we are still in BOL context.
11309      *)
11310     let fields = attrs @ interleaves in
11311     let pas = List.map generate_parser fields in
11312
11313     (* Generate an intermediate tuple from all the fields first.
11314      * If the type is just a string + another field, then we will
11315      * return this directly, otherwise it is turned into a record.
11316      *
11317      * RELAX NG note: This code treats <interleave> and plain lists of
11318      * fields the same.  In other words, it doesn't bother enforcing
11319      * any ordering of fields in the XML.
11320      *)
11321     pr "let parse_%s x =\n" name;
11322     pr "  let t = (\n    ";
11323     let comma = ref false in
11324     List.iter (
11325       fun x ->
11326         if !comma then pr ",\n    ";
11327         comma := true;
11328         match x with
11329         | Optional (Attribute (fname, [field])), pa ->
11330             pr "%s x" pa
11331         | Optional (Element (fname, [field])), pa ->
11332             pr "%s (optional_child %S x)" pa fname
11333         | Attribute (fname, [Text]), _ ->
11334             pr "attribute %S x" fname
11335         | (ZeroOrMore _ | OneOrMore _), pa ->
11336             pr "%s x" pa
11337         | Text, pa ->
11338             pr "%s x" pa
11339         | (field, pa) ->
11340             let fname = name_of_field field in
11341             pr "%s (child %S x)" pa fname
11342     ) (List.combine fields pas);
11343     pr "\n  ) in\n";
11344
11345     (match fields with
11346      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11347          pr "  t\n"
11348
11349      | _ ->
11350          pr "  (Obj.magic t : %s)\n" name
11351 (*
11352          List.iter (
11353            function
11354            | (Optional (Attribute (fname, [field])), pa) ->
11355                pr "  %s_%s =\n" name fname;
11356                pr "    %s x;\n" pa
11357            | (Optional (Element (fname, [field])), pa) ->
11358                pr "  %s_%s =\n" name fname;
11359                pr "    (let x = optional_child %S x in\n" fname;
11360                pr "     %s x);\n" pa
11361            | (field, pa) ->
11362                let fname = name_of_field field in
11363                pr "  %s_%s =\n" name fname;
11364                pr "    (let x = child %S x in\n" fname;
11365                pr "     %s x);\n" pa
11366          ) (List.combine fields pas);
11367          pr "}\n"
11368 *)
11369     );
11370     sprintf "parse_%s" name
11371   in
11372
11373   generate_parsers xs
11374
11375 (* Generate ocaml/guestfs_inspector.mli. *)
11376 let generate_ocaml_inspector_mli () =
11377   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11378
11379   pr "\
11380 (** This is an OCaml language binding to the external [virt-inspector]
11381     program.
11382
11383     For more information, please read the man page [virt-inspector(1)].
11384 *)
11385
11386 ";
11387
11388   generate_types grammar;
11389   pr "(** The nested information returned from the {!inspect} function. *)\n";
11390   pr "\n";
11391
11392   pr "\
11393 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11394 (** To inspect a libvirt domain called [name], pass a singleton
11395     list: [inspect [name]].  When using libvirt only, you may
11396     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11397
11398     To inspect a disk image or images, pass a list of the filenames
11399     of the disk images: [inspect filenames]
11400
11401     This function inspects the given guest or disk images and
11402     returns a list of operating system(s) found and a large amount
11403     of information about them.  In the vast majority of cases,
11404     a virtual machine only contains a single operating system.
11405
11406     If the optional [~xml] parameter is given, then this function
11407     skips running the external virt-inspector program and just
11408     parses the given XML directly (which is expected to be XML
11409     produced from a previous run of virt-inspector).  The list of
11410     names and connect URI are ignored in this case.
11411
11412     This function can throw a wide variety of exceptions, for example
11413     if the external virt-inspector program cannot be found, or if
11414     it doesn't generate valid XML.
11415 *)
11416 "
11417
11418 (* Generate ocaml/guestfs_inspector.ml. *)
11419 let generate_ocaml_inspector_ml () =
11420   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11421
11422   pr "open Unix\n";
11423   pr "\n";
11424
11425   generate_types grammar;
11426   pr "\n";
11427
11428   pr "\
11429 (* Misc functions which are used by the parser code below. *)
11430 let first_child = function
11431   | Xml.Element (_, _, c::_) -> c
11432   | Xml.Element (name, _, []) ->
11433       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11434   | Xml.PCData str ->
11435       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11436
11437 let string_child_or_empty = function
11438   | Xml.Element (_, _, [Xml.PCData s]) -> s
11439   | Xml.Element (_, _, []) -> \"\"
11440   | Xml.Element (x, _, _) ->
11441       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11442                 x ^ \" instead\")
11443   | Xml.PCData str ->
11444       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11445
11446 let optional_child name xml =
11447   let children = Xml.children xml in
11448   try
11449     Some (List.find (function
11450                      | Xml.Element (n, _, _) when n = name -> true
11451                      | _ -> false) children)
11452   with
11453     Not_found -> None
11454
11455 let child name xml =
11456   match optional_child name xml with
11457   | Some c -> c
11458   | None ->
11459       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11460
11461 let attribute name xml =
11462   try Xml.attrib xml name
11463   with Xml.No_attribute _ ->
11464     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11465
11466 ";
11467
11468   generate_parsers grammar;
11469   pr "\n";
11470
11471   pr "\
11472 (* Run external virt-inspector, then use parser to parse the XML. *)
11473 let inspect ?connect ?xml names =
11474   let xml =
11475     match xml with
11476     | None ->
11477         if names = [] then invalid_arg \"inspect: no names given\";
11478         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11479           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11480           names in
11481         let cmd = List.map Filename.quote cmd in
11482         let cmd = String.concat \" \" cmd in
11483         let chan = open_process_in cmd in
11484         let xml = Xml.parse_in chan in
11485         (match close_process_in chan with
11486          | WEXITED 0 -> ()
11487          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11488          | WSIGNALED i | WSTOPPED i ->
11489              failwith (\"external virt-inspector command died or stopped on sig \" ^
11490                        string_of_int i)
11491         );
11492         xml
11493     | Some doc ->
11494         Xml.parse_string doc in
11495   parse_operatingsystems xml
11496 "
11497
11498 (* This is used to generate the src/MAX_PROC_NR file which
11499  * contains the maximum procedure number, a surrogate for the
11500  * ABI version number.  See src/Makefile.am for the details.
11501  *)
11502 and generate_max_proc_nr () =
11503   let proc_nrs = List.map (
11504     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11505   ) daemon_functions in
11506
11507   let max_proc_nr = List.fold_left max 0 proc_nrs in
11508
11509   pr "%d\n" max_proc_nr
11510
11511 let output_to filename k =
11512   let filename_new = filename ^ ".new" in
11513   chan := open_out filename_new;
11514   k ();
11515   close_out !chan;
11516   chan := Pervasives.stdout;
11517
11518   (* Is the new file different from the current file? *)
11519   if Sys.file_exists filename && files_equal filename filename_new then
11520     unlink filename_new                 (* same, so skip it *)
11521   else (
11522     (* different, overwrite old one *)
11523     (try chmod filename 0o644 with Unix_error _ -> ());
11524     rename filename_new filename;
11525     chmod filename 0o444;
11526     printf "written %s\n%!" filename;
11527   )
11528
11529 let perror msg = function
11530   | Unix_error (err, _, _) ->
11531       eprintf "%s: %s\n" msg (error_message err)
11532   | exn ->
11533       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11534
11535 (* Main program. *)
11536 let () =
11537   let lock_fd =
11538     try openfile "HACKING" [O_RDWR] 0
11539     with
11540     | Unix_error (ENOENT, _, _) ->
11541         eprintf "\
11542 You are probably running this from the wrong directory.
11543 Run it from the top source directory using the command
11544   src/generator.ml
11545 ";
11546         exit 1
11547     | exn ->
11548         perror "open: HACKING" exn;
11549         exit 1 in
11550
11551   (* Acquire a lock so parallel builds won't try to run the generator
11552    * twice at the same time.  Subsequent builds will wait for the first
11553    * one to finish.  Note the lock is released implicitly when the
11554    * program exits.
11555    *)
11556   (try lockf lock_fd F_LOCK 1
11557    with exn ->
11558      perror "lock: HACKING" exn;
11559      exit 1);
11560
11561   check_functions ();
11562
11563   output_to "src/guestfs_protocol.x" generate_xdr;
11564   output_to "src/guestfs-structs.h" generate_structs_h;
11565   output_to "src/guestfs-actions.h" generate_actions_h;
11566   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11567   output_to "src/guestfs-actions.c" generate_client_actions;
11568   output_to "src/guestfs-bindtests.c" generate_bindtests;
11569   output_to "src/guestfs-structs.pod" generate_structs_pod;
11570   output_to "src/guestfs-actions.pod" generate_actions_pod;
11571   output_to "src/guestfs-availability.pod" generate_availability_pod;
11572   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11573   output_to "src/libguestfs.syms" generate_linker_script;
11574   output_to "daemon/actions.h" generate_daemon_actions_h;
11575   output_to "daemon/stubs.c" generate_daemon_actions;
11576   output_to "daemon/names.c" generate_daemon_names;
11577   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11578   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11579   output_to "capitests/tests.c" generate_tests;
11580   output_to "fish/cmds.c" generate_fish_cmds;
11581   output_to "fish/completion.c" generate_fish_completion;
11582   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11583   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11584   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11585   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11586   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11587   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11588   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11589   output_to "perl/Guestfs.xs" generate_perl_xs;
11590   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11591   output_to "perl/bindtests.pl" generate_perl_bindtests;
11592   output_to "python/guestfs-py.c" generate_python_c;
11593   output_to "python/guestfs.py" generate_python_py;
11594   output_to "python/bindtests.py" generate_python_bindtests;
11595   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11596   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11597   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11598
11599   List.iter (
11600     fun (typ, jtyp) ->
11601       let cols = cols_of_struct typ in
11602       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11603       output_to filename (generate_java_struct jtyp cols);
11604   ) java_structs;
11605
11606   output_to "java/Makefile.inc" generate_java_makefile_inc;
11607   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11608   output_to "java/Bindtests.java" generate_java_bindtests;
11609   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11610   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11611   output_to "csharp/Libguestfs.cs" generate_csharp;
11612
11613   (* Always generate this file last, and unconditionally.  It's used
11614    * by the Makefile to know when we must re-run the generator.
11615    *)
11616   let chan = open_out "src/stamp-generator" in
11617   fprintf chan "1\n";
11618   close_out chan;
11619
11620   printf "generated %d lines of code\n" !lines