fish: Add guestfish -N bootroot and -N bootrootlv for creating boot+root disks.
[libguestfs.git] / src / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009-2010 Red Hat Inc.
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18  *)
19
20 (* This script generates a large amount of code and documentation for
21  * all the daemon actions.
22  *
23  * To add a new action there are only two files you need to change,
24  * this one to describe the interface (see the big table of
25  * 'daemon_functions' below), and daemon/<somefile>.c to write the
26  * implementation.
27  *
28  * After editing this file, run it (./src/generator.ml) to regenerate
29  * all the output files.  'make' will rerun this automatically when
30  * necessary.  Note that if you are using a separate build directory
31  * you must run generator.ml from the _source_ directory.
32  *
33  * IMPORTANT: This script should NOT print any warnings.  If it prints
34  * warnings, you should treat them as errors.
35  *
36  * OCaml tips:
37  * (1) In emacs, install tuareg-mode to display and format OCaml code
38  * correctly.  'vim' comes with a good OCaml editing mode by default.
39  * (2) Read the resources at http://ocaml-tutorial.org/
40  *)
41
42 #load "unix.cma";;
43 #load "str.cma";;
44 #directory "+xml-light";;
45 #directory "+../pkg-lib/xml-light";; (* for GODI users *)
46 #load "xml-light.cma";;
47
48 open Unix
49 open Printf
50
51 type style = ret * args
52 and ret =
53     (* "RErr" as a return value means an int used as a simple error
54      * indication, ie. 0 or -1.
55      *)
56   | RErr
57
58     (* "RInt" as a return value means an int which is -1 for error
59      * or any value >= 0 on success.  Only use this for smallish
60      * positive ints (0 <= i < 2^30).
61      *)
62   | RInt of string
63
64     (* "RInt64" is the same as RInt, but is guaranteed to be able
65      * to return a full 64 bit value, _except_ that -1 means error
66      * (so -1 cannot be a valid, non-error return value).
67      *)
68   | RInt64 of string
69
70     (* "RBool" is a bool return value which can be true/false or
71      * -1 for error.
72      *)
73   | RBool of string
74
75     (* "RConstString" is a string that refers to a constant value.
76      * The return value must NOT be NULL (since NULL indicates
77      * an error).
78      *
79      * Try to avoid using this.  In particular you cannot use this
80      * for values returned from the daemon, because there is no
81      * thread-safe way to return them in the C API.
82      *)
83   | RConstString of string
84
85     (* "RConstOptString" is an even more broken version of
86      * "RConstString".  The returned string may be NULL and there
87      * is no way to return an error indication.  Avoid using this!
88      *)
89   | RConstOptString of string
90
91     (* "RString" is a returned string.  It must NOT be NULL, since
92      * a NULL return indicates an error.  The caller frees this.
93      *)
94   | RString of string
95
96     (* "RStringList" is a list of strings.  No string in the list
97      * can be NULL.  The caller frees the strings and the array.
98      *)
99   | RStringList of string
100
101     (* "RStruct" is a function which returns a single named structure
102      * or an error indication (in C, a struct, and in other languages
103      * with varying representations, but usually very efficient).  See
104      * after the function list below for the structures.
105      *)
106   | RStruct of string * string          (* name of retval, name of struct *)
107
108     (* "RStructList" is a function which returns either a list/array
109      * of structures (could be zero-length), or an error indication.
110      *)
111   | RStructList of string * string      (* name of retval, name of struct *)
112
113     (* Key-value pairs of untyped strings.  Turns into a hashtable or
114      * dictionary in languages which support it.  DON'T use this as a
115      * general "bucket" for results.  Prefer a stronger typed return
116      * value if one is available, or write a custom struct.  Don't use
117      * this if the list could potentially be very long, since it is
118      * inefficient.  Keys should be unique.  NULLs are not permitted.
119      *)
120   | RHashtable of string
121
122     (* "RBufferOut" is handled almost exactly like RString, but
123      * it allows the string to contain arbitrary 8 bit data including
124      * ASCII NUL.  In the C API this causes an implicit extra parameter
125      * to be added of type <size_t *size_r>.  The extra parameter
126      * returns the actual size of the return buffer in bytes.
127      *
128      * Other programming languages support strings with arbitrary 8 bit
129      * data.
130      *
131      * At the RPC layer we have to use the opaque<> type instead of
132      * string<>.  Returned data is still limited to the max message
133      * size (ie. ~ 2 MB).
134      *)
135   | RBufferOut of string
136
137 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
138
139     (* Note in future we should allow a "variable args" parameter as
140      * the final parameter, to allow commands like
141      *   chmod mode file [file(s)...]
142      * This is not implemented yet, but many commands (such as chmod)
143      * are currently defined with the argument order keeping this future
144      * possibility in mind.
145      *)
146 and argt =
147   | String of string    (* const char *name, cannot be NULL *)
148   | Device of string    (* /dev device name, cannot be NULL *)
149   | Pathname of string  (* file name, cannot be NULL *)
150   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
151   | OptString of string (* const char *name, may be NULL *)
152   | StringList of string(* list of strings (each string cannot be NULL) *)
153   | DeviceList of string(* list of Device names (each cannot be NULL) *)
154   | Bool of string      (* boolean *)
155   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
156   | Int64 of string     (* any 64 bit int *)
157     (* These are treated as filenames (simple string parameters) in
158      * the C API and bindings.  But in the RPC protocol, we transfer
159      * the actual file content up to or down from the daemon.
160      * FileIn: local machine -> daemon (in request)
161      * FileOut: daemon -> local machine (in reply)
162      * In guestfish (only), the special name "-" means read from
163      * stdin or write to stdout.
164      *)
165   | FileIn of string
166   | FileOut of string
167     (* Opaque buffer which can contain arbitrary 8 bit data.
168      * In the C API, this is expressed as <const char *, size_t> pair.
169      * Most other languages have a string type which can contain
170      * ASCII NUL.  We use whatever type is appropriate for each
171      * language.
172      * Buffers are limited by the total message size.  To transfer
173      * large blocks of data, use FileIn/FileOut parameters instead.
174      * To return an arbitrary buffer, use RBufferOut.
175      *)
176   | BufferIn of string
177     (* Key material / passphrase.  Eventually we should treat this
178      * as sensitive and mlock it into physical RAM.  However this
179      * is highly complex because of all the places that XDR-encoded
180      * strings can end up.  So currently the only difference from
181      * 'String' is the way that guestfish requests these parameters
182      * from the user.
183      *)
184   | Key of string
185
186 type flags =
187   | ProtocolLimitWarning  (* display warning about protocol size limits *)
188   | DangerWillRobinson    (* flags particularly dangerous commands *)
189   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
190   | FishOutput of fish_output_t (* how to display output in guestfish *)
191   | NotInFish             (* do not export via guestfish *)
192   | NotInDocs             (* do not add this function to documentation *)
193   | DeprecatedBy of string (* function is deprecated, use .. instead *)
194   | Optional of string    (* function is part of an optional group *)
195   | Progress              (* function can generate progress messages *)
196
197 and fish_output_t =
198   | FishOutputOctal       (* for int return, print in octal *)
199   | FishOutputHexadecimal (* for int return, print in hex *)
200
201 (* You can supply zero or as many tests as you want per API call.
202  *
203  * Note that the test environment has 3 block devices, of size 500MB,
204  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
205  * a fourth ISO block device with some known files on it (/dev/sdd).
206  *
207  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
208  * Number of cylinders was 63 for IDE emulated disks with precisely
209  * the same size.  How exactly this is calculated is a mystery.
210  *
211  * The ISO block device (/dev/sdd) comes from images/test.iso.
212  *
213  * To be able to run the tests in a reasonable amount of time,
214  * the virtual machine and block devices are reused between tests.
215  * So don't try testing kill_subprocess :-x
216  *
217  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
218  *
219  * Don't assume anything about the previous contents of the block
220  * devices.  Use 'Init*' to create some initial scenarios.
221  *
222  * You can add a prerequisite clause to any individual test.  This
223  * is a run-time check, which, if it fails, causes the test to be
224  * skipped.  Useful if testing a command which might not work on
225  * all variations of libguestfs builds.  A test that has prerequisite
226  * of 'Always' is run unconditionally.
227  *
228  * In addition, packagers can skip individual tests by setting the
229  * environment variables:     eg:
230  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
231  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
232  *)
233 type tests = (test_init * test_prereq * test) list
234 and test =
235     (* Run the command sequence and just expect nothing to fail. *)
236   | TestRun of seq
237
238     (* Run the command sequence and expect the output of the final
239      * command to be the string.
240      *)
241   | TestOutput of seq * string
242
243     (* Run the command sequence and expect the output of the final
244      * command to be the list of strings.
245      *)
246   | TestOutputList of seq * string list
247
248     (* Run the command sequence and expect the output of the final
249      * command to be the list of block devices (could be either
250      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
251      * character of each string).
252      *)
253   | TestOutputListOfDevices of seq * string list
254
255     (* Run the command sequence and expect the output of the final
256      * command to be the integer.
257      *)
258   | TestOutputInt of seq * int
259
260     (* Run the command sequence and expect the output of the final
261      * command to be <op> <int>, eg. ">=", "1".
262      *)
263   | TestOutputIntOp of seq * string * int
264
265     (* Run the command sequence and expect the output of the final
266      * command to be a true value (!= 0 or != NULL).
267      *)
268   | TestOutputTrue of seq
269
270     (* Run the command sequence and expect the output of the final
271      * command to be a false value (== 0 or == NULL, but not an error).
272      *)
273   | TestOutputFalse of seq
274
275     (* Run the command sequence and expect the output of the final
276      * command to be a list of the given length (but don't care about
277      * content).
278      *)
279   | TestOutputLength of seq * int
280
281     (* Run the command sequence and expect the output of the final
282      * command to be a buffer (RBufferOut), ie. string + size.
283      *)
284   | TestOutputBuffer of seq * string
285
286     (* Run the command sequence and expect the output of the final
287      * command to be a structure.
288      *)
289   | TestOutputStruct of seq * test_field_compare list
290
291     (* Run the command sequence and expect the final command (only)
292      * to fail.
293      *)
294   | TestLastFail of seq
295
296 and test_field_compare =
297   | CompareWithInt of string * int
298   | CompareWithIntOp of string * string * int
299   | CompareWithString of string * string
300   | CompareFieldsIntEq of string * string
301   | CompareFieldsStrEq of string * string
302
303 (* Test prerequisites. *)
304 and test_prereq =
305     (* Test always runs. *)
306   | Always
307
308     (* Test is currently disabled - eg. it fails, or it tests some
309      * unimplemented feature.
310      *)
311   | Disabled
312
313     (* 'string' is some C code (a function body) that should return
314      * true or false.  The test will run if the code returns true.
315      *)
316   | If of string
317
318     (* As for 'If' but the test runs _unless_ the code returns true. *)
319   | Unless of string
320
321     (* Run the test only if 'string' is available in the daemon. *)
322   | IfAvailable of string
323
324 (* Some initial scenarios for testing. *)
325 and test_init =
326     (* Do nothing, block devices could contain random stuff including
327      * LVM PVs, and some filesystems might be mounted.  This is usually
328      * a bad idea.
329      *)
330   | InitNone
331
332     (* Block devices are empty and no filesystems are mounted. *)
333   | InitEmpty
334
335     (* /dev/sda contains a single partition /dev/sda1, with random
336      * content.  /dev/sdb and /dev/sdc may have random content.
337      * No LVM.
338      *)
339   | InitPartition
340
341     (* /dev/sda contains a single partition /dev/sda1, which is formatted
342      * as ext2, empty [except for lost+found] and mounted on /.
343      * /dev/sdb and /dev/sdc may have random content.
344      * No LVM.
345      *)
346   | InitBasicFS
347
348     (* /dev/sda:
349      *   /dev/sda1 (is a PV):
350      *     /dev/VG/LV (size 8MB):
351      *       formatted as ext2, empty [except for lost+found], mounted on /
352      * /dev/sdb and /dev/sdc may have random content.
353      *)
354   | InitBasicFSonLVM
355
356     (* /dev/sdd (the ISO, see images/ directory in source)
357      * is mounted on /
358      *)
359   | InitISOFS
360
361 (* Sequence of commands for testing. *)
362 and seq = cmd list
363 and cmd = string list
364
365 (* Note about long descriptions: When referring to another
366  * action, use the format C<guestfs_other> (ie. the full name of
367  * the C function).  This will be replaced as appropriate in other
368  * language bindings.
369  *
370  * Apart from that, long descriptions are just perldoc paragraphs.
371  *)
372
373 (* Generate a random UUID (used in tests). *)
374 let uuidgen () =
375   let chan = open_process_in "uuidgen" in
376   let uuid = input_line chan in
377   (match close_process_in chan with
378    | WEXITED 0 -> ()
379    | WEXITED _ ->
380        failwith "uuidgen: process exited with non-zero status"
381    | WSIGNALED _ | WSTOPPED _ ->
382        failwith "uuidgen: process signalled or stopped by signal"
383   );
384   uuid
385
386 (* These test functions are used in the language binding tests. *)
387
388 let test_all_args = [
389   String "str";
390   OptString "optstr";
391   StringList "strlist";
392   Bool "b";
393   Int "integer";
394   Int64 "integer64";
395   FileIn "filein";
396   FileOut "fileout";
397   BufferIn "bufferin";
398 ]
399
400 let test_all_rets = [
401   (* except for RErr, which is tested thoroughly elsewhere *)
402   "test0rint",         RInt "valout";
403   "test0rint64",       RInt64 "valout";
404   "test0rbool",        RBool "valout";
405   "test0rconststring", RConstString "valout";
406   "test0rconstoptstring", RConstOptString "valout";
407   "test0rstring",      RString "valout";
408   "test0rstringlist",  RStringList "valout";
409   "test0rstruct",      RStruct ("valout", "lvm_pv");
410   "test0rstructlist",  RStructList ("valout", "lvm_pv");
411   "test0rhashtable",   RHashtable "valout";
412 ]
413
414 let test_functions = [
415   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
416    [],
417    "internal test function - do not use",
418    "\
419 This is an internal test function which is used to test whether
420 the automatically generated bindings can handle every possible
421 parameter type correctly.
422
423 It echos the contents of each parameter to stdout.
424
425 You probably don't want to call this function.");
426 ] @ List.flatten (
427   List.map (
428     fun (name, ret) ->
429       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
430         [],
431         "internal test function - do not use",
432         "\
433 This is an internal test function which is used to test whether
434 the automatically generated bindings can handle every possible
435 return type correctly.
436
437 It converts string C<val> to the return type.
438
439 You probably don't want to call this function.");
440        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
441         [],
442         "internal test function - do not use",
443         "\
444 This is an internal test function which is used to test whether
445 the automatically generated bindings can handle every possible
446 return type correctly.
447
448 This function always returns an error.
449
450 You probably don't want to call this function.")]
451   ) test_all_rets
452 )
453
454 (* non_daemon_functions are any functions which don't get processed
455  * in the daemon, eg. functions for setting and getting local
456  * configuration values.
457  *)
458
459 let non_daemon_functions = test_functions @ [
460   ("launch", (RErr, []), -1, [FishAlias "run"],
461    [],
462    "launch the qemu subprocess",
463    "\
464 Internally libguestfs is implemented by running a virtual machine
465 using L<qemu(1)>.
466
467 You should call this after configuring the handle
468 (eg. adding drives) but before performing any actions.");
469
470   ("wait_ready", (RErr, []), -1, [NotInFish],
471    [],
472    "wait until the qemu subprocess launches (no op)",
473    "\
474 This function is a no op.
475
476 In versions of the API E<lt> 1.0.71 you had to call this function
477 just after calling C<guestfs_launch> to wait for the launch
478 to complete.  However this is no longer necessary because
479 C<guestfs_launch> now does the waiting.
480
481 If you see any calls to this function in code then you can just
482 remove them, unless you want to retain compatibility with older
483 versions of the API.");
484
485   ("kill_subprocess", (RErr, []), -1, [],
486    [],
487    "kill the qemu subprocess",
488    "\
489 This kills the qemu subprocess.  You should never need to call this.");
490
491   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
492    [],
493    "add an image to examine or modify",
494    "\
495 This function adds a virtual machine disk image C<filename> to the
496 guest.  The first time you call this function, the disk appears as IDE
497 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
498 so on.
499
500 You don't necessarily need to be root when using libguestfs.  However
501 you obviously do need sufficient permissions to access the filename
502 for whatever operations you want to perform (ie. read access if you
503 just want to read the image or write access if you want to modify the
504 image).
505
506 This is equivalent to the qemu parameter
507 C<-drive file=filename,cache=off,if=...>.
508
509 C<cache=off> is omitted in cases where it is not supported by
510 the underlying filesystem.
511
512 C<if=...> is set at compile time by the configuration option
513 C<./configure --with-drive-if=...>.  In the rare case where you
514 might need to change this at run time, use C<guestfs_add_drive_with_if>
515 or C<guestfs_add_drive_ro_with_if>.
516
517 Note that this call checks for the existence of C<filename>.  This
518 stops you from specifying other types of drive which are supported
519 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
520 the general C<guestfs_config> call instead.");
521
522   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
523    [],
524    "add a CD-ROM disk image to examine",
525    "\
526 This function adds a virtual CD-ROM disk image to the guest.
527
528 This is equivalent to the qemu parameter C<-cdrom filename>.
529
530 Notes:
531
532 =over 4
533
534 =item *
535
536 This call checks for the existence of C<filename>.  This
537 stops you from specifying other types of drive which are supported
538 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
539 the general C<guestfs_config> call instead.
540
541 =item *
542
543 If you just want to add an ISO file (often you use this as an
544 efficient way to transfer large files into the guest), then you
545 should probably use C<guestfs_add_drive_ro> instead.
546
547 =back");
548
549   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
550    [],
551    "add a drive in snapshot mode (read-only)",
552    "\
553 This adds a drive in snapshot mode, making it effectively
554 read-only.
555
556 Note that writes to the device are allowed, and will be seen for
557 the duration of the guestfs handle, but they are written
558 to a temporary file which is discarded as soon as the guestfs
559 handle is closed.  We don't currently have any method to enable
560 changes to be committed, although qemu can support this.
561
562 This is equivalent to the qemu parameter
563 C<-drive file=filename,snapshot=on,if=...>.
564
565 C<if=...> is set at compile time by the configuration option
566 C<./configure --with-drive-if=...>.  In the rare case where you
567 might need to change this at run time, use C<guestfs_add_drive_with_if>
568 or C<guestfs_add_drive_ro_with_if>.
569
570 Note that this call checks for the existence of C<filename>.  This
571 stops you from specifying other types of drive which are supported
572 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
573 the general C<guestfs_config> call instead.");
574
575   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
576    [],
577    "add qemu parameters",
578    "\
579 This can be used to add arbitrary qemu command line parameters
580 of the form C<-param value>.  Actually it's not quite arbitrary - we
581 prevent you from setting some parameters which would interfere with
582 parameters that we use.
583
584 The first character of C<param> string must be a C<-> (dash).
585
586 C<value> can be NULL.");
587
588   ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
589    [],
590    "set the qemu binary",
591    "\
592 Set the qemu binary that we will use.
593
594 The default is chosen when the library was compiled by the
595 configure script.
596
597 You can also override this by setting the C<LIBGUESTFS_QEMU>
598 environment variable.
599
600 Setting C<qemu> to C<NULL> restores the default qemu binary.
601
602 Note that you should call this function as early as possible
603 after creating the handle.  This is because some pre-launch
604 operations depend on testing qemu features (by running C<qemu -help>).
605 If the qemu binary changes, we don't retest features, and
606 so you might see inconsistent results.  Using the environment
607 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
608 the qemu binary at the same time as the handle is created.");
609
610   ("get_qemu", (RConstString "qemu", []), -1, [],
611    [InitNone, Always, TestRun (
612       [["get_qemu"]])],
613    "get the qemu binary",
614    "\
615 Return the current qemu binary.
616
617 This is always non-NULL.  If it wasn't set already, then this will
618 return the default qemu binary name.");
619
620   ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
621    [],
622    "set the search path",
623    "\
624 Set the path that libguestfs searches for kernel and initrd.img.
625
626 The default is C<$libdir/guestfs> unless overridden by setting
627 C<LIBGUESTFS_PATH> environment variable.
628
629 Setting C<path> to C<NULL> restores the default path.");
630
631   ("get_path", (RConstString "path", []), -1, [],
632    [InitNone, Always, TestRun (
633       [["get_path"]])],
634    "get the search path",
635    "\
636 Return the current search path.
637
638 This is always non-NULL.  If it wasn't set already, then this will
639 return the default path.");
640
641   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
642    [],
643    "add options to kernel command line",
644    "\
645 This function is used to add additional options to the
646 guest kernel command line.
647
648 The default is C<NULL> unless overridden by setting
649 C<LIBGUESTFS_APPEND> environment variable.
650
651 Setting C<append> to C<NULL> means I<no> additional options
652 are passed (libguestfs always adds a few of its own).");
653
654   ("get_append", (RConstOptString "append", []), -1, [],
655    (* This cannot be tested with the current framework.  The
656     * function can return NULL in normal operations, which the
657     * test framework interprets as an error.
658     *)
659    [],
660    "get the additional kernel options",
661    "\
662 Return the additional kernel options which are added to the
663 guest kernel command line.
664
665 If C<NULL> then no options are added.");
666
667   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
668    [],
669    "set autosync mode",
670    "\
671 If C<autosync> is true, this enables autosync.  Libguestfs will make a
672 best effort attempt to run C<guestfs_umount_all> followed by
673 C<guestfs_sync> when the handle is closed
674 (also if the program exits without closing handles).
675
676 This is disabled by default (except in guestfish where it is
677 enabled by default).");
678
679   ("get_autosync", (RBool "autosync", []), -1, [],
680    [InitNone, Always, TestRun (
681       [["get_autosync"]])],
682    "get autosync mode",
683    "\
684 Get the autosync flag.");
685
686   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
687    [],
688    "set verbose mode",
689    "\
690 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
691
692 Verbose messages are disabled unless the environment variable
693 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
694
695   ("get_verbose", (RBool "verbose", []), -1, [],
696    [],
697    "get verbose mode",
698    "\
699 This returns the verbose messages flag.");
700
701   ("is_ready", (RBool "ready", []), -1, [],
702    [InitNone, Always, TestOutputTrue (
703       [["is_ready"]])],
704    "is ready to accept commands",
705    "\
706 This returns true iff this handle is ready to accept commands
707 (in the C<READY> state).
708
709 For more information on states, see L<guestfs(3)>.");
710
711   ("is_config", (RBool "config", []), -1, [],
712    [InitNone, Always, TestOutputFalse (
713       [["is_config"]])],
714    "is in configuration state",
715    "\
716 This returns true iff this handle is being configured
717 (in the C<CONFIG> state).
718
719 For more information on states, see L<guestfs(3)>.");
720
721   ("is_launching", (RBool "launching", []), -1, [],
722    [InitNone, Always, TestOutputFalse (
723       [["is_launching"]])],
724    "is launching subprocess",
725    "\
726 This returns true iff this handle is launching the subprocess
727 (in the C<LAUNCHING> state).
728
729 For more information on states, see L<guestfs(3)>.");
730
731   ("is_busy", (RBool "busy", []), -1, [],
732    [InitNone, Always, TestOutputFalse (
733       [["is_busy"]])],
734    "is busy processing a command",
735    "\
736 This returns true iff this handle is busy processing a command
737 (in the C<BUSY> state).
738
739 For more information on states, see L<guestfs(3)>.");
740
741   ("get_state", (RInt "state", []), -1, [],
742    [],
743    "get the current state",
744    "\
745 This returns the current state as an opaque integer.  This is
746 only useful for printing debug and internal error messages.
747
748 For more information on states, see L<guestfs(3)>.");
749
750   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
751    [InitNone, Always, TestOutputInt (
752       [["set_memsize"; "500"];
753        ["get_memsize"]], 500)],
754    "set memory allocated to the qemu subprocess",
755    "\
756 This sets the memory size in megabytes allocated to the
757 qemu subprocess.  This only has any effect if called before
758 C<guestfs_launch>.
759
760 You can also change this by setting the environment
761 variable C<LIBGUESTFS_MEMSIZE> before the handle is
762 created.
763
764 For more information on the architecture of libguestfs,
765 see L<guestfs(3)>.");
766
767   ("get_memsize", (RInt "memsize", []), -1, [],
768    [InitNone, Always, TestOutputIntOp (
769       [["get_memsize"]], ">=", 256)],
770    "get memory allocated to the qemu subprocess",
771    "\
772 This gets the memory size in megabytes allocated to the
773 qemu subprocess.
774
775 If C<guestfs_set_memsize> was not called
776 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
777 then this returns the compiled-in default value for memsize.
778
779 For more information on the architecture of libguestfs,
780 see L<guestfs(3)>.");
781
782   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
783    [InitNone, Always, TestOutputIntOp (
784       [["get_pid"]], ">=", 1)],
785    "get PID of qemu subprocess",
786    "\
787 Return the process ID of the qemu subprocess.  If there is no
788 qemu subprocess, then this will return an error.
789
790 This is an internal call used for debugging and testing.");
791
792   ("version", (RStruct ("version", "version"), []), -1, [],
793    [InitNone, Always, TestOutputStruct (
794       [["version"]], [CompareWithInt ("major", 1)])],
795    "get the library version number",
796    "\
797 Return the libguestfs version number that the program is linked
798 against.
799
800 Note that because of dynamic linking this is not necessarily
801 the version of libguestfs that you compiled against.  You can
802 compile the program, and then at runtime dynamically link
803 against a completely different C<libguestfs.so> library.
804
805 This call was added in version C<1.0.58>.  In previous
806 versions of libguestfs there was no way to get the version
807 number.  From C code you can use dynamic linker functions
808 to find out if this symbol exists (if it doesn't, then
809 it's an earlier version).
810
811 The call returns a structure with four elements.  The first
812 three (C<major>, C<minor> and C<release>) are numbers and
813 correspond to the usual version triplet.  The fourth element
814 (C<extra>) is a string and is normally empty, but may be
815 used for distro-specific information.
816
817 To construct the original version string:
818 C<$major.$minor.$release$extra>
819
820 See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
821
822 I<Note:> Don't use this call to test for availability
823 of features.  In enterprise distributions we backport
824 features from later versions into earlier versions,
825 making this an unreliable way to test for features.
826 Use C<guestfs_available> instead.");
827
828   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
829    [InitNone, Always, TestOutputTrue (
830       [["set_selinux"; "true"];
831        ["get_selinux"]])],
832    "set SELinux enabled or disabled at appliance boot",
833    "\
834 This sets the selinux flag that is passed to the appliance
835 at boot time.  The default is C<selinux=0> (disabled).
836
837 Note that if SELinux is enabled, it is always in
838 Permissive mode (C<enforcing=0>).
839
840 For more information on the architecture of libguestfs,
841 see L<guestfs(3)>.");
842
843   ("get_selinux", (RBool "selinux", []), -1, [],
844    [],
845    "get SELinux enabled flag",
846    "\
847 This returns the current setting of the selinux flag which
848 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
849
850 For more information on the architecture of libguestfs,
851 see L<guestfs(3)>.");
852
853   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
854    [InitNone, Always, TestOutputFalse (
855       [["set_trace"; "false"];
856        ["get_trace"]])],
857    "enable or disable command traces",
858    "\
859 If the command trace flag is set to 1, then commands are
860 printed on stderr before they are executed in a format
861 which is very similar to the one used by guestfish.  In
862 other words, you can run a program with this enabled, and
863 you will get out a script which you can feed to guestfish
864 to perform the same set of actions.
865
866 If you want to trace C API calls into libguestfs (and
867 other libraries) then possibly a better way is to use
868 the external ltrace(1) command.
869
870 Command traces are disabled unless the environment variable
871 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
872
873   ("get_trace", (RBool "trace", []), -1, [],
874    [],
875    "get command trace enabled flag",
876    "\
877 Return the command trace flag.");
878
879   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
880    [InitNone, Always, TestOutputFalse (
881       [["set_direct"; "false"];
882        ["get_direct"]])],
883    "enable or disable direct appliance mode",
884    "\
885 If the direct appliance mode flag is enabled, then stdin and
886 stdout are passed directly through to the appliance once it
887 is launched.
888
889 One consequence of this is that log messages aren't caught
890 by the library and handled by C<guestfs_set_log_message_callback>,
891 but go straight to stdout.
892
893 You probably don't want to use this unless you know what you
894 are doing.
895
896 The default is disabled.");
897
898   ("get_direct", (RBool "direct", []), -1, [],
899    [],
900    "get direct appliance mode flag",
901    "\
902 Return the direct appliance mode flag.");
903
904   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
905    [InitNone, Always, TestOutputTrue (
906       [["set_recovery_proc"; "true"];
907        ["get_recovery_proc"]])],
908    "enable or disable the recovery process",
909    "\
910 If this is called with the parameter C<false> then
911 C<guestfs_launch> does not create a recovery process.  The
912 purpose of the recovery process is to stop runaway qemu
913 processes in the case where the main program aborts abruptly.
914
915 This only has any effect if called before C<guestfs_launch>,
916 and the default is true.
917
918 About the only time when you would want to disable this is
919 if the main process will fork itself into the background
920 (\"daemonize\" itself).  In this case the recovery process
921 thinks that the main program has disappeared and so kills
922 qemu, which is not very helpful.");
923
924   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
925    [],
926    "get recovery process enabled flag",
927    "\
928 Return the recovery process enabled flag.");
929
930   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
931    [],
932    "add a drive specifying the QEMU block emulation to use",
933    "\
934 This is the same as C<guestfs_add_drive> but it allows you
935 to specify the QEMU interface emulation to use at run time.");
936
937   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
938    [],
939    "add a drive read-only specifying the QEMU block emulation to use",
940    "\
941 This is the same as C<guestfs_add_drive_ro> but it allows you
942 to specify the QEMU interface emulation to use at run time.");
943
944   ("file_architecture", (RString "arch", [Pathname "filename"]), -1, [],
945    [InitISOFS, Always, TestOutput (
946       [["file_architecture"; "/bin-i586-dynamic"]], "i386");
947     InitISOFS, Always, TestOutput (
948       [["file_architecture"; "/bin-sparc-dynamic"]], "sparc");
949     InitISOFS, Always, TestOutput (
950       [["file_architecture"; "/bin-win32.exe"]], "i386");
951     InitISOFS, Always, TestOutput (
952       [["file_architecture"; "/bin-win64.exe"]], "x86_64");
953     InitISOFS, Always, TestOutput (
954       [["file_architecture"; "/bin-x86_64-dynamic"]], "x86_64");
955     InitISOFS, Always, TestOutput (
956       [["file_architecture"; "/lib-i586.so"]], "i386");
957     InitISOFS, Always, TestOutput (
958       [["file_architecture"; "/lib-sparc.so"]], "sparc");
959     InitISOFS, Always, TestOutput (
960       [["file_architecture"; "/lib-win32.dll"]], "i386");
961     InitISOFS, Always, TestOutput (
962       [["file_architecture"; "/lib-win64.dll"]], "x86_64");
963     InitISOFS, Always, TestOutput (
964       [["file_architecture"; "/lib-x86_64.so"]], "x86_64");
965     InitISOFS, Always, TestOutput (
966       [["file_architecture"; "/initrd-x86_64.img"]], "x86_64");
967     InitISOFS, Always, TestOutput (
968       [["file_architecture"; "/initrd-x86_64.img.gz"]], "x86_64");],
969    "detect the architecture of a binary file",
970    "\
971 This detects the architecture of the binary C<filename>,
972 and returns it if known.
973
974 Currently defined architectures are:
975
976 =over 4
977
978 =item \"i386\"
979
980 This string is returned for all 32 bit i386, i486, i586, i686 binaries
981 irrespective of the precise processor requirements of the binary.
982
983 =item \"x86_64\"
984
985 64 bit x86-64.
986
987 =item \"sparc\"
988
989 32 bit SPARC.
990
991 =item \"sparc64\"
992
993 64 bit SPARC V9 and above.
994
995 =item \"ia64\"
996
997 Intel Itanium.
998
999 =item \"ppc\"
1000
1001 32 bit Power PC.
1002
1003 =item \"ppc64\"
1004
1005 64 bit Power PC.
1006
1007 =back
1008
1009 Libguestfs may return other architecture strings in future.
1010
1011 The function works on at least the following types of files:
1012
1013 =over 4
1014
1015 =item *
1016
1017 many types of Un*x and Linux binary
1018
1019 =item *
1020
1021 many types of Un*x and Linux shared library
1022
1023 =item *
1024
1025 Windows Win32 and Win64 binaries
1026
1027 =item *
1028
1029 Windows Win32 and Win64 DLLs
1030
1031 Win32 binaries and DLLs return C<i386>.
1032
1033 Win64 binaries and DLLs return C<x86_64>.
1034
1035 =item *
1036
1037 Linux kernel modules
1038
1039 =item *
1040
1041 Linux new-style initrd images
1042
1043 =item *
1044
1045 some non-x86 Linux vmlinuz kernels
1046
1047 =back
1048
1049 What it can't do currently:
1050
1051 =over 4
1052
1053 =item *
1054
1055 static libraries (libfoo.a)
1056
1057 =item *
1058
1059 Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
1060
1061 =item *
1062
1063 x86 Linux vmlinuz kernels
1064
1065 x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
1066 compressed code, and are horribly hard to unpack.  If you want to find
1067 the architecture of a kernel, use the architecture of the associated
1068 initrd or kernel module(s) instead.
1069
1070 =back");
1071
1072   ("inspect_os", (RStringList "roots", []), -1, [],
1073    [],
1074    "inspect disk and return list of operating systems found",
1075    "\
1076 This function uses other libguestfs functions and certain
1077 heuristics to inspect the disk(s) (usually disks belonging to
1078 a virtual machine), looking for operating systems.
1079
1080 The list returned is empty if no operating systems were found.
1081
1082 If one operating system was found, then this returns a list with
1083 a single element, which is the name of the root filesystem of
1084 this operating system.  It is also possible for this function
1085 to return a list containing more than one element, indicating
1086 a dual-boot or multi-boot virtual machine, with each element being
1087 the root filesystem of one of the operating systems.
1088
1089 You can pass the root string(s) returned to other
1090 C<guestfs_inspect_get_*> functions in order to query further
1091 information about each operating system, such as the name
1092 and version.
1093
1094 This function uses other libguestfs features such as
1095 C<guestfs_mount_ro> and C<guestfs_umount_all> in order to mount
1096 and unmount filesystems and look at the contents.  This should
1097 be called with no disks currently mounted.  The function may also
1098 use Augeas, so any existing Augeas handle will be closed.
1099
1100 This function cannot decrypt encrypted disks.  The caller
1101 must do that first (supplying the necessary keys) if the
1102 disk is encrypted.
1103
1104 Please read L<guestfs(3)/INSPECTION> for more details.");
1105
1106   ("inspect_get_type", (RString "name", [Device "root"]), -1, [],
1107    [],
1108    "get type of inspected operating system",
1109    "\
1110 This function should only be called with a root device string
1111 as returned by C<guestfs_inspect_os>.
1112
1113 This returns the type of the inspected operating system.
1114 Currently defined types are:
1115
1116 =over 4
1117
1118 =item \"linux\"
1119
1120 Any Linux-based operating system.
1121
1122 =item \"windows\"
1123
1124 Any Microsoft Windows operating system.
1125
1126 =item \"unknown\"
1127
1128 The operating system type could not be determined.
1129
1130 =back
1131
1132 Future versions of libguestfs may return other strings here.
1133 The caller should be prepared to handle any string.
1134
1135 Please read L<guestfs(3)/INSPECTION> for more details.");
1136
1137   ("inspect_get_arch", (RString "arch", [Device "root"]), -1, [],
1138    [],
1139    "get architecture of inspected operating system",
1140    "\
1141 This function should only be called with a root device string
1142 as returned by C<guestfs_inspect_os>.
1143
1144 This returns the architecture of the inspected operating system.
1145 The possible return values are listed under
1146 C<guestfs_file_architecture>.
1147
1148 If the architecture could not be determined, then the
1149 string C<unknown> is returned.
1150
1151 Please read L<guestfs(3)/INSPECTION> for more details.");
1152
1153   ("inspect_get_distro", (RString "distro", [Device "root"]), -1, [],
1154    [],
1155    "get distro of inspected operating system",
1156    "\
1157 This function should only be called with a root device string
1158 as returned by C<guestfs_inspect_os>.
1159
1160 This returns the distro (distribution) of the inspected operating
1161 system.
1162
1163 Currently defined distros are:
1164
1165 =over 4
1166
1167 =item \"debian\"
1168
1169 Debian or a Debian-derived distro such as Ubuntu.
1170
1171 =item \"fedora\"
1172
1173 Fedora.
1174
1175 =item \"redhat-based\"
1176
1177 Some Red Hat-derived distro.
1178
1179 =item \"rhel\"
1180
1181 Red Hat Enterprise Linux and some derivatives.
1182
1183 =item \"windows\"
1184
1185 Windows does not have distributions.  This string is
1186 returned if the OS type is Windows.
1187
1188 =item \"unknown\"
1189
1190 The distro could not be determined.
1191
1192 =back
1193
1194 Future versions of libguestfs may return other strings here.
1195 The caller should be prepared to handle any string.
1196
1197 Please read L<guestfs(3)/INSPECTION> for more details.");
1198
1199   ("inspect_get_major_version", (RInt "major", [Device "root"]), -1, [],
1200    [],
1201    "get major version of inspected operating system",
1202    "\
1203 This function should only be called with a root device string
1204 as returned by C<guestfs_inspect_os>.
1205
1206 This returns the major version number of the inspected operating
1207 system.
1208
1209 Windows uses a consistent versioning scheme which is I<not>
1210 reflected in the popular public names used by the operating system.
1211 Notably the operating system known as \"Windows 7\" is really
1212 version 6.1 (ie. major = 6, minor = 1).  You can find out the
1213 real versions corresponding to releases of Windows by consulting
1214 Wikipedia or MSDN.
1215
1216 If the version could not be determined, then C<0> is returned.
1217
1218 Please read L<guestfs(3)/INSPECTION> for more details.");
1219
1220   ("inspect_get_minor_version", (RInt "minor", [Device "root"]), -1, [],
1221    [],
1222    "get minor version of inspected operating system",
1223    "\
1224 This function should only be called with a root device string
1225 as returned by C<guestfs_inspect_os>.
1226
1227 This returns the minor version number of the inspected operating
1228 system.
1229
1230 If the version could not be determined, then C<0> is returned.
1231
1232 Please read L<guestfs(3)/INSPECTION> for more details.
1233 See also C<guestfs_inspect_get_major_version>.");
1234
1235   ("inspect_get_product_name", (RString "product", [Device "root"]), -1, [],
1236    [],
1237    "get product name of inspected operating system",
1238    "\
1239 This function should only be called with a root device string
1240 as returned by C<guestfs_inspect_os>.
1241
1242 This returns the product name of the inspected operating
1243 system.  The product name is generally some freeform string
1244 which can be displayed to the user, but should not be
1245 parsed by programs.
1246
1247 If the product name could not be determined, then the
1248 string C<unknown> is returned.
1249
1250 Please read L<guestfs(3)/INSPECTION> for more details.");
1251
1252   ("inspect_get_mountpoints", (RHashtable "mountpoints", [Device "root"]), -1, [],
1253    [],
1254    "get mountpoints of inspected operating system",
1255    "\
1256 This function should only be called with a root device string
1257 as returned by C<guestfs_inspect_os>.
1258
1259 This returns a hash of where we think the filesystems
1260 associated with this operating system should be mounted.
1261 Callers should note that this is at best an educated guess
1262 made by reading configuration files such as C</etc/fstab>.
1263
1264 Each element in the returned hashtable has a key which
1265 is the path of the mountpoint (eg. C</boot>) and a value
1266 which is the filesystem that would be mounted there
1267 (eg. C</dev/sda1>).
1268
1269 Non-mounted devices such as swap devices are I<not>
1270 returned in this list.
1271
1272 Please read L<guestfs(3)/INSPECTION> for more details.
1273 See also C<guestfs_inspect_get_filesystems>.");
1274
1275   ("inspect_get_filesystems", (RStringList "filesystems", [Device "root"]), -1, [],
1276    [],
1277    "get filesystems associated with inspected operating system",
1278    "\
1279 This function should only be called with a root device string
1280 as returned by C<guestfs_inspect_os>.
1281
1282 This returns a list of all the filesystems that we think
1283 are associated with this operating system.  This includes
1284 the root filesystem, other ordinary filesystems, and
1285 non-mounted devices like swap partitions.
1286
1287 In the case of a multi-boot virtual machine, it is possible
1288 for a filesystem to be shared between operating systems.
1289
1290 Please read L<guestfs(3)/INSPECTION> for more details.
1291 See also C<guestfs_inspect_get_mountpoints>.");
1292
1293   ("set_network", (RErr, [Bool "network"]), -1, [FishAlias "network"],
1294    [],
1295    "set enable network flag",
1296    "\
1297 If C<network> is true, then the network is enabled in the
1298 libguestfs appliance.  The default is false.
1299
1300 This affects whether commands are able to access the network
1301 (see L<guestfs(3)/RUNNING COMMANDS>).
1302
1303 You must call this before calling C<guestfs_launch>, otherwise
1304 it has no effect.");
1305
1306   ("get_network", (RBool "network", []), -1, [],
1307    [],
1308    "get enable network flag",
1309    "\
1310 This returns the enable network flag.");
1311
1312 ]
1313
1314 (* daemon_functions are any functions which cause some action
1315  * to take place in the daemon.
1316  *)
1317
1318 let daemon_functions = [
1319   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
1320    [InitEmpty, Always, TestOutput (
1321       [["part_disk"; "/dev/sda"; "mbr"];
1322        ["mkfs"; "ext2"; "/dev/sda1"];
1323        ["mount"; "/dev/sda1"; "/"];
1324        ["write"; "/new"; "new file contents"];
1325        ["cat"; "/new"]], "new file contents")],
1326    "mount a guest disk at a position in the filesystem",
1327    "\
1328 Mount a guest disk at a position in the filesystem.  Block devices
1329 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
1330 the guest.  If those block devices contain partitions, they will have
1331 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
1332 names can be used.
1333
1334 The rules are the same as for L<mount(2)>:  A filesystem must
1335 first be mounted on C</> before others can be mounted.  Other
1336 filesystems can only be mounted on directories which already
1337 exist.
1338
1339 The mounted filesystem is writable, if we have sufficient permissions
1340 on the underlying device.
1341
1342 B<Important note:>
1343 When you use this call, the filesystem options C<sync> and C<noatime>
1344 are set implicitly.  This was originally done because we thought it
1345 would improve reliability, but it turns out that I<-o sync> has a
1346 very large negative performance impact and negligible effect on
1347 reliability.  Therefore we recommend that you avoid using
1348 C<guestfs_mount> in any code that needs performance, and instead
1349 use C<guestfs_mount_options> (use an empty string for the first
1350 parameter if you don't want any options).");
1351
1352   ("sync", (RErr, []), 2, [],
1353    [ InitEmpty, Always, TestRun [["sync"]]],
1354    "sync disks, writes are flushed through to the disk image",
1355    "\
1356 This syncs the disk, so that any writes are flushed through to the
1357 underlying disk image.
1358
1359 You should always call this if you have modified a disk image, before
1360 closing the handle.");
1361
1362   ("touch", (RErr, [Pathname "path"]), 3, [],
1363    [InitBasicFS, Always, TestOutputTrue (
1364       [["touch"; "/new"];
1365        ["exists"; "/new"]])],
1366    "update file timestamps or create a new file",
1367    "\
1368 Touch acts like the L<touch(1)> command.  It can be used to
1369 update the timestamps on a file, or, if the file does not exist,
1370 to create a new zero-length file.
1371
1372 This command only works on regular files, and will fail on other
1373 file types such as directories, symbolic links, block special etc.");
1374
1375   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
1376    [InitISOFS, Always, TestOutput (
1377       [["cat"; "/known-2"]], "abcdef\n")],
1378    "list the contents of a file",
1379    "\
1380 Return the contents of the file named C<path>.
1381
1382 Note that this function cannot correctly handle binary files
1383 (specifically, files containing C<\\0> character which is treated
1384 as end of string).  For those you need to use the C<guestfs_read_file>
1385 or C<guestfs_download> functions which have a more complex interface.");
1386
1387   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
1388    [], (* XXX Tricky to test because it depends on the exact format
1389         * of the 'ls -l' command, which changes between F10 and F11.
1390         *)
1391    "list the files in a directory (long format)",
1392    "\
1393 List the files in C<directory> (relative to the root directory,
1394 there is no cwd) in the format of 'ls -la'.
1395
1396 This command is mostly useful for interactive sessions.  It
1397 is I<not> intended that you try to parse the output string.");
1398
1399   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1400    [InitBasicFS, Always, TestOutputList (
1401       [["touch"; "/new"];
1402        ["touch"; "/newer"];
1403        ["touch"; "/newest"];
1404        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1405    "list the files in a directory",
1406    "\
1407 List the files in C<directory> (relative to the root directory,
1408 there is no cwd).  The '.' and '..' entries are not returned, but
1409 hidden files are shown.
1410
1411 This command is mostly useful for interactive sessions.  Programs
1412 should probably use C<guestfs_readdir> instead.");
1413
1414   ("list_devices", (RStringList "devices", []), 7, [],
1415    [InitEmpty, Always, TestOutputListOfDevices (
1416       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1417    "list the block devices",
1418    "\
1419 List all the block devices.
1420
1421 The full block device names are returned, eg. C</dev/sda>");
1422
1423   ("list_partitions", (RStringList "partitions", []), 8, [],
1424    [InitBasicFS, Always, TestOutputListOfDevices (
1425       [["list_partitions"]], ["/dev/sda1"]);
1426     InitEmpty, Always, TestOutputListOfDevices (
1427       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1428        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1429    "list the partitions",
1430    "\
1431 List all the partitions detected on all block devices.
1432
1433 The full partition device names are returned, eg. C</dev/sda1>
1434
1435 This does not return logical volumes.  For that you will need to
1436 call C<guestfs_lvs>.");
1437
1438   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1439    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1440       [["pvs"]], ["/dev/sda1"]);
1441     InitEmpty, Always, TestOutputListOfDevices (
1442       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1443        ["pvcreate"; "/dev/sda1"];
1444        ["pvcreate"; "/dev/sda2"];
1445        ["pvcreate"; "/dev/sda3"];
1446        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1447    "list the LVM physical volumes (PVs)",
1448    "\
1449 List all the physical volumes detected.  This is the equivalent
1450 of the L<pvs(8)> command.
1451
1452 This returns a list of just the device names that contain
1453 PVs (eg. C</dev/sda2>).
1454
1455 See also C<guestfs_pvs_full>.");
1456
1457   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1458    [InitBasicFSonLVM, Always, TestOutputList (
1459       [["vgs"]], ["VG"]);
1460     InitEmpty, Always, TestOutputList (
1461       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1462        ["pvcreate"; "/dev/sda1"];
1463        ["pvcreate"; "/dev/sda2"];
1464        ["pvcreate"; "/dev/sda3"];
1465        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1466        ["vgcreate"; "VG2"; "/dev/sda3"];
1467        ["vgs"]], ["VG1"; "VG2"])],
1468    "list the LVM volume groups (VGs)",
1469    "\
1470 List all the volumes groups detected.  This is the equivalent
1471 of the L<vgs(8)> command.
1472
1473 This returns a list of just the volume group names that were
1474 detected (eg. C<VolGroup00>).
1475
1476 See also C<guestfs_vgs_full>.");
1477
1478   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1479    [InitBasicFSonLVM, Always, TestOutputList (
1480       [["lvs"]], ["/dev/VG/LV"]);
1481     InitEmpty, Always, TestOutputList (
1482       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1483        ["pvcreate"; "/dev/sda1"];
1484        ["pvcreate"; "/dev/sda2"];
1485        ["pvcreate"; "/dev/sda3"];
1486        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1487        ["vgcreate"; "VG2"; "/dev/sda3"];
1488        ["lvcreate"; "LV1"; "VG1"; "50"];
1489        ["lvcreate"; "LV2"; "VG1"; "50"];
1490        ["lvcreate"; "LV3"; "VG2"; "50"];
1491        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1492    "list the LVM logical volumes (LVs)",
1493    "\
1494 List all the logical volumes detected.  This is the equivalent
1495 of the L<lvs(8)> command.
1496
1497 This returns a list of the logical volume device names
1498 (eg. C</dev/VolGroup00/LogVol00>).
1499
1500 See also C<guestfs_lvs_full>.");
1501
1502   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1503    [], (* XXX how to test? *)
1504    "list the LVM physical volumes (PVs)",
1505    "\
1506 List all the physical volumes detected.  This is the equivalent
1507 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1508
1509   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1510    [], (* XXX how to test? *)
1511    "list the LVM volume groups (VGs)",
1512    "\
1513 List all the volumes groups detected.  This is the equivalent
1514 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1515
1516   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1517    [], (* XXX how to test? *)
1518    "list the LVM logical volumes (LVs)",
1519    "\
1520 List all the logical volumes detected.  This is the equivalent
1521 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1522
1523   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1524    [InitISOFS, Always, TestOutputList (
1525       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1526     InitISOFS, Always, TestOutputList (
1527       [["read_lines"; "/empty"]], [])],
1528    "read file as lines",
1529    "\
1530 Return the contents of the file named C<path>.
1531
1532 The file contents are returned as a list of lines.  Trailing
1533 C<LF> and C<CRLF> character sequences are I<not> returned.
1534
1535 Note that this function cannot correctly handle binary files
1536 (specifically, files containing C<\\0> character which is treated
1537 as end of line).  For those you need to use the C<guestfs_read_file>
1538 function which has a more complex interface.");
1539
1540   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1541    [], (* XXX Augeas code needs tests. *)
1542    "create a new Augeas handle",
1543    "\
1544 Create a new Augeas handle for editing configuration files.
1545 If there was any previous Augeas handle associated with this
1546 guestfs session, then it is closed.
1547
1548 You must call this before using any other C<guestfs_aug_*>
1549 commands.
1550
1551 C<root> is the filesystem root.  C<root> must not be NULL,
1552 use C</> instead.
1553
1554 The flags are the same as the flags defined in
1555 E<lt>augeas.hE<gt>, the logical I<or> of the following
1556 integers:
1557
1558 =over 4
1559
1560 =item C<AUG_SAVE_BACKUP> = 1
1561
1562 Keep the original file with a C<.augsave> extension.
1563
1564 =item C<AUG_SAVE_NEWFILE> = 2
1565
1566 Save changes into a file with extension C<.augnew>, and
1567 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1568
1569 =item C<AUG_TYPE_CHECK> = 4
1570
1571 Typecheck lenses (can be expensive).
1572
1573 =item C<AUG_NO_STDINC> = 8
1574
1575 Do not use standard load path for modules.
1576
1577 =item C<AUG_SAVE_NOOP> = 16
1578
1579 Make save a no-op, just record what would have been changed.
1580
1581 =item C<AUG_NO_LOAD> = 32
1582
1583 Do not load the tree in C<guestfs_aug_init>.
1584
1585 =back
1586
1587 To close the handle, you can call C<guestfs_aug_close>.
1588
1589 To find out more about Augeas, see L<http://augeas.net/>.");
1590
1591   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1592    [], (* XXX Augeas code needs tests. *)
1593    "close the current Augeas handle",
1594    "\
1595 Close the current Augeas handle and free up any resources
1596 used by it.  After calling this, you have to call
1597 C<guestfs_aug_init> again before you can use any other
1598 Augeas functions.");
1599
1600   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1601    [], (* XXX Augeas code needs tests. *)
1602    "define an Augeas variable",
1603    "\
1604 Defines an Augeas variable C<name> whose value is the result
1605 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1606 undefined.
1607
1608 On success this returns the number of nodes in C<expr>, or
1609 C<0> if C<expr> evaluates to something which is not a nodeset.");
1610
1611   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1612    [], (* XXX Augeas code needs tests. *)
1613    "define an Augeas node",
1614    "\
1615 Defines a variable C<name> whose value is the result of
1616 evaluating C<expr>.
1617
1618 If C<expr> evaluates to an empty nodeset, a node is created,
1619 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1620 C<name> will be the nodeset containing that single node.
1621
1622 On success this returns a pair containing the
1623 number of nodes in the nodeset, and a boolean flag
1624 if a node was created.");
1625
1626   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1627    [], (* XXX Augeas code needs tests. *)
1628    "look up the value of an Augeas path",
1629    "\
1630 Look up the value associated with C<path>.  If C<path>
1631 matches exactly one node, the C<value> is returned.");
1632
1633   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1634    [], (* XXX Augeas code needs tests. *)
1635    "set Augeas path to value",
1636    "\
1637 Set the value associated with C<path> to C<val>.
1638
1639 In the Augeas API, it is possible to clear a node by setting
1640 the value to NULL.  Due to an oversight in the libguestfs API
1641 you cannot do that with this call.  Instead you must use the
1642 C<guestfs_aug_clear> call.");
1643
1644   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1645    [], (* XXX Augeas code needs tests. *)
1646    "insert a sibling Augeas node",
1647    "\
1648 Create a new sibling C<label> for C<path>, inserting it into
1649 the tree before or after C<path> (depending on the boolean
1650 flag C<before>).
1651
1652 C<path> must match exactly one existing node in the tree, and
1653 C<label> must be a label, ie. not contain C</>, C<*> or end
1654 with a bracketed index C<[N]>.");
1655
1656   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1657    [], (* XXX Augeas code needs tests. *)
1658    "remove an Augeas path",
1659    "\
1660 Remove C<path> and all of its children.
1661
1662 On success this returns the number of entries which were removed.");
1663
1664   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1665    [], (* XXX Augeas code needs tests. *)
1666    "move Augeas node",
1667    "\
1668 Move the node C<src> to C<dest>.  C<src> must match exactly
1669 one node.  C<dest> is overwritten if it exists.");
1670
1671   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1672    [], (* XXX Augeas code needs tests. *)
1673    "return Augeas nodes which match augpath",
1674    "\
1675 Returns a list of paths which match the path expression C<path>.
1676 The returned paths are sufficiently qualified so that they match
1677 exactly one node in the current tree.");
1678
1679   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1680    [], (* XXX Augeas code needs tests. *)
1681    "write all pending Augeas changes to disk",
1682    "\
1683 This writes all pending changes to disk.
1684
1685 The flags which were passed to C<guestfs_aug_init> affect exactly
1686 how files are saved.");
1687
1688   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1689    [], (* XXX Augeas code needs tests. *)
1690    "load files into the tree",
1691    "\
1692 Load files into the tree.
1693
1694 See C<aug_load> in the Augeas documentation for the full gory
1695 details.");
1696
1697   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1698    [], (* XXX Augeas code needs tests. *)
1699    "list Augeas nodes under augpath",
1700    "\
1701 This is just a shortcut for listing C<guestfs_aug_match>
1702 C<path/*> and sorting the resulting nodes into alphabetical order.");
1703
1704   ("rm", (RErr, [Pathname "path"]), 29, [],
1705    [InitBasicFS, Always, TestRun
1706       [["touch"; "/new"];
1707        ["rm"; "/new"]];
1708     InitBasicFS, Always, TestLastFail
1709       [["rm"; "/new"]];
1710     InitBasicFS, Always, TestLastFail
1711       [["mkdir"; "/new"];
1712        ["rm"; "/new"]]],
1713    "remove a file",
1714    "\
1715 Remove the single file C<path>.");
1716
1717   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1718    [InitBasicFS, Always, TestRun
1719       [["mkdir"; "/new"];
1720        ["rmdir"; "/new"]];
1721     InitBasicFS, Always, TestLastFail
1722       [["rmdir"; "/new"]];
1723     InitBasicFS, Always, TestLastFail
1724       [["touch"; "/new"];
1725        ["rmdir"; "/new"]]],
1726    "remove a directory",
1727    "\
1728 Remove the single directory C<path>.");
1729
1730   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1731    [InitBasicFS, Always, TestOutputFalse
1732       [["mkdir"; "/new"];
1733        ["mkdir"; "/new/foo"];
1734        ["touch"; "/new/foo/bar"];
1735        ["rm_rf"; "/new"];
1736        ["exists"; "/new"]]],
1737    "remove a file or directory recursively",
1738    "\
1739 Remove the file or directory C<path>, recursively removing the
1740 contents if its a directory.  This is like the C<rm -rf> shell
1741 command.");
1742
1743   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1744    [InitBasicFS, Always, TestOutputTrue
1745       [["mkdir"; "/new"];
1746        ["is_dir"; "/new"]];
1747     InitBasicFS, Always, TestLastFail
1748       [["mkdir"; "/new/foo/bar"]]],
1749    "create a directory",
1750    "\
1751 Create a directory named C<path>.");
1752
1753   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1754    [InitBasicFS, Always, TestOutputTrue
1755       [["mkdir_p"; "/new/foo/bar"];
1756        ["is_dir"; "/new/foo/bar"]];
1757     InitBasicFS, Always, TestOutputTrue
1758       [["mkdir_p"; "/new/foo/bar"];
1759        ["is_dir"; "/new/foo"]];
1760     InitBasicFS, Always, TestOutputTrue
1761       [["mkdir_p"; "/new/foo/bar"];
1762        ["is_dir"; "/new"]];
1763     (* Regression tests for RHBZ#503133: *)
1764     InitBasicFS, Always, TestRun
1765       [["mkdir"; "/new"];
1766        ["mkdir_p"; "/new"]];
1767     InitBasicFS, Always, TestLastFail
1768       [["touch"; "/new"];
1769        ["mkdir_p"; "/new"]]],
1770    "create a directory and parents",
1771    "\
1772 Create a directory named C<path>, creating any parent directories
1773 as necessary.  This is like the C<mkdir -p> shell command.");
1774
1775   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1776    [], (* XXX Need stat command to test *)
1777    "change file mode",
1778    "\
1779 Change the mode (permissions) of C<path> to C<mode>.  Only
1780 numeric modes are supported.
1781
1782 I<Note>: When using this command from guestfish, C<mode>
1783 by default would be decimal, unless you prefix it with
1784 C<0> to get octal, ie. use C<0700> not C<700>.
1785
1786 The mode actually set is affected by the umask.");
1787
1788   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1789    [], (* XXX Need stat command to test *)
1790    "change file owner and group",
1791    "\
1792 Change the file owner to C<owner> and group to C<group>.
1793
1794 Only numeric uid and gid are supported.  If you want to use
1795 names, you will need to locate and parse the password file
1796 yourself (Augeas support makes this relatively easy).");
1797
1798   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1799    [InitISOFS, Always, TestOutputTrue (
1800       [["exists"; "/empty"]]);
1801     InitISOFS, Always, TestOutputTrue (
1802       [["exists"; "/directory"]])],
1803    "test if file or directory exists",
1804    "\
1805 This returns C<true> if and only if there is a file, directory
1806 (or anything) with the given C<path> name.
1807
1808 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1809
1810   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1811    [InitISOFS, Always, TestOutputTrue (
1812       [["is_file"; "/known-1"]]);
1813     InitISOFS, Always, TestOutputFalse (
1814       [["is_file"; "/directory"]])],
1815    "test if file exists",
1816    "\
1817 This returns C<true> if and only if there is a file
1818 with the given C<path> name.  Note that it returns false for
1819 other objects like directories.
1820
1821 See also C<guestfs_stat>.");
1822
1823   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1824    [InitISOFS, Always, TestOutputFalse (
1825       [["is_dir"; "/known-3"]]);
1826     InitISOFS, Always, TestOutputTrue (
1827       [["is_dir"; "/directory"]])],
1828    "test if file exists",
1829    "\
1830 This returns C<true> if and only if there is a directory
1831 with the given C<path> name.  Note that it returns false for
1832 other objects like files.
1833
1834 See also C<guestfs_stat>.");
1835
1836   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1837    [InitEmpty, Always, TestOutputListOfDevices (
1838       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1839        ["pvcreate"; "/dev/sda1"];
1840        ["pvcreate"; "/dev/sda2"];
1841        ["pvcreate"; "/dev/sda3"];
1842        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1843    "create an LVM physical volume",
1844    "\
1845 This creates an LVM physical volume on the named C<device>,
1846 where C<device> should usually be a partition name such
1847 as C</dev/sda1>.");
1848
1849   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1850    [InitEmpty, Always, TestOutputList (
1851       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1852        ["pvcreate"; "/dev/sda1"];
1853        ["pvcreate"; "/dev/sda2"];
1854        ["pvcreate"; "/dev/sda3"];
1855        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1856        ["vgcreate"; "VG2"; "/dev/sda3"];
1857        ["vgs"]], ["VG1"; "VG2"])],
1858    "create an LVM volume group",
1859    "\
1860 This creates an LVM volume group called C<volgroup>
1861 from the non-empty list of physical volumes C<physvols>.");
1862
1863   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1864    [InitEmpty, Always, TestOutputList (
1865       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1866        ["pvcreate"; "/dev/sda1"];
1867        ["pvcreate"; "/dev/sda2"];
1868        ["pvcreate"; "/dev/sda3"];
1869        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1870        ["vgcreate"; "VG2"; "/dev/sda3"];
1871        ["lvcreate"; "LV1"; "VG1"; "50"];
1872        ["lvcreate"; "LV2"; "VG1"; "50"];
1873        ["lvcreate"; "LV3"; "VG2"; "50"];
1874        ["lvcreate"; "LV4"; "VG2"; "50"];
1875        ["lvcreate"; "LV5"; "VG2"; "50"];
1876        ["lvs"]],
1877       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1878        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1879    "create an LVM logical volume",
1880    "\
1881 This creates an LVM logical volume called C<logvol>
1882 on the volume group C<volgroup>, with C<size> megabytes.");
1883
1884   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1885    [InitEmpty, Always, TestOutput (
1886       [["part_disk"; "/dev/sda"; "mbr"];
1887        ["mkfs"; "ext2"; "/dev/sda1"];
1888        ["mount_options"; ""; "/dev/sda1"; "/"];
1889        ["write"; "/new"; "new file contents"];
1890        ["cat"; "/new"]], "new file contents")],
1891    "make a filesystem",
1892    "\
1893 This creates a filesystem on C<device> (usually a partition
1894 or LVM logical volume).  The filesystem type is C<fstype>, for
1895 example C<ext3>.");
1896
1897   ("sfdisk", (RErr, [Device "device";
1898                      Int "cyls"; Int "heads"; Int "sectors";
1899                      StringList "lines"]), 43, [DangerWillRobinson],
1900    [],
1901    "create partitions on a block device",
1902    "\
1903 This is a direct interface to the L<sfdisk(8)> program for creating
1904 partitions on block devices.
1905
1906 C<device> should be a block device, for example C</dev/sda>.
1907
1908 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1909 and sectors on the device, which are passed directly to sfdisk as
1910 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1911 of these, then the corresponding parameter is omitted.  Usually for
1912 'large' disks, you can just pass C<0> for these, but for small
1913 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1914 out the right geometry and you will need to tell it.
1915
1916 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1917 information refer to the L<sfdisk(8)> manpage.
1918
1919 To create a single partition occupying the whole disk, you would
1920 pass C<lines> as a single element list, when the single element being
1921 the string C<,> (comma).
1922
1923 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1924 C<guestfs_part_init>");
1925
1926   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],
1927    (* Regression test for RHBZ#597135. *)
1928    [InitBasicFS, Always, TestLastFail
1929       [["write_file"; "/new"; "abc"; "10000"]]],
1930    "create a file",
1931    "\
1932 This call creates a file called C<path>.  The contents of the
1933 file is the string C<content> (which can contain any 8 bit data),
1934 with length C<size>.
1935
1936 As a special case, if C<size> is C<0>
1937 then the length is calculated using C<strlen> (so in this case
1938 the content cannot contain embedded ASCII NULs).
1939
1940 I<NB.> Owing to a bug, writing content containing ASCII NUL
1941 characters does I<not> work, even if the length is specified.");
1942
1943   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1944    [InitEmpty, Always, TestOutputListOfDevices (
1945       [["part_disk"; "/dev/sda"; "mbr"];
1946        ["mkfs"; "ext2"; "/dev/sda1"];
1947        ["mount_options"; ""; "/dev/sda1"; "/"];
1948        ["mounts"]], ["/dev/sda1"]);
1949     InitEmpty, Always, TestOutputList (
1950       [["part_disk"; "/dev/sda"; "mbr"];
1951        ["mkfs"; "ext2"; "/dev/sda1"];
1952        ["mount_options"; ""; "/dev/sda1"; "/"];
1953        ["umount"; "/"];
1954        ["mounts"]], [])],
1955    "unmount a filesystem",
1956    "\
1957 This unmounts the given filesystem.  The filesystem may be
1958 specified either by its mountpoint (path) or the device which
1959 contains the filesystem.");
1960
1961   ("mounts", (RStringList "devices", []), 46, [],
1962    [InitBasicFS, Always, TestOutputListOfDevices (
1963       [["mounts"]], ["/dev/sda1"])],
1964    "show mounted filesystems",
1965    "\
1966 This returns the list of currently mounted filesystems.  It returns
1967 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1968
1969 Some internal mounts are not shown.
1970
1971 See also: C<guestfs_mountpoints>");
1972
1973   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1974    [InitBasicFS, Always, TestOutputList (
1975       [["umount_all"];
1976        ["mounts"]], []);
1977     (* check that umount_all can unmount nested mounts correctly: *)
1978     InitEmpty, Always, TestOutputList (
1979       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1980        ["mkfs"; "ext2"; "/dev/sda1"];
1981        ["mkfs"; "ext2"; "/dev/sda2"];
1982        ["mkfs"; "ext2"; "/dev/sda3"];
1983        ["mount_options"; ""; "/dev/sda1"; "/"];
1984        ["mkdir"; "/mp1"];
1985        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1986        ["mkdir"; "/mp1/mp2"];
1987        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1988        ["mkdir"; "/mp1/mp2/mp3"];
1989        ["umount_all"];
1990        ["mounts"]], [])],
1991    "unmount all filesystems",
1992    "\
1993 This unmounts all mounted filesystems.
1994
1995 Some internal mounts are not unmounted by this call.");
1996
1997   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1998    [],
1999    "remove all LVM LVs, VGs and PVs",
2000    "\
2001 This command removes all LVM logical volumes, volume groups
2002 and physical volumes.");
2003
2004   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
2005    [InitISOFS, Always, TestOutput (
2006       [["file"; "/empty"]], "empty");
2007     InitISOFS, Always, TestOutput (
2008       [["file"; "/known-1"]], "ASCII text");
2009     InitISOFS, Always, TestLastFail (
2010       [["file"; "/notexists"]]);
2011     InitISOFS, Always, TestOutput (
2012       [["file"; "/abssymlink"]], "symbolic link");
2013     InitISOFS, Always, TestOutput (
2014       [["file"; "/directory"]], "directory")],
2015    "determine file type",
2016    "\
2017 This call uses the standard L<file(1)> command to determine
2018 the type or contents of the file.
2019
2020 This call will also transparently look inside various types
2021 of compressed file.
2022
2023 The exact command which runs is C<file -zb path>.  Note in
2024 particular that the filename is not prepended to the output
2025 (the C<-b> option).
2026
2027 This command can also be used on C</dev/> devices
2028 (and partitions, LV names).  You can for example use this
2029 to determine if a device contains a filesystem, although
2030 it's usually better to use C<guestfs_vfs_type>.
2031
2032 If the C<path> does not begin with C</dev/> then
2033 this command only works for the content of regular files.
2034 For other file types (directory, symbolic link etc) it
2035 will just return the string C<directory> etc.");
2036
2037   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
2038    [InitBasicFS, Always, TestOutput (
2039       [["upload"; "test-command"; "/test-command"];
2040        ["chmod"; "0o755"; "/test-command"];
2041        ["command"; "/test-command 1"]], "Result1");
2042     InitBasicFS, Always, TestOutput (
2043       [["upload"; "test-command"; "/test-command"];
2044        ["chmod"; "0o755"; "/test-command"];
2045        ["command"; "/test-command 2"]], "Result2\n");
2046     InitBasicFS, Always, TestOutput (
2047       [["upload"; "test-command"; "/test-command"];
2048        ["chmod"; "0o755"; "/test-command"];
2049        ["command"; "/test-command 3"]], "\nResult3");
2050     InitBasicFS, Always, TestOutput (
2051       [["upload"; "test-command"; "/test-command"];
2052        ["chmod"; "0o755"; "/test-command"];
2053        ["command"; "/test-command 4"]], "\nResult4\n");
2054     InitBasicFS, Always, TestOutput (
2055       [["upload"; "test-command"; "/test-command"];
2056        ["chmod"; "0o755"; "/test-command"];
2057        ["command"; "/test-command 5"]], "\nResult5\n\n");
2058     InitBasicFS, Always, TestOutput (
2059       [["upload"; "test-command"; "/test-command"];
2060        ["chmod"; "0o755"; "/test-command"];
2061        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
2062     InitBasicFS, Always, TestOutput (
2063       [["upload"; "test-command"; "/test-command"];
2064        ["chmod"; "0o755"; "/test-command"];
2065        ["command"; "/test-command 7"]], "");
2066     InitBasicFS, Always, TestOutput (
2067       [["upload"; "test-command"; "/test-command"];
2068        ["chmod"; "0o755"; "/test-command"];
2069        ["command"; "/test-command 8"]], "\n");
2070     InitBasicFS, Always, TestOutput (
2071       [["upload"; "test-command"; "/test-command"];
2072        ["chmod"; "0o755"; "/test-command"];
2073        ["command"; "/test-command 9"]], "\n\n");
2074     InitBasicFS, Always, TestOutput (
2075       [["upload"; "test-command"; "/test-command"];
2076        ["chmod"; "0o755"; "/test-command"];
2077        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
2078     InitBasicFS, Always, TestOutput (
2079       [["upload"; "test-command"; "/test-command"];
2080        ["chmod"; "0o755"; "/test-command"];
2081        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
2082     InitBasicFS, Always, TestLastFail (
2083       [["upload"; "test-command"; "/test-command"];
2084        ["chmod"; "0o755"; "/test-command"];
2085        ["command"; "/test-command"]])],
2086    "run a command from the guest filesystem",
2087    "\
2088 This call runs a command from the guest filesystem.  The
2089 filesystem must be mounted, and must contain a compatible
2090 operating system (ie. something Linux, with the same
2091 or compatible processor architecture).
2092
2093 The single parameter is an argv-style list of arguments.
2094 The first element is the name of the program to run.
2095 Subsequent elements are parameters.  The list must be
2096 non-empty (ie. must contain a program name).  Note that
2097 the command runs directly, and is I<not> invoked via
2098 the shell (see C<guestfs_sh>).
2099
2100 The return value is anything printed to I<stdout> by
2101 the command.
2102
2103 If the command returns a non-zero exit status, then
2104 this function returns an error message.  The error message
2105 string is the content of I<stderr> from the command.
2106
2107 The C<$PATH> environment variable will contain at least
2108 C</usr/bin> and C</bin>.  If you require a program from
2109 another location, you should provide the full path in the
2110 first parameter.
2111
2112 Shared libraries and data files required by the program
2113 must be available on filesystems which are mounted in the
2114 correct places.  It is the caller's responsibility to ensure
2115 all filesystems that are needed are mounted at the right
2116 locations.");
2117
2118   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
2119    [InitBasicFS, Always, TestOutputList (
2120       [["upload"; "test-command"; "/test-command"];
2121        ["chmod"; "0o755"; "/test-command"];
2122        ["command_lines"; "/test-command 1"]], ["Result1"]);
2123     InitBasicFS, Always, TestOutputList (
2124       [["upload"; "test-command"; "/test-command"];
2125        ["chmod"; "0o755"; "/test-command"];
2126        ["command_lines"; "/test-command 2"]], ["Result2"]);
2127     InitBasicFS, Always, TestOutputList (
2128       [["upload"; "test-command"; "/test-command"];
2129        ["chmod"; "0o755"; "/test-command"];
2130        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
2131     InitBasicFS, Always, TestOutputList (
2132       [["upload"; "test-command"; "/test-command"];
2133        ["chmod"; "0o755"; "/test-command"];
2134        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
2135     InitBasicFS, Always, TestOutputList (
2136       [["upload"; "test-command"; "/test-command"];
2137        ["chmod"; "0o755"; "/test-command"];
2138        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
2139     InitBasicFS, Always, TestOutputList (
2140       [["upload"; "test-command"; "/test-command"];
2141        ["chmod"; "0o755"; "/test-command"];
2142        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
2143     InitBasicFS, Always, TestOutputList (
2144       [["upload"; "test-command"; "/test-command"];
2145        ["chmod"; "0o755"; "/test-command"];
2146        ["command_lines"; "/test-command 7"]], []);
2147     InitBasicFS, Always, TestOutputList (
2148       [["upload"; "test-command"; "/test-command"];
2149        ["chmod"; "0o755"; "/test-command"];
2150        ["command_lines"; "/test-command 8"]], [""]);
2151     InitBasicFS, Always, TestOutputList (
2152       [["upload"; "test-command"; "/test-command"];
2153        ["chmod"; "0o755"; "/test-command"];
2154        ["command_lines"; "/test-command 9"]], ["";""]);
2155     InitBasicFS, Always, TestOutputList (
2156       [["upload"; "test-command"; "/test-command"];
2157        ["chmod"; "0o755"; "/test-command"];
2158        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
2159     InitBasicFS, Always, TestOutputList (
2160       [["upload"; "test-command"; "/test-command"];
2161        ["chmod"; "0o755"; "/test-command"];
2162        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
2163    "run a command, returning lines",
2164    "\
2165 This is the same as C<guestfs_command>, but splits the
2166 result into a list of lines.
2167
2168 See also: C<guestfs_sh_lines>");
2169
2170   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
2171    [InitISOFS, Always, TestOutputStruct (
2172       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
2173    "get file information",
2174    "\
2175 Returns file information for the given C<path>.
2176
2177 This is the same as the C<stat(2)> system call.");
2178
2179   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
2180    [InitISOFS, Always, TestOutputStruct (
2181       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
2182    "get file information for a symbolic link",
2183    "\
2184 Returns file information for the given C<path>.
2185
2186 This is the same as C<guestfs_stat> except that if C<path>
2187 is a symbolic link, then the link is stat-ed, not the file it
2188 refers to.
2189
2190 This is the same as the C<lstat(2)> system call.");
2191
2192   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
2193    [InitISOFS, Always, TestOutputStruct (
2194       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
2195    "get file system statistics",
2196    "\
2197 Returns file system statistics for any mounted file system.
2198 C<path> should be a file or directory in the mounted file system
2199 (typically it is the mount point itself, but it doesn't need to be).
2200
2201 This is the same as the C<statvfs(2)> system call.");
2202
2203   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
2204    [], (* XXX test *)
2205    "get ext2/ext3/ext4 superblock details",
2206    "\
2207 This returns the contents of the ext2, ext3 or ext4 filesystem
2208 superblock on C<device>.
2209
2210 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
2211 manpage for more details.  The list of fields returned isn't
2212 clearly defined, and depends on both the version of C<tune2fs>
2213 that libguestfs was built against, and the filesystem itself.");
2214
2215   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
2216    [InitEmpty, Always, TestOutputTrue (
2217       [["blockdev_setro"; "/dev/sda"];
2218        ["blockdev_getro"; "/dev/sda"]])],
2219    "set block device to read-only",
2220    "\
2221 Sets the block device named C<device> to read-only.
2222
2223 This uses the L<blockdev(8)> command.");
2224
2225   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
2226    [InitEmpty, Always, TestOutputFalse (
2227       [["blockdev_setrw"; "/dev/sda"];
2228        ["blockdev_getro"; "/dev/sda"]])],
2229    "set block device to read-write",
2230    "\
2231 Sets the block device named C<device> to read-write.
2232
2233 This uses the L<blockdev(8)> command.");
2234
2235   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
2236    [InitEmpty, Always, TestOutputTrue (
2237       [["blockdev_setro"; "/dev/sda"];
2238        ["blockdev_getro"; "/dev/sda"]])],
2239    "is block device set to read-only",
2240    "\
2241 Returns a boolean indicating if the block device is read-only
2242 (true if read-only, false if not).
2243
2244 This uses the L<blockdev(8)> command.");
2245
2246   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
2247    [InitEmpty, Always, TestOutputInt (
2248       [["blockdev_getss"; "/dev/sda"]], 512)],
2249    "get sectorsize of block device",
2250    "\
2251 This returns the size of sectors on a block device.
2252 Usually 512, but can be larger for modern devices.
2253
2254 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
2255 for that).
2256
2257 This uses the L<blockdev(8)> command.");
2258
2259   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
2260    [InitEmpty, Always, TestOutputInt (
2261       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
2262    "get blocksize of block device",
2263    "\
2264 This returns the block size of a device.
2265
2266 (Note this is different from both I<size in blocks> and
2267 I<filesystem block size>).
2268
2269 This uses the L<blockdev(8)> command.");
2270
2271   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
2272    [], (* XXX test *)
2273    "set blocksize of block device",
2274    "\
2275 This sets the block size of a device.
2276
2277 (Note this is different from both I<size in blocks> and
2278 I<filesystem block size>).
2279
2280 This uses the L<blockdev(8)> command.");
2281
2282   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
2283    [InitEmpty, Always, TestOutputInt (
2284       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
2285    "get total size of device in 512-byte sectors",
2286    "\
2287 This returns the size of the device in units of 512-byte sectors
2288 (even if the sectorsize isn't 512 bytes ... weird).
2289
2290 See also C<guestfs_blockdev_getss> for the real sector size of
2291 the device, and C<guestfs_blockdev_getsize64> for the more
2292 useful I<size in bytes>.
2293
2294 This uses the L<blockdev(8)> command.");
2295
2296   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
2297    [InitEmpty, Always, TestOutputInt (
2298       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
2299    "get total size of device in bytes",
2300    "\
2301 This returns the size of the device in bytes.
2302
2303 See also C<guestfs_blockdev_getsz>.
2304
2305 This uses the L<blockdev(8)> command.");
2306
2307   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
2308    [InitEmpty, Always, TestRun
2309       [["blockdev_flushbufs"; "/dev/sda"]]],
2310    "flush device buffers",
2311    "\
2312 This tells the kernel to flush internal buffers associated
2313 with C<device>.
2314
2315 This uses the L<blockdev(8)> command.");
2316
2317   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
2318    [InitEmpty, Always, TestRun
2319       [["blockdev_rereadpt"; "/dev/sda"]]],
2320    "reread partition table",
2321    "\
2322 Reread the partition table on C<device>.
2323
2324 This uses the L<blockdev(8)> command.");
2325
2326   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
2327    [InitBasicFS, Always, TestOutput (
2328       (* Pick a file from cwd which isn't likely to change. *)
2329       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
2330        ["checksum"; "md5"; "/COPYING.LIB"]],
2331       Digest.to_hex (Digest.file "COPYING.LIB"))],
2332    "upload a file from the local machine",
2333    "\
2334 Upload local file C<filename> to C<remotefilename> on the
2335 filesystem.
2336
2337 C<filename> can also be a named pipe.
2338
2339 See also C<guestfs_download>.");
2340
2341   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [Progress],
2342    [InitBasicFS, Always, TestOutput (
2343       (* Pick a file from cwd which isn't likely to change. *)
2344       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
2345        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
2346        ["upload"; "testdownload.tmp"; "/upload"];
2347        ["checksum"; "md5"; "/upload"]],
2348       Digest.to_hex (Digest.file "COPYING.LIB"))],
2349    "download a file to the local machine",
2350    "\
2351 Download file C<remotefilename> and save it as C<filename>
2352 on the local machine.
2353
2354 C<filename> can also be a named pipe.
2355
2356 See also C<guestfs_upload>, C<guestfs_cat>.");
2357
2358   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
2359    [InitISOFS, Always, TestOutput (
2360       [["checksum"; "crc"; "/known-3"]], "2891671662");
2361     InitISOFS, Always, TestLastFail (
2362       [["checksum"; "crc"; "/notexists"]]);
2363     InitISOFS, Always, TestOutput (
2364       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
2365     InitISOFS, Always, TestOutput (
2366       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
2367     InitISOFS, Always, TestOutput (
2368       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
2369     InitISOFS, Always, TestOutput (
2370       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
2371     InitISOFS, Always, TestOutput (
2372       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
2373     InitISOFS, Always, TestOutput (
2374       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6");
2375     (* Test for RHBZ#579608, absolute symbolic links. *)
2376     InitISOFS, Always, TestOutput (
2377       [["checksum"; "sha512"; "/abssymlink"]], "5f57d0639bc95081c53afc63a449403883818edc64da48930ad6b1a4fb49be90404686877743fbcd7c99811f3def7df7bc22635c885c6a8cf79c806b43451c1a")],
2378    "compute MD5, SHAx or CRC checksum of file",
2379    "\
2380 This call computes the MD5, SHAx or CRC checksum of the
2381 file named C<path>.
2382
2383 The type of checksum to compute is given by the C<csumtype>
2384 parameter which must have one of the following values:
2385
2386 =over 4
2387
2388 =item C<crc>
2389
2390 Compute the cyclic redundancy check (CRC) specified by POSIX
2391 for the C<cksum> command.
2392
2393 =item C<md5>
2394
2395 Compute the MD5 hash (using the C<md5sum> program).
2396
2397 =item C<sha1>
2398
2399 Compute the SHA1 hash (using the C<sha1sum> program).
2400
2401 =item C<sha224>
2402
2403 Compute the SHA224 hash (using the C<sha224sum> program).
2404
2405 =item C<sha256>
2406
2407 Compute the SHA256 hash (using the C<sha256sum> program).
2408
2409 =item C<sha384>
2410
2411 Compute the SHA384 hash (using the C<sha384sum> program).
2412
2413 =item C<sha512>
2414
2415 Compute the SHA512 hash (using the C<sha512sum> program).
2416
2417 =back
2418
2419 The checksum is returned as a printable string.
2420
2421 To get the checksum for a device, use C<guestfs_checksum_device>.
2422
2423 To get the checksums for many files, use C<guestfs_checksums_out>.");
2424
2425   ("tar_in", (RErr, [FileIn "tarfile"; Pathname "directory"]), 69, [],
2426    [InitBasicFS, Always, TestOutput (
2427       [["tar_in"; "../images/helloworld.tar"; "/"];
2428        ["cat"; "/hello"]], "hello\n")],
2429    "unpack tarfile to directory",
2430    "\
2431 This command uploads and unpacks local file C<tarfile> (an
2432 I<uncompressed> tar file) into C<directory>.
2433
2434 To upload a compressed tarball, use C<guestfs_tgz_in>
2435 or C<guestfs_txz_in>.");
2436
2437   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2438    [],
2439    "pack directory into tarfile",
2440    "\
2441 This command packs the contents of C<directory> and downloads
2442 it to local file C<tarfile>.
2443
2444 To download a compressed tarball, use C<guestfs_tgz_out>
2445 or C<guestfs_txz_out>.");
2446
2447   ("tgz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 71, [],
2448    [InitBasicFS, Always, TestOutput (
2449       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2450        ["cat"; "/hello"]], "hello\n")],
2451    "unpack compressed tarball to directory",
2452    "\
2453 This command uploads and unpacks local file C<tarball> (a
2454 I<gzip compressed> tar file) into C<directory>.
2455
2456 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2457
2458   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2459    [],
2460    "pack directory into compressed tarball",
2461    "\
2462 This command packs the contents of C<directory> and downloads
2463 it to local file C<tarball>.
2464
2465 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2466
2467   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2468    [InitBasicFS, Always, TestLastFail (
2469       [["umount"; "/"];
2470        ["mount_ro"; "/dev/sda1"; "/"];
2471        ["touch"; "/new"]]);
2472     InitBasicFS, Always, TestOutput (
2473       [["write"; "/new"; "data"];
2474        ["umount"; "/"];
2475        ["mount_ro"; "/dev/sda1"; "/"];
2476        ["cat"; "/new"]], "data")],
2477    "mount a guest disk, read-only",
2478    "\
2479 This is the same as the C<guestfs_mount> command, but it
2480 mounts the filesystem with the read-only (I<-o ro>) flag.");
2481
2482   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2483    [],
2484    "mount a guest disk with mount options",
2485    "\
2486 This is the same as the C<guestfs_mount> command, but it
2487 allows you to set the mount options as for the
2488 L<mount(8)> I<-o> flag.
2489
2490 If the C<options> parameter is an empty string, then
2491 no options are passed (all options default to whatever
2492 the filesystem uses).");
2493
2494   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2495    [],
2496    "mount a guest disk with mount options and vfstype",
2497    "\
2498 This is the same as the C<guestfs_mount> command, but it
2499 allows you to set both the mount options and the vfstype
2500 as for the L<mount(8)> I<-o> and I<-t> flags.");
2501
2502   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2503    [],
2504    "debugging and internals",
2505    "\
2506 The C<guestfs_debug> command exposes some internals of
2507 C<guestfsd> (the guestfs daemon) that runs inside the
2508 qemu subprocess.
2509
2510 There is no comprehensive help for this command.  You have
2511 to look at the file C<daemon/debug.c> in the libguestfs source
2512 to find out what you can do.");
2513
2514   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2515    [InitEmpty, Always, TestOutputList (
2516       [["part_disk"; "/dev/sda"; "mbr"];
2517        ["pvcreate"; "/dev/sda1"];
2518        ["vgcreate"; "VG"; "/dev/sda1"];
2519        ["lvcreate"; "LV1"; "VG"; "50"];
2520        ["lvcreate"; "LV2"; "VG"; "50"];
2521        ["lvremove"; "/dev/VG/LV1"];
2522        ["lvs"]], ["/dev/VG/LV2"]);
2523     InitEmpty, Always, TestOutputList (
2524       [["part_disk"; "/dev/sda"; "mbr"];
2525        ["pvcreate"; "/dev/sda1"];
2526        ["vgcreate"; "VG"; "/dev/sda1"];
2527        ["lvcreate"; "LV1"; "VG"; "50"];
2528        ["lvcreate"; "LV2"; "VG"; "50"];
2529        ["lvremove"; "/dev/VG"];
2530        ["lvs"]], []);
2531     InitEmpty, Always, TestOutputList (
2532       [["part_disk"; "/dev/sda"; "mbr"];
2533        ["pvcreate"; "/dev/sda1"];
2534        ["vgcreate"; "VG"; "/dev/sda1"];
2535        ["lvcreate"; "LV1"; "VG"; "50"];
2536        ["lvcreate"; "LV2"; "VG"; "50"];
2537        ["lvremove"; "/dev/VG"];
2538        ["vgs"]], ["VG"])],
2539    "remove an LVM logical volume",
2540    "\
2541 Remove an LVM logical volume C<device>, where C<device> is
2542 the path to the LV, such as C</dev/VG/LV>.
2543
2544 You can also remove all LVs in a volume group by specifying
2545 the VG name, C</dev/VG>.");
2546
2547   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2548    [InitEmpty, Always, TestOutputList (
2549       [["part_disk"; "/dev/sda"; "mbr"];
2550        ["pvcreate"; "/dev/sda1"];
2551        ["vgcreate"; "VG"; "/dev/sda1"];
2552        ["lvcreate"; "LV1"; "VG"; "50"];
2553        ["lvcreate"; "LV2"; "VG"; "50"];
2554        ["vgremove"; "VG"];
2555        ["lvs"]], []);
2556     InitEmpty, Always, TestOutputList (
2557       [["part_disk"; "/dev/sda"; "mbr"];
2558        ["pvcreate"; "/dev/sda1"];
2559        ["vgcreate"; "VG"; "/dev/sda1"];
2560        ["lvcreate"; "LV1"; "VG"; "50"];
2561        ["lvcreate"; "LV2"; "VG"; "50"];
2562        ["vgremove"; "VG"];
2563        ["vgs"]], [])],
2564    "remove an LVM volume group",
2565    "\
2566 Remove an LVM volume group C<vgname>, (for example C<VG>).
2567
2568 This also forcibly removes all logical volumes in the volume
2569 group (if any).");
2570
2571   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2572    [InitEmpty, Always, TestOutputListOfDevices (
2573       [["part_disk"; "/dev/sda"; "mbr"];
2574        ["pvcreate"; "/dev/sda1"];
2575        ["vgcreate"; "VG"; "/dev/sda1"];
2576        ["lvcreate"; "LV1"; "VG"; "50"];
2577        ["lvcreate"; "LV2"; "VG"; "50"];
2578        ["vgremove"; "VG"];
2579        ["pvremove"; "/dev/sda1"];
2580        ["lvs"]], []);
2581     InitEmpty, Always, TestOutputListOfDevices (
2582       [["part_disk"; "/dev/sda"; "mbr"];
2583        ["pvcreate"; "/dev/sda1"];
2584        ["vgcreate"; "VG"; "/dev/sda1"];
2585        ["lvcreate"; "LV1"; "VG"; "50"];
2586        ["lvcreate"; "LV2"; "VG"; "50"];
2587        ["vgremove"; "VG"];
2588        ["pvremove"; "/dev/sda1"];
2589        ["vgs"]], []);
2590     InitEmpty, Always, TestOutputListOfDevices (
2591       [["part_disk"; "/dev/sda"; "mbr"];
2592        ["pvcreate"; "/dev/sda1"];
2593        ["vgcreate"; "VG"; "/dev/sda1"];
2594        ["lvcreate"; "LV1"; "VG"; "50"];
2595        ["lvcreate"; "LV2"; "VG"; "50"];
2596        ["vgremove"; "VG"];
2597        ["pvremove"; "/dev/sda1"];
2598        ["pvs"]], [])],
2599    "remove an LVM physical volume",
2600    "\
2601 This wipes a physical volume C<device> so that LVM will no longer
2602 recognise it.
2603
2604 The implementation uses the C<pvremove> command which refuses to
2605 wipe physical volumes that contain any volume groups, so you have
2606 to remove those first.");
2607
2608   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2609    [InitBasicFS, Always, TestOutput (
2610       [["set_e2label"; "/dev/sda1"; "testlabel"];
2611        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2612    "set the ext2/3/4 filesystem label",
2613    "\
2614 This sets the ext2/3/4 filesystem label of the filesystem on
2615 C<device> to C<label>.  Filesystem labels are limited to
2616 16 characters.
2617
2618 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2619 to return the existing label on a filesystem.");
2620
2621   ("get_e2label", (RString "label", [Device "device"]), 81, [DeprecatedBy "vfs_label"],
2622    [],
2623    "get the ext2/3/4 filesystem label",
2624    "\
2625 This returns the ext2/3/4 filesystem label of the filesystem on
2626 C<device>.");
2627
2628   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2629    (let uuid = uuidgen () in
2630     [InitBasicFS, Always, TestOutput (
2631        [["set_e2uuid"; "/dev/sda1"; uuid];
2632         ["get_e2uuid"; "/dev/sda1"]], uuid);
2633      InitBasicFS, Always, TestOutput (
2634        [["set_e2uuid"; "/dev/sda1"; "clear"];
2635         ["get_e2uuid"; "/dev/sda1"]], "");
2636      (* We can't predict what UUIDs will be, so just check the commands run. *)
2637      InitBasicFS, Always, TestRun (
2638        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2639      InitBasicFS, Always, TestRun (
2640        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2641    "set the ext2/3/4 filesystem UUID",
2642    "\
2643 This sets the ext2/3/4 filesystem UUID of the filesystem on
2644 C<device> to C<uuid>.  The format of the UUID and alternatives
2645 such as C<clear>, C<random> and C<time> are described in the
2646 L<tune2fs(8)> manpage.
2647
2648 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2649 to return the existing UUID of a filesystem.");
2650
2651   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [DeprecatedBy "vfs_uuid"],
2652    (* Regression test for RHBZ#597112. *)
2653    (let uuid = uuidgen () in
2654     [InitBasicFS, Always, TestOutput (
2655        [["mke2journal"; "1024"; "/dev/sdb"];
2656         ["set_e2uuid"; "/dev/sdb"; uuid];
2657         ["get_e2uuid"; "/dev/sdb"]], uuid)]),
2658    "get the ext2/3/4 filesystem UUID",
2659    "\
2660 This returns the ext2/3/4 filesystem UUID of the filesystem on
2661 C<device>.");
2662
2663   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [FishOutput FishOutputHexadecimal],
2664    [InitBasicFS, Always, TestOutputInt (
2665       [["umount"; "/dev/sda1"];
2666        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2667     InitBasicFS, Always, TestOutputInt (
2668       [["umount"; "/dev/sda1"];
2669        ["zero"; "/dev/sda1"];
2670        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2671    "run the filesystem checker",
2672    "\
2673 This runs the filesystem checker (fsck) on C<device> which
2674 should have filesystem type C<fstype>.
2675
2676 The returned integer is the status.  See L<fsck(8)> for the
2677 list of status codes from C<fsck>.
2678
2679 Notes:
2680
2681 =over 4
2682
2683 =item *
2684
2685 Multiple status codes can be summed together.
2686
2687 =item *
2688
2689 A non-zero return code can mean \"success\", for example if
2690 errors have been corrected on the filesystem.
2691
2692 =item *
2693
2694 Checking or repairing NTFS volumes is not supported
2695 (by linux-ntfs).
2696
2697 =back
2698
2699 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2700
2701   ("zero", (RErr, [Device "device"]), 85, [Progress],
2702    [InitBasicFS, Always, TestOutput (
2703       [["umount"; "/dev/sda1"];
2704        ["zero"; "/dev/sda1"];
2705        ["file"; "/dev/sda1"]], "data")],
2706    "write zeroes to the device",
2707    "\
2708 This command writes zeroes over the first few blocks of C<device>.
2709
2710 How many blocks are zeroed isn't specified (but it's I<not> enough
2711 to securely wipe the device).  It should be sufficient to remove
2712 any partition tables, filesystem superblocks and so on.
2713
2714 See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
2715
2716   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2717    (* See:
2718     * https://bugzilla.redhat.com/show_bug.cgi?id=484986
2719     * https://bugzilla.redhat.com/show_bug.cgi?id=479760
2720     *)
2721    [InitBasicFS, Always, TestOutputTrue (
2722       [["mkdir_p"; "/boot/grub"];
2723        ["write"; "/boot/grub/device.map"; "(hd0) /dev/vda"];
2724        ["grub_install"; "/"; "/dev/vda"];
2725        ["is_dir"; "/boot"]])],
2726    "install GRUB",
2727    "\
2728 This command installs GRUB (the Grand Unified Bootloader) on
2729 C<device>, with the root directory being C<root>.
2730
2731 Note: If grub-install reports the error
2732 \"No suitable drive was found in the generated device map.\"
2733 it may be that you need to create a C</boot/grub/device.map>
2734 file first that contains the mapping between grub device names
2735 and Linux device names.  It is usually sufficient to create
2736 a file containing:
2737
2738  (hd0) /dev/vda
2739
2740 replacing C</dev/vda> with the name of the installation device.");
2741
2742   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2743    [InitBasicFS, Always, TestOutput (
2744       [["write"; "/old"; "file content"];
2745        ["cp"; "/old"; "/new"];
2746        ["cat"; "/new"]], "file content");
2747     InitBasicFS, Always, TestOutputTrue (
2748       [["write"; "/old"; "file content"];
2749        ["cp"; "/old"; "/new"];
2750        ["is_file"; "/old"]]);
2751     InitBasicFS, Always, TestOutput (
2752       [["write"; "/old"; "file content"];
2753        ["mkdir"; "/dir"];
2754        ["cp"; "/old"; "/dir/new"];
2755        ["cat"; "/dir/new"]], "file content")],
2756    "copy a file",
2757    "\
2758 This copies a file from C<src> to C<dest> where C<dest> is
2759 either a destination filename or destination directory.");
2760
2761   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2762    [InitBasicFS, Always, TestOutput (
2763       [["mkdir"; "/olddir"];
2764        ["mkdir"; "/newdir"];
2765        ["write"; "/olddir/file"; "file content"];
2766        ["cp_a"; "/olddir"; "/newdir"];
2767        ["cat"; "/newdir/olddir/file"]], "file content")],
2768    "copy a file or directory recursively",
2769    "\
2770 This copies a file or directory from C<src> to C<dest>
2771 recursively using the C<cp -a> command.");
2772
2773   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2774    [InitBasicFS, Always, TestOutput (
2775       [["write"; "/old"; "file content"];
2776        ["mv"; "/old"; "/new"];
2777        ["cat"; "/new"]], "file content");
2778     InitBasicFS, Always, TestOutputFalse (
2779       [["write"; "/old"; "file content"];
2780        ["mv"; "/old"; "/new"];
2781        ["is_file"; "/old"]])],
2782    "move a file",
2783    "\
2784 This moves a file from C<src> to C<dest> where C<dest> is
2785 either a destination filename or destination directory.");
2786
2787   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2788    [InitEmpty, Always, TestRun (
2789       [["drop_caches"; "3"]])],
2790    "drop kernel page cache, dentries and inodes",
2791    "\
2792 This instructs the guest kernel to drop its page cache,
2793 and/or dentries and inode caches.  The parameter C<whattodrop>
2794 tells the kernel what precisely to drop, see
2795 L<http://linux-mm.org/Drop_Caches>
2796
2797 Setting C<whattodrop> to 3 should drop everything.
2798
2799 This automatically calls L<sync(2)> before the operation,
2800 so that the maximum guest memory is freed.");
2801
2802   ("dmesg", (RString "kmsgs", []), 91, [],
2803    [InitEmpty, Always, TestRun (
2804       [["dmesg"]])],
2805    "return kernel messages",
2806    "\
2807 This returns the kernel messages (C<dmesg> output) from
2808 the guest kernel.  This is sometimes useful for extended
2809 debugging of problems.
2810
2811 Another way to get the same information is to enable
2812 verbose messages with C<guestfs_set_verbose> or by setting
2813 the environment variable C<LIBGUESTFS_DEBUG=1> before
2814 running the program.");
2815
2816   ("ping_daemon", (RErr, []), 92, [],
2817    [InitEmpty, Always, TestRun (
2818       [["ping_daemon"]])],
2819    "ping the guest daemon",
2820    "\
2821 This is a test probe into the guestfs daemon running inside
2822 the qemu subprocess.  Calling this function checks that the
2823 daemon responds to the ping message, without affecting the daemon
2824 or attached block device(s) in any other way.");
2825
2826   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2827    [InitBasicFS, Always, TestOutputTrue (
2828       [["write"; "/file1"; "contents of a file"];
2829        ["cp"; "/file1"; "/file2"];
2830        ["equal"; "/file1"; "/file2"]]);
2831     InitBasicFS, Always, TestOutputFalse (
2832       [["write"; "/file1"; "contents of a file"];
2833        ["write"; "/file2"; "contents of another file"];
2834        ["equal"; "/file1"; "/file2"]]);
2835     InitBasicFS, Always, TestLastFail (
2836       [["equal"; "/file1"; "/file2"]])],
2837    "test if two files have equal contents",
2838    "\
2839 This compares the two files C<file1> and C<file2> and returns
2840 true if their content is exactly equal, or false otherwise.
2841
2842 The external L<cmp(1)> program is used for the comparison.");
2843
2844   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2845    [InitISOFS, Always, TestOutputList (
2846       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2847     InitISOFS, Always, TestOutputList (
2848       [["strings"; "/empty"]], []);
2849     (* Test for RHBZ#579608, absolute symbolic links. *)
2850     InitISOFS, Always, TestRun (
2851       [["strings"; "/abssymlink"]])],
2852    "print the printable strings in a file",
2853    "\
2854 This runs the L<strings(1)> command on a file and returns
2855 the list of printable strings found.");
2856
2857   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2858    [InitISOFS, Always, TestOutputList (
2859       [["strings_e"; "b"; "/known-5"]], []);
2860     InitBasicFS, Always, TestOutputList (
2861       [["write"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"];
2862        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2863    "print the printable strings in a file",
2864    "\
2865 This is like the C<guestfs_strings> command, but allows you to
2866 specify the encoding of strings that are looked for in
2867 the source file C<path>.
2868
2869 Allowed encodings are:
2870
2871 =over 4
2872
2873 =item s
2874
2875 Single 7-bit-byte characters like ASCII and the ASCII-compatible
2876 parts of ISO-8859-X (this is what C<guestfs_strings> uses).
2877
2878 =item S
2879
2880 Single 8-bit-byte characters.
2881
2882 =item b
2883
2884 16-bit big endian strings such as those encoded in
2885 UTF-16BE or UCS-2BE.
2886
2887 =item l (lower case letter L)
2888
2889 16-bit little endian such as UTF-16LE and UCS-2LE.
2890 This is useful for examining binaries in Windows guests.
2891
2892 =item B
2893
2894 32-bit big endian such as UCS-4BE.
2895
2896 =item L
2897
2898 32-bit little endian such as UCS-4LE.
2899
2900 =back
2901
2902 The returned strings are transcoded to UTF-8.");
2903
2904   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2905    [InitISOFS, Always, TestOutput (
2906       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2907     (* Test for RHBZ#501888c2 regression which caused large hexdump
2908      * commands to segfault.
2909      *)
2910     InitISOFS, Always, TestRun (
2911       [["hexdump"; "/100krandom"]]);
2912     (* Test for RHBZ#579608, absolute symbolic links. *)
2913     InitISOFS, Always, TestRun (
2914       [["hexdump"; "/abssymlink"]])],
2915    "dump a file in hexadecimal",
2916    "\
2917 This runs C<hexdump -C> on the given C<path>.  The result is
2918 the human-readable, canonical hex dump of the file.");
2919
2920   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2921    [InitNone, Always, TestOutput (
2922       [["part_disk"; "/dev/sda"; "mbr"];
2923        ["mkfs"; "ext3"; "/dev/sda1"];
2924        ["mount_options"; ""; "/dev/sda1"; "/"];
2925        ["write"; "/new"; "test file"];
2926        ["umount"; "/dev/sda1"];
2927        ["zerofree"; "/dev/sda1"];
2928        ["mount_options"; ""; "/dev/sda1"; "/"];
2929        ["cat"; "/new"]], "test file")],
2930    "zero unused inodes and disk blocks on ext2/3 filesystem",
2931    "\
2932 This runs the I<zerofree> program on C<device>.  This program
2933 claims to zero unused inodes and disk blocks on an ext2/3
2934 filesystem, thus making it possible to compress the filesystem
2935 more effectively.
2936
2937 You should B<not> run this program if the filesystem is
2938 mounted.
2939
2940 It is possible that using this program can damage the filesystem
2941 or data on the filesystem.");
2942
2943   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2944    [],
2945    "resize an LVM physical volume",
2946    "\
2947 This resizes (expands or shrinks) an existing LVM physical
2948 volume to match the new size of the underlying device.");
2949
2950   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2951                        Int "cyls"; Int "heads"; Int "sectors";
2952                        String "line"]), 99, [DangerWillRobinson],
2953    [],
2954    "modify a single partition on a block device",
2955    "\
2956 This runs L<sfdisk(8)> option to modify just the single
2957 partition C<n> (note: C<n> counts from 1).
2958
2959 For other parameters, see C<guestfs_sfdisk>.  You should usually
2960 pass C<0> for the cyls/heads/sectors parameters.
2961
2962 See also: C<guestfs_part_add>");
2963
2964   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2965    [],
2966    "display the partition table",
2967    "\
2968 This displays the partition table on C<device>, in the
2969 human-readable output of the L<sfdisk(8)> command.  It is
2970 not intended to be parsed.
2971
2972 See also: C<guestfs_part_list>");
2973
2974   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2975    [],
2976    "display the kernel geometry",
2977    "\
2978 This displays the kernel's idea of the geometry of C<device>.
2979
2980 The result is in human-readable format, and not designed to
2981 be parsed.");
2982
2983   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2984    [],
2985    "display the disk geometry from the partition table",
2986    "\
2987 This displays the disk geometry of C<device> read from the
2988 partition table.  Especially in the case where the underlying
2989 block device has been resized, this can be different from the
2990 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2991
2992 The result is in human-readable format, and not designed to
2993 be parsed.");
2994
2995   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2996    [],
2997    "activate or deactivate all volume groups",
2998    "\
2999 This command activates or (if C<activate> is false) deactivates
3000 all logical volumes in all volume groups.
3001 If activated, then they are made known to the
3002 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
3003 then those devices disappear.
3004
3005 This command is the same as running C<vgchange -a y|n>");
3006
3007   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
3008    [],
3009    "activate or deactivate some volume groups",
3010    "\
3011 This command activates or (if C<activate> is false) deactivates
3012 all logical volumes in the listed volume groups C<volgroups>.
3013 If activated, then they are made known to the
3014 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
3015 then those devices disappear.
3016
3017 This command is the same as running C<vgchange -a y|n volgroups...>
3018
3019 Note that if C<volgroups> is an empty list then B<all> volume groups
3020 are activated or deactivated.");
3021
3022   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
3023    [InitNone, Always, TestOutput (
3024       [["part_disk"; "/dev/sda"; "mbr"];
3025        ["pvcreate"; "/dev/sda1"];
3026        ["vgcreate"; "VG"; "/dev/sda1"];
3027        ["lvcreate"; "LV"; "VG"; "10"];
3028        ["mkfs"; "ext2"; "/dev/VG/LV"];
3029        ["mount_options"; ""; "/dev/VG/LV"; "/"];
3030        ["write"; "/new"; "test content"];
3031        ["umount"; "/"];
3032        ["lvresize"; "/dev/VG/LV"; "20"];
3033        ["e2fsck_f"; "/dev/VG/LV"];
3034        ["resize2fs"; "/dev/VG/LV"];
3035        ["mount_options"; ""; "/dev/VG/LV"; "/"];
3036        ["cat"; "/new"]], "test content");
3037     InitNone, Always, TestRun (
3038       (* Make an LV smaller to test RHBZ#587484. *)
3039       [["part_disk"; "/dev/sda"; "mbr"];
3040        ["pvcreate"; "/dev/sda1"];
3041        ["vgcreate"; "VG"; "/dev/sda1"];
3042        ["lvcreate"; "LV"; "VG"; "20"];
3043        ["lvresize"; "/dev/VG/LV"; "10"]])],
3044    "resize an LVM logical volume",
3045    "\
3046 This resizes (expands or shrinks) an existing LVM logical
3047 volume to C<mbytes>.  When reducing, data in the reduced part
3048 is lost.");
3049
3050   ("resize2fs", (RErr, [Device "device"]), 106, [],
3051    [], (* lvresize tests this *)
3052    "resize an ext2, ext3 or ext4 filesystem",
3053    "\
3054 This resizes an ext2, ext3 or ext4 filesystem to match the size of
3055 the underlying device.
3056
3057 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
3058 on the C<device> before calling this command.  For unknown reasons
3059 C<resize2fs> sometimes gives an error about this and sometimes not.
3060 In any case, it is always safe to call C<guestfs_e2fsck_f> before
3061 calling this function.");
3062
3063   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
3064    [InitBasicFS, Always, TestOutputList (
3065       [["find"; "/"]], ["lost+found"]);
3066     InitBasicFS, Always, TestOutputList (
3067       [["touch"; "/a"];
3068        ["mkdir"; "/b"];
3069        ["touch"; "/b/c"];
3070        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
3071     InitBasicFS, Always, TestOutputList (
3072       [["mkdir_p"; "/a/b/c"];
3073        ["touch"; "/a/b/c/d"];
3074        ["find"; "/a/b/"]], ["c"; "c/d"])],
3075    "find all files and directories",
3076    "\
3077 This command lists out all files and directories, recursively,
3078 starting at C<directory>.  It is essentially equivalent to
3079 running the shell command C<find directory -print> but some
3080 post-processing happens on the output, described below.
3081
3082 This returns a list of strings I<without any prefix>.  Thus
3083 if the directory structure was:
3084
3085  /tmp/a
3086  /tmp/b
3087  /tmp/c/d
3088
3089 then the returned list from C<guestfs_find> C</tmp> would be
3090 4 elements:
3091
3092  a
3093  b
3094  c
3095  c/d
3096
3097 If C<directory> is not a directory, then this command returns
3098 an error.
3099
3100 The returned list is sorted.
3101
3102 See also C<guestfs_find0>.");
3103
3104   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
3105    [], (* lvresize tests this *)
3106    "check an ext2/ext3 filesystem",
3107    "\
3108 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
3109 filesystem checker on C<device>, noninteractively (C<-p>),
3110 even if the filesystem appears to be clean (C<-f>).
3111
3112 This command is only needed because of C<guestfs_resize2fs>
3113 (q.v.).  Normally you should use C<guestfs_fsck>.");
3114
3115   ("sleep", (RErr, [Int "secs"]), 109, [],
3116    [InitNone, Always, TestRun (
3117       [["sleep"; "1"]])],
3118    "sleep for some seconds",
3119    "\
3120 Sleep for C<secs> seconds.");
3121
3122   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
3123    [InitNone, Always, TestOutputInt (
3124       [["part_disk"; "/dev/sda"; "mbr"];
3125        ["mkfs"; "ntfs"; "/dev/sda1"];
3126        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
3127     InitNone, Always, TestOutputInt (
3128       [["part_disk"; "/dev/sda"; "mbr"];
3129        ["mkfs"; "ext2"; "/dev/sda1"];
3130        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
3131    "probe NTFS volume",
3132    "\
3133 This command runs the L<ntfs-3g.probe(8)> command which probes
3134 an NTFS C<device> for mountability.  (Not all NTFS volumes can
3135 be mounted read-write, and some cannot be mounted at all).
3136
3137 C<rw> is a boolean flag.  Set it to true if you want to test
3138 if the volume can be mounted read-write.  Set it to false if
3139 you want to test if the volume can be mounted read-only.
3140
3141 The return value is an integer which C<0> if the operation
3142 would succeed, or some non-zero value documented in the
3143 L<ntfs-3g.probe(8)> manual page.");
3144
3145   ("sh", (RString "output", [String "command"]), 111, [],
3146    [], (* XXX needs tests *)
3147    "run a command via the shell",
3148    "\
3149 This call runs a command from the guest filesystem via the
3150 guest's C</bin/sh>.
3151
3152 This is like C<guestfs_command>, but passes the command to:
3153
3154  /bin/sh -c \"command\"
3155
3156 Depending on the guest's shell, this usually results in
3157 wildcards being expanded, shell expressions being interpolated
3158 and so on.
3159
3160 All the provisos about C<guestfs_command> apply to this call.");
3161
3162   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
3163    [], (* XXX needs tests *)
3164    "run a command via the shell returning lines",
3165    "\
3166 This is the same as C<guestfs_sh>, but splits the result
3167 into a list of lines.
3168
3169 See also: C<guestfs_command_lines>");
3170
3171   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
3172    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
3173     * code in stubs.c, since all valid glob patterns must start with "/".
3174     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
3175     *)
3176    [InitBasicFS, Always, TestOutputList (
3177       [["mkdir_p"; "/a/b/c"];
3178        ["touch"; "/a/b/c/d"];
3179        ["touch"; "/a/b/c/e"];
3180        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
3181     InitBasicFS, Always, TestOutputList (
3182       [["mkdir_p"; "/a/b/c"];
3183        ["touch"; "/a/b/c/d"];
3184        ["touch"; "/a/b/c/e"];
3185        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
3186     InitBasicFS, Always, TestOutputList (
3187       [["mkdir_p"; "/a/b/c"];
3188        ["touch"; "/a/b/c/d"];
3189        ["touch"; "/a/b/c/e"];
3190        ["glob_expand"; "/a/*/x/*"]], [])],
3191    "expand a wildcard path",
3192    "\
3193 This command searches for all the pathnames matching
3194 C<pattern> according to the wildcard expansion rules
3195 used by the shell.
3196
3197 If no paths match, then this returns an empty list
3198 (note: not an error).
3199
3200 It is just a wrapper around the C L<glob(3)> function
3201 with flags C<GLOB_MARK|GLOB_BRACE>.
3202 See that manual page for more details.");
3203
3204   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
3205    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
3206       [["scrub_device"; "/dev/sdc"]])],
3207    "scrub (securely wipe) a device",
3208    "\
3209 This command writes patterns over C<device> to make data retrieval
3210 more difficult.
3211
3212 It is an interface to the L<scrub(1)> program.  See that
3213 manual page for more details.");
3214
3215   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
3216    [InitBasicFS, Always, TestRun (
3217       [["write"; "/file"; "content"];
3218        ["scrub_file"; "/file"]])],
3219    "scrub (securely wipe) a file",
3220    "\
3221 This command writes patterns over a file to make data retrieval
3222 more difficult.
3223
3224 The file is I<removed> after scrubbing.
3225
3226 It is an interface to the L<scrub(1)> program.  See that
3227 manual page for more details.");
3228
3229   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
3230    [], (* XXX needs testing *)
3231    "scrub (securely wipe) free space",
3232    "\
3233 This command creates the directory C<dir> and then fills it
3234 with files until the filesystem is full, and scrubs the files
3235 as for C<guestfs_scrub_file>, and deletes them.
3236 The intention is to scrub any free space on the partition
3237 containing C<dir>.
3238
3239 It is an interface to the L<scrub(1)> program.  See that
3240 manual page for more details.");
3241
3242   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
3243    [InitBasicFS, Always, TestRun (
3244       [["mkdir"; "/tmp"];
3245        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
3246    "create a temporary directory",
3247    "\
3248 This command creates a temporary directory.  The
3249 C<template> parameter should be a full pathname for the
3250 temporary directory name with the final six characters being
3251 \"XXXXXX\".
3252
3253 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
3254 the second one being suitable for Windows filesystems.
3255
3256 The name of the temporary directory that was created
3257 is returned.
3258
3259 The temporary directory is created with mode 0700
3260 and is owned by root.
3261
3262 The caller is responsible for deleting the temporary
3263 directory and its contents after use.
3264
3265 See also: L<mkdtemp(3)>");
3266
3267   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
3268    [InitISOFS, Always, TestOutputInt (
3269       [["wc_l"; "/10klines"]], 10000);
3270     (* Test for RHBZ#579608, absolute symbolic links. *)
3271     InitISOFS, Always, TestOutputInt (
3272       [["wc_l"; "/abssymlink"]], 10000)],
3273    "count lines in a file",
3274    "\
3275 This command counts the lines in a file, using the
3276 C<wc -l> external command.");
3277
3278   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
3279    [InitISOFS, Always, TestOutputInt (
3280       [["wc_w"; "/10klines"]], 10000)],
3281    "count words in a file",
3282    "\
3283 This command counts the words in a file, using the
3284 C<wc -w> external command.");
3285
3286   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
3287    [InitISOFS, Always, TestOutputInt (
3288       [["wc_c"; "/100kallspaces"]], 102400)],
3289    "count characters in a file",
3290    "\
3291 This command counts the characters in a file, using the
3292 C<wc -c> external command.");
3293
3294   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
3295    [InitISOFS, Always, TestOutputList (
3296       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"]);
3297     (* Test for RHBZ#579608, absolute symbolic links. *)
3298     InitISOFS, Always, TestOutputList (
3299       [["head"; "/abssymlink"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
3300    "return first 10 lines of a file",
3301    "\
3302 This command returns up to the first 10 lines of a file as
3303 a list of strings.");
3304
3305   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
3306    [InitISOFS, Always, TestOutputList (
3307       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
3308     InitISOFS, Always, TestOutputList (
3309       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
3310     InitISOFS, Always, TestOutputList (
3311       [["head_n"; "0"; "/10klines"]], [])],
3312    "return first N lines of a file",
3313    "\
3314 If the parameter C<nrlines> is a positive number, this returns the first
3315 C<nrlines> lines of the file C<path>.
3316
3317 If the parameter C<nrlines> is a negative number, this returns lines
3318 from the file C<path>, excluding the last C<nrlines> lines.
3319
3320 If the parameter C<nrlines> is zero, this returns an empty list.");
3321
3322   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
3323    [InitISOFS, Always, TestOutputList (
3324       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
3325    "return last 10 lines of a file",
3326    "\
3327 This command returns up to the last 10 lines of a file as
3328 a list of strings.");
3329
3330   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
3331    [InitISOFS, Always, TestOutputList (
3332       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
3333     InitISOFS, Always, TestOutputList (
3334       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
3335     InitISOFS, Always, TestOutputList (
3336       [["tail_n"; "0"; "/10klines"]], [])],
3337    "return last N lines of a file",
3338    "\
3339 If the parameter C<nrlines> is a positive number, this returns the last
3340 C<nrlines> lines of the file C<path>.
3341
3342 If the parameter C<nrlines> is a negative number, this returns lines
3343 from the file C<path>, starting with the C<-nrlines>th line.
3344
3345 If the parameter C<nrlines> is zero, this returns an empty list.");
3346
3347   ("df", (RString "output", []), 125, [],
3348    [], (* XXX Tricky to test because it depends on the exact format
3349         * of the 'df' command and other imponderables.
3350         *)
3351    "report file system disk space usage",
3352    "\
3353 This command runs the C<df> command to report disk space used.
3354
3355 This command is mostly useful for interactive sessions.  It
3356 is I<not> intended that you try to parse the output string.
3357 Use C<statvfs> from programs.");
3358
3359   ("df_h", (RString "output", []), 126, [],
3360    [], (* XXX Tricky to test because it depends on the exact format
3361         * of the 'df' command and other imponderables.
3362         *)
3363    "report file system disk space usage (human readable)",
3364    "\
3365 This command runs the C<df -h> command to report disk space used
3366 in human-readable format.
3367
3368 This command is mostly useful for interactive sessions.  It
3369 is I<not> intended that you try to parse the output string.
3370 Use C<statvfs> from programs.");
3371
3372   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
3373    [InitISOFS, Always, TestOutputInt (
3374       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
3375    "estimate file space usage",
3376    "\
3377 This command runs the C<du -s> command to estimate file space
3378 usage for C<path>.
3379
3380 C<path> can be a file or a directory.  If C<path> is a directory
3381 then the estimate includes the contents of the directory and all
3382 subdirectories (recursively).
3383
3384 The result is the estimated size in I<kilobytes>
3385 (ie. units of 1024 bytes).");
3386
3387   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
3388    [InitISOFS, Always, TestOutputList (
3389       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
3390    "list files in an initrd",
3391    "\
3392 This command lists out files contained in an initrd.
3393
3394 The files are listed without any initial C</> character.  The
3395 files are listed in the order they appear (not necessarily
3396 alphabetical).  Directory names are listed as separate items.
3397
3398 Old Linux kernels (2.4 and earlier) used a compressed ext2
3399 filesystem as initrd.  We I<only> support the newer initramfs
3400 format (compressed cpio files).");
3401
3402   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
3403    [],
3404    "mount a file using the loop device",
3405    "\
3406 This command lets you mount C<file> (a filesystem image
3407 in a file) on a mount point.  It is entirely equivalent to
3408 the command C<mount -o loop file mountpoint>.");
3409
3410   ("mkswap", (RErr, [Device "device"]), 130, [],
3411    [InitEmpty, Always, TestRun (
3412       [["part_disk"; "/dev/sda"; "mbr"];
3413        ["mkswap"; "/dev/sda1"]])],
3414    "create a swap partition",
3415    "\
3416 Create a swap partition on C<device>.");
3417
3418   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
3419    [InitEmpty, Always, TestRun (
3420       [["part_disk"; "/dev/sda"; "mbr"];
3421        ["mkswap_L"; "hello"; "/dev/sda1"]])],
3422    "create a swap partition with a label",
3423    "\
3424 Create a swap partition on C<device> with label C<label>.
3425
3426 Note that you cannot attach a swap label to a block device
3427 (eg. C</dev/sda>), just to a partition.  This appears to be
3428 a limitation of the kernel or swap tools.");
3429
3430   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
3431    (let uuid = uuidgen () in
3432     [InitEmpty, Always, TestRun (
3433        [["part_disk"; "/dev/sda"; "mbr"];
3434         ["mkswap_U"; uuid; "/dev/sda1"]])]),
3435    "create a swap partition with an explicit UUID",
3436    "\
3437 Create a swap partition on C<device> with UUID C<uuid>.");
3438
3439   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
3440    [InitBasicFS, Always, TestOutputStruct (
3441       [["mknod"; "0o10777"; "0"; "0"; "/node"];
3442        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
3443        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
3444     InitBasicFS, Always, TestOutputStruct (
3445       [["mknod"; "0o60777"; "66"; "99"; "/node"];
3446        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3447    "make block, character or FIFO devices",
3448    "\
3449 This call creates block or character special devices, or
3450 named pipes (FIFOs).
3451
3452 The C<mode> parameter should be the mode, using the standard
3453 constants.  C<devmajor> and C<devminor> are the
3454 device major and minor numbers, only used when creating block
3455 and character special devices.
3456
3457 Note that, just like L<mknod(2)>, the mode must be bitwise
3458 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3459 just creates a regular file).  These constants are
3460 available in the standard Linux header files, or you can use
3461 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3462 which are wrappers around this command which bitwise OR
3463 in the appropriate constant for you.
3464
3465 The mode actually set is affected by the umask.");
3466
3467   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3468    [InitBasicFS, Always, TestOutputStruct (
3469       [["mkfifo"; "0o777"; "/node"];
3470        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3471    "make FIFO (named pipe)",
3472    "\
3473 This call creates a FIFO (named pipe) called C<path> with
3474 mode C<mode>.  It is just a convenient wrapper around
3475 C<guestfs_mknod>.
3476
3477 The mode actually set is affected by the umask.");
3478
3479   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3480    [InitBasicFS, Always, TestOutputStruct (
3481       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3482        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3483    "make block device node",
3484    "\
3485 This call creates a block device node called C<path> with
3486 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3487 It is just a convenient wrapper around C<guestfs_mknod>.
3488
3489 The mode actually set is affected by the umask.");
3490
3491   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3492    [InitBasicFS, Always, TestOutputStruct (
3493       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3494        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3495    "make char device node",
3496    "\
3497 This call creates a char device node called C<path> with
3498 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3499 It is just a convenient wrapper around C<guestfs_mknod>.
3500
3501 The mode actually set is affected by the umask.");
3502
3503   ("umask", (RInt "oldmask", [Int "mask"]), 137, [FishOutput FishOutputOctal],
3504    [InitEmpty, Always, TestOutputInt (
3505       [["umask"; "0o22"]], 0o22)],
3506    "set file mode creation mask (umask)",
3507    "\
3508 This function sets the mask used for creating new files and
3509 device nodes to C<mask & 0777>.
3510
3511 Typical umask values would be C<022> which creates new files
3512 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3513 C<002> which creates new files with permissions like
3514 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3515
3516 The default umask is C<022>.  This is important because it
3517 means that directories and device nodes will be created with
3518 C<0644> or C<0755> mode even if you specify C<0777>.
3519
3520 See also C<guestfs_get_umask>,
3521 L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3522
3523 This call returns the previous umask.");
3524
3525   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3526    [],
3527    "read directories entries",
3528    "\
3529 This returns the list of directory entries in directory C<dir>.
3530
3531 All entries in the directory are returned, including C<.> and
3532 C<..>.  The entries are I<not> sorted, but returned in the same
3533 order as the underlying filesystem.
3534
3535 Also this call returns basic file type information about each
3536 file.  The C<ftyp> field will contain one of the following characters:
3537
3538 =over 4
3539
3540 =item 'b'
3541
3542 Block special
3543
3544 =item 'c'
3545
3546 Char special
3547
3548 =item 'd'
3549
3550 Directory
3551
3552 =item 'f'
3553
3554 FIFO (named pipe)
3555
3556 =item 'l'
3557
3558 Symbolic link
3559
3560 =item 'r'
3561
3562 Regular file
3563
3564 =item 's'
3565
3566 Socket
3567
3568 =item 'u'
3569
3570 Unknown file type
3571
3572 =item '?'
3573
3574 The L<readdir(3)> call returned a C<d_type> field with an
3575 unexpected value
3576
3577 =back
3578
3579 This function is primarily intended for use by programs.  To
3580 get a simple list of names, use C<guestfs_ls>.  To get a printable
3581 directory for human consumption, use C<guestfs_ll>.");
3582
3583   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3584    [],
3585    "create partitions on a block device",
3586    "\
3587 This is a simplified interface to the C<guestfs_sfdisk>
3588 command, where partition sizes are specified in megabytes
3589 only (rounded to the nearest cylinder) and you don't need
3590 to specify the cyls, heads and sectors parameters which
3591 were rarely if ever used anyway.
3592
3593 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3594 and C<guestfs_part_disk>");
3595
3596   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3597    [],
3598    "determine file type inside a compressed file",
3599    "\
3600 This command runs C<file> after first decompressing C<path>
3601 using C<method>.
3602
3603 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3604
3605 Since 1.0.63, use C<guestfs_file> instead which can now
3606 process compressed files.");
3607
3608   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3609    [],
3610    "list extended attributes of a file or directory",
3611    "\
3612 This call lists the extended attributes of the file or directory
3613 C<path>.
3614
3615 At the system call level, this is a combination of the
3616 L<listxattr(2)> and L<getxattr(2)> calls.
3617
3618 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3619
3620   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3621    [],
3622    "list extended attributes of a file or directory",
3623    "\
3624 This is the same as C<guestfs_getxattrs>, but if C<path>
3625 is a symbolic link, then it returns the extended attributes
3626 of the link itself.");
3627
3628   ("setxattr", (RErr, [String "xattr";
3629                        String "val"; Int "vallen"; (* will be BufferIn *)
3630                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3631    [],
3632    "set extended attribute of a file or directory",
3633    "\
3634 This call sets the extended attribute named C<xattr>
3635 of the file C<path> to the value C<val> (of length C<vallen>).
3636 The value is arbitrary 8 bit data.
3637
3638 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3639
3640   ("lsetxattr", (RErr, [String "xattr";
3641                         String "val"; Int "vallen"; (* will be BufferIn *)
3642                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3643    [],
3644    "set extended attribute of a file or directory",
3645    "\
3646 This is the same as C<guestfs_setxattr>, but if C<path>
3647 is a symbolic link, then it sets an extended attribute
3648 of the link itself.");
3649
3650   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3651    [],
3652    "remove extended attribute of a file or directory",
3653    "\
3654 This call removes the extended attribute named C<xattr>
3655 of the file C<path>.
3656
3657 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3658
3659   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3660    [],
3661    "remove extended attribute of a file or directory",
3662    "\
3663 This is the same as C<guestfs_removexattr>, but if C<path>
3664 is a symbolic link, then it removes an extended attribute
3665 of the link itself.");
3666
3667   ("mountpoints", (RHashtable "mps", []), 147, [],
3668    [],
3669    "show mountpoints",
3670    "\
3671 This call is similar to C<guestfs_mounts>.  That call returns
3672 a list of devices.  This one returns a hash table (map) of
3673 device name to directory where the device is mounted.");
3674
3675   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3676    (* This is a special case: while you would expect a parameter
3677     * of type "Pathname", that doesn't work, because it implies
3678     * NEED_ROOT in the generated calling code in stubs.c, and
3679     * this function cannot use NEED_ROOT.
3680     *)
3681    [],
3682    "create a mountpoint",
3683    "\
3684 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3685 specialized calls that can be used to create extra mountpoints
3686 before mounting the first filesystem.
3687
3688 These calls are I<only> necessary in some very limited circumstances,
3689 mainly the case where you want to mount a mix of unrelated and/or
3690 read-only filesystems together.
3691
3692 For example, live CDs often contain a \"Russian doll\" nest of
3693 filesystems, an ISO outer layer, with a squashfs image inside, with
3694 an ext2/3 image inside that.  You can unpack this as follows
3695 in guestfish:
3696
3697  add-ro Fedora-11-i686-Live.iso
3698  run
3699  mkmountpoint /cd
3700  mkmountpoint /squash
3701  mkmountpoint /ext3
3702  mount /dev/sda /cd
3703  mount-loop /cd/LiveOS/squashfs.img /squash
3704  mount-loop /squash/LiveOS/ext3fs.img /ext3
3705
3706 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3707
3708   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3709    [],
3710    "remove a mountpoint",
3711    "\
3712 This calls removes a mountpoint that was previously created
3713 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3714 for full details.");
3715
3716   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3717    [InitISOFS, Always, TestOutputBuffer (
3718       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3719     (* Test various near large, large and too large files (RHBZ#589039). *)
3720     InitBasicFS, Always, TestLastFail (
3721       [["touch"; "/a"];
3722        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3723        ["read_file"; "/a"]]);
3724     InitBasicFS, Always, TestLastFail (
3725       [["touch"; "/a"];
3726        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3727        ["read_file"; "/a"]]);
3728     InitBasicFS, Always, TestLastFail (
3729       [["touch"; "/a"];
3730        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3731        ["read_file"; "/a"]])],
3732    "read a file",
3733    "\
3734 This calls returns the contents of the file C<path> as a
3735 buffer.
3736
3737 Unlike C<guestfs_cat>, this function can correctly
3738 handle files that contain embedded ASCII NUL characters.
3739 However unlike C<guestfs_download>, this function is limited
3740 in the total size of file that can be handled.");
3741
3742   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3743    [InitISOFS, Always, TestOutputList (
3744       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3745     InitISOFS, Always, TestOutputList (
3746       [["grep"; "nomatch"; "/test-grep.txt"]], []);
3747     (* Test for RHBZ#579608, absolute symbolic links. *)
3748     InitISOFS, Always, TestOutputList (
3749       [["grep"; "nomatch"; "/abssymlink"]], [])],
3750    "return lines matching a pattern",
3751    "\
3752 This calls the external C<grep> program and returns the
3753 matching lines.");
3754
3755   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3756    [InitISOFS, Always, TestOutputList (
3757       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3758    "return lines matching a pattern",
3759    "\
3760 This calls the external C<egrep> program and returns the
3761 matching lines.");
3762
3763   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3764    [InitISOFS, Always, TestOutputList (
3765       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3766    "return lines matching a pattern",
3767    "\
3768 This calls the external C<fgrep> program and returns the
3769 matching lines.");
3770
3771   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3772    [InitISOFS, Always, TestOutputList (
3773       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3774    "return lines matching a pattern",
3775    "\
3776 This calls the external C<grep -i> program and returns the
3777 matching lines.");
3778
3779   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3780    [InitISOFS, Always, TestOutputList (
3781       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3782    "return lines matching a pattern",
3783    "\
3784 This calls the external C<egrep -i> program and returns the
3785 matching lines.");
3786
3787   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3788    [InitISOFS, Always, TestOutputList (
3789       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3790    "return lines matching a pattern",
3791    "\
3792 This calls the external C<fgrep -i> program and returns the
3793 matching lines.");
3794
3795   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3796    [InitISOFS, Always, TestOutputList (
3797       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3798    "return lines matching a pattern",
3799    "\
3800 This calls the external C<zgrep> program and returns the
3801 matching lines.");
3802
3803   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3804    [InitISOFS, Always, TestOutputList (
3805       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3806    "return lines matching a pattern",
3807    "\
3808 This calls the external C<zegrep> program and returns the
3809 matching lines.");
3810
3811   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3812    [InitISOFS, Always, TestOutputList (
3813       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3814    "return lines matching a pattern",
3815    "\
3816 This calls the external C<zfgrep> program and returns the
3817 matching lines.");
3818
3819   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3820    [InitISOFS, Always, TestOutputList (
3821       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3822    "return lines matching a pattern",
3823    "\
3824 This calls the external C<zgrep -i> program and returns the
3825 matching lines.");
3826
3827   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3828    [InitISOFS, Always, TestOutputList (
3829       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3830    "return lines matching a pattern",
3831    "\
3832 This calls the external C<zegrep -i> program and returns the
3833 matching lines.");
3834
3835   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3836    [InitISOFS, Always, TestOutputList (
3837       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3838    "return lines matching a pattern",
3839    "\
3840 This calls the external C<zfgrep -i> program and returns the
3841 matching lines.");
3842
3843   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3844    [InitISOFS, Always, TestOutput (
3845       [["realpath"; "/../directory"]], "/directory")],
3846    "canonicalized absolute pathname",
3847    "\
3848 Return the canonicalized absolute pathname of C<path>.  The
3849 returned path has no C<.>, C<..> or symbolic link path elements.");
3850
3851   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3852    [InitBasicFS, Always, TestOutputStruct (
3853       [["touch"; "/a"];
3854        ["ln"; "/a"; "/b"];
3855        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3856    "create a hard link",
3857    "\
3858 This command creates a hard link using the C<ln> command.");
3859
3860   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3861    [InitBasicFS, Always, TestOutputStruct (
3862       [["touch"; "/a"];
3863        ["touch"; "/b"];
3864        ["ln_f"; "/a"; "/b"];
3865        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3866    "create a hard link",
3867    "\
3868 This command creates a hard link using the C<ln -f> command.
3869 The C<-f> option removes the link (C<linkname>) if it exists already.");
3870
3871   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3872    [InitBasicFS, Always, TestOutputStruct (
3873       [["touch"; "/a"];
3874        ["ln_s"; "a"; "/b"];
3875        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3876    "create a symbolic link",
3877    "\
3878 This command creates a symbolic link using the C<ln -s> command.");
3879
3880   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3881    [InitBasicFS, Always, TestOutput (
3882       [["mkdir_p"; "/a/b"];
3883        ["touch"; "/a/b/c"];
3884        ["ln_sf"; "../d"; "/a/b/c"];
3885        ["readlink"; "/a/b/c"]], "../d")],
3886    "create a symbolic link",
3887    "\
3888 This command creates a symbolic link using the C<ln -sf> command,
3889 The C<-f> option removes the link (C<linkname>) if it exists already.");
3890
3891   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3892    [] (* XXX tested above *),
3893    "read the target of a symbolic link",
3894    "\
3895 This command reads the target of a symbolic link.");
3896
3897   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [DeprecatedBy "fallocate64"],
3898    [InitBasicFS, Always, TestOutputStruct (
3899       [["fallocate"; "/a"; "1000000"];
3900        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3901    "preallocate a file in the guest filesystem",
3902    "\
3903 This command preallocates a file (containing zero bytes) named
3904 C<path> of size C<len> bytes.  If the file exists already, it
3905 is overwritten.
3906
3907 Do not confuse this with the guestfish-specific
3908 C<alloc> command which allocates a file in the host and
3909 attaches it as a device.");
3910
3911   ("swapon_device", (RErr, [Device "device"]), 170, [],
3912    [InitPartition, Always, TestRun (
3913       [["mkswap"; "/dev/sda1"];
3914        ["swapon_device"; "/dev/sda1"];
3915        ["swapoff_device"; "/dev/sda1"]])],
3916    "enable swap on device",
3917    "\
3918 This command enables the libguestfs appliance to use the
3919 swap device or partition named C<device>.  The increased
3920 memory is made available for all commands, for example
3921 those run using C<guestfs_command> or C<guestfs_sh>.
3922
3923 Note that you should not swap to existing guest swap
3924 partitions unless you know what you are doing.  They may
3925 contain hibernation information, or other information that
3926 the guest doesn't want you to trash.  You also risk leaking
3927 information about the host to the guest this way.  Instead,
3928 attach a new host device to the guest and swap on that.");
3929
3930   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3931    [], (* XXX tested by swapon_device *)
3932    "disable swap on device",
3933    "\
3934 This command disables the libguestfs appliance swap
3935 device or partition named C<device>.
3936 See C<guestfs_swapon_device>.");
3937
3938   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3939    [InitBasicFS, Always, TestRun (
3940       [["fallocate"; "/swap"; "8388608"];
3941        ["mkswap_file"; "/swap"];
3942        ["swapon_file"; "/swap"];
3943        ["swapoff_file"; "/swap"]])],
3944    "enable swap on file",
3945    "\
3946 This command enables swap to a file.
3947 See C<guestfs_swapon_device> for other notes.");
3948
3949   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3950    [], (* XXX tested by swapon_file *)
3951    "disable swap on file",
3952    "\
3953 This command disables the libguestfs appliance swap on file.");
3954
3955   ("swapon_label", (RErr, [String "label"]), 174, [],
3956    [InitEmpty, Always, TestRun (
3957       [["part_disk"; "/dev/sdb"; "mbr"];
3958        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3959        ["swapon_label"; "swapit"];
3960        ["swapoff_label"; "swapit"];
3961        ["zero"; "/dev/sdb"];
3962        ["blockdev_rereadpt"; "/dev/sdb"]])],
3963    "enable swap on labeled swap partition",
3964    "\
3965 This command enables swap to a labeled swap partition.
3966 See C<guestfs_swapon_device> for other notes.");
3967
3968   ("swapoff_label", (RErr, [String "label"]), 175, [],
3969    [], (* XXX tested by swapon_label *)
3970    "disable swap on labeled swap partition",
3971    "\
3972 This command disables the libguestfs appliance swap on
3973 labeled swap partition.");
3974
3975   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3976    (let uuid = uuidgen () in
3977     [InitEmpty, Always, TestRun (
3978        [["mkswap_U"; uuid; "/dev/sdb"];
3979         ["swapon_uuid"; uuid];
3980         ["swapoff_uuid"; uuid]])]),
3981    "enable swap on swap partition by UUID",
3982    "\
3983 This command enables swap to a swap partition with the given UUID.
3984 See C<guestfs_swapon_device> for other notes.");
3985
3986   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3987    [], (* XXX tested by swapon_uuid *)
3988    "disable swap on swap partition by UUID",
3989    "\
3990 This command disables the libguestfs appliance swap partition
3991 with the given UUID.");
3992
3993   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3994    [InitBasicFS, Always, TestRun (
3995       [["fallocate"; "/swap"; "8388608"];
3996        ["mkswap_file"; "/swap"]])],
3997    "create a swap file",
3998    "\
3999 Create a swap file.
4000
4001 This command just writes a swap file signature to an existing
4002 file.  To create the file itself, use something like C<guestfs_fallocate>.");
4003
4004   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
4005    [InitISOFS, Always, TestRun (
4006       [["inotify_init"; "0"]])],
4007    "create an inotify handle",
4008    "\
4009 This command creates a new inotify handle.
4010 The inotify subsystem can be used to notify events which happen to
4011 objects in the guest filesystem.
4012
4013 C<maxevents> is the maximum number of events which will be
4014 queued up between calls to C<guestfs_inotify_read> or
4015 C<guestfs_inotify_files>.
4016 If this is passed as C<0>, then the kernel (or previously set)
4017 default is used.  For Linux 2.6.29 the default was 16384 events.
4018 Beyond this limit, the kernel throws away events, but records
4019 the fact that it threw them away by setting a flag
4020 C<IN_Q_OVERFLOW> in the returned structure list (see
4021 C<guestfs_inotify_read>).
4022
4023 Before any events are generated, you have to add some
4024 watches to the internal watch list.  See:
4025 C<guestfs_inotify_add_watch>,
4026 C<guestfs_inotify_rm_watch> and
4027 C<guestfs_inotify_watch_all>.
4028
4029 Queued up events should be read periodically by calling
4030 C<guestfs_inotify_read>
4031 (or C<guestfs_inotify_files> which is just a helpful
4032 wrapper around C<guestfs_inotify_read>).  If you don't
4033 read the events out often enough then you risk the internal
4034 queue overflowing.
4035
4036 The handle should be closed after use by calling
4037 C<guestfs_inotify_close>.  This also removes any
4038 watches automatically.
4039
4040 See also L<inotify(7)> for an overview of the inotify interface
4041 as exposed by the Linux kernel, which is roughly what we expose
4042 via libguestfs.  Note that there is one global inotify handle
4043 per libguestfs instance.");
4044
4045   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
4046    [InitBasicFS, Always, TestOutputList (
4047       [["inotify_init"; "0"];
4048        ["inotify_add_watch"; "/"; "1073741823"];
4049        ["touch"; "/a"];
4050        ["touch"; "/b"];
4051        ["inotify_files"]], ["a"; "b"])],
4052    "add an inotify watch",
4053    "\
4054 Watch C<path> for the events listed in C<mask>.
4055
4056 Note that if C<path> is a directory then events within that
4057 directory are watched, but this does I<not> happen recursively
4058 (in subdirectories).
4059
4060 Note for non-C or non-Linux callers: the inotify events are
4061 defined by the Linux kernel ABI and are listed in
4062 C</usr/include/sys/inotify.h>.");
4063
4064   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
4065    [],
4066    "remove an inotify watch",
4067    "\
4068 Remove a previously defined inotify watch.
4069 See C<guestfs_inotify_add_watch>.");
4070
4071   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
4072    [],
4073    "return list of inotify events",
4074    "\
4075 Return the complete queue of events that have happened
4076 since the previous read call.
4077
4078 If no events have happened, this returns an empty list.
4079
4080 I<Note>: In order to make sure that all events have been
4081 read, you must call this function repeatedly until it
4082 returns an empty list.  The reason is that the call will
4083 read events up to the maximum appliance-to-host message
4084 size and leave remaining events in the queue.");
4085
4086   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
4087    [],
4088    "return list of watched files that had events",
4089    "\
4090 This function is a helpful wrapper around C<guestfs_inotify_read>
4091 which just returns a list of pathnames of objects that were
4092 touched.  The returned pathnames are sorted and deduplicated.");
4093
4094   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
4095    [],
4096    "close the inotify handle",
4097    "\
4098 This closes the inotify handle which was previously
4099 opened by inotify_init.  It removes all watches, throws
4100 away any pending events, and deallocates all resources.");
4101
4102   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
4103    [],
4104    "set SELinux security context",
4105    "\
4106 This sets the SELinux security context of the daemon
4107 to the string C<context>.
4108
4109 See the documentation about SELINUX in L<guestfs(3)>.");
4110
4111   ("getcon", (RString "context", []), 186, [Optional "selinux"],
4112    [],
4113    "get SELinux security context",
4114    "\
4115 This gets the SELinux security context of the daemon.
4116
4117 See the documentation about SELINUX in L<guestfs(3)>,
4118 and C<guestfs_setcon>");
4119
4120   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
4121    [InitEmpty, Always, TestOutput (
4122       [["part_disk"; "/dev/sda"; "mbr"];
4123        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
4124        ["mount_options"; ""; "/dev/sda1"; "/"];
4125        ["write"; "/new"; "new file contents"];
4126        ["cat"; "/new"]], "new file contents");
4127     InitEmpty, Always, TestRun (
4128       [["part_disk"; "/dev/sda"; "mbr"];
4129        ["mkfs_b"; "vfat"; "32768"; "/dev/sda1"]]);
4130     InitEmpty, Always, TestLastFail (
4131       [["part_disk"; "/dev/sda"; "mbr"];
4132        ["mkfs_b"; "vfat"; "32769"; "/dev/sda1"]]);
4133     InitEmpty, Always, TestLastFail (
4134       [["part_disk"; "/dev/sda"; "mbr"];
4135        ["mkfs_b"; "vfat"; "33280"; "/dev/sda1"]]);
4136     InitEmpty, IfAvailable "ntfsprogs", TestRun (
4137       [["part_disk"; "/dev/sda"; "mbr"];
4138        ["mkfs_b"; "ntfs"; "32768"; "/dev/sda1"]])],
4139    "make a filesystem with block size",
4140    "\
4141 This call is similar to C<guestfs_mkfs>, but it allows you to
4142 control the block size of the resulting filesystem.  Supported
4143 block sizes depend on the filesystem type, but typically they
4144 are C<1024>, C<2048> or C<4096> only.
4145
4146 For VFAT and NTFS the C<blocksize> parameter is treated as
4147 the requested cluster size.");
4148
4149   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
4150    [InitEmpty, Always, TestOutput (
4151       [["sfdiskM"; "/dev/sda"; ",100 ,"];
4152        ["mke2journal"; "4096"; "/dev/sda1"];
4153        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
4154        ["mount_options"; ""; "/dev/sda2"; "/"];
4155        ["write"; "/new"; "new file contents"];
4156        ["cat"; "/new"]], "new file contents")],
4157    "make ext2/3/4 external journal",
4158    "\
4159 This creates an ext2 external journal on C<device>.  It is equivalent
4160 to the command:
4161
4162  mke2fs -O journal_dev -b blocksize device");
4163
4164   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
4165    [InitEmpty, Always, TestOutput (
4166       [["sfdiskM"; "/dev/sda"; ",100 ,"];
4167        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
4168        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
4169        ["mount_options"; ""; "/dev/sda2"; "/"];
4170        ["write"; "/new"; "new file contents"];
4171        ["cat"; "/new"]], "new file contents")],
4172    "make ext2/3/4 external journal with label",
4173    "\
4174 This creates an ext2 external journal on C<device> with label C<label>.");
4175
4176   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
4177    (let uuid = uuidgen () in
4178     [InitEmpty, Always, TestOutput (
4179        [["sfdiskM"; "/dev/sda"; ",100 ,"];
4180         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
4181         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
4182         ["mount_options"; ""; "/dev/sda2"; "/"];
4183         ["write"; "/new"; "new file contents"];
4184         ["cat"; "/new"]], "new file contents")]),
4185    "make ext2/3/4 external journal with UUID",
4186    "\
4187 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
4188
4189   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
4190    [],
4191    "make ext2/3/4 filesystem with external journal",
4192    "\
4193 This creates an ext2/3/4 filesystem on C<device> with
4194 an external journal on C<journal>.  It is equivalent
4195 to the command:
4196
4197  mke2fs -t fstype -b blocksize -J device=<journal> <device>
4198
4199 See also C<guestfs_mke2journal>.");
4200
4201   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
4202    [],
4203    "make ext2/3/4 filesystem with external journal",
4204    "\
4205 This creates an ext2/3/4 filesystem on C<device> with
4206 an external journal on the journal labeled C<label>.
4207
4208 See also C<guestfs_mke2journal_L>.");
4209
4210   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
4211    [],
4212    "make ext2/3/4 filesystem with external journal",
4213    "\
4214 This creates an ext2/3/4 filesystem on C<device> with
4215 an external journal on the journal with UUID C<uuid>.
4216
4217 See also C<guestfs_mke2journal_U>.");
4218
4219   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
4220    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
4221    "load a kernel module",
4222    "\
4223 This loads a kernel module in the appliance.
4224
4225 The kernel module must have been whitelisted when libguestfs
4226 was built (see C<appliance/kmod.whitelist.in> in the source).");
4227
4228   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
4229    [InitNone, Always, TestOutput (
4230       [["echo_daemon"; "This is a test"]], "This is a test"
4231     )],
4232    "echo arguments back to the client",
4233    "\
4234 This command concatenates the list of C<words> passed with single spaces
4235 between them and returns the resulting string.
4236
4237 You can use this command to test the connection through to the daemon.
4238
4239 See also C<guestfs_ping_daemon>.");
4240
4241   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
4242    [], (* There is a regression test for this. *)
4243    "find all files and directories, returning NUL-separated list",
4244    "\
4245 This command lists out all files and directories, recursively,
4246 starting at C<directory>, placing the resulting list in the
4247 external file called C<files>.
4248
4249 This command works the same way as C<guestfs_find> with the
4250 following exceptions:
4251
4252 =over 4
4253
4254 =item *
4255
4256 The resulting list is written to an external file.
4257
4258 =item *
4259
4260 Items (filenames) in the result are separated
4261 by C<\\0> characters.  See L<find(1)> option I<-print0>.
4262
4263 =item *
4264
4265 This command is not limited in the number of names that it
4266 can return.
4267
4268 =item *
4269
4270 The result list is not sorted.
4271
4272 =back");
4273
4274   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
4275    [InitISOFS, Always, TestOutput (
4276       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
4277     InitISOFS, Always, TestOutput (
4278       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
4279     InitISOFS, Always, TestOutput (
4280       [["case_sensitive_path"; "/Known-1"]], "/known-1");
4281     InitISOFS, Always, TestLastFail (
4282       [["case_sensitive_path"; "/Known-1/"]]);
4283     InitBasicFS, Always, TestOutput (
4284       [["mkdir"; "/a"];
4285        ["mkdir"; "/a/bbb"];
4286        ["touch"; "/a/bbb/c"];
4287        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
4288     InitBasicFS, Always, TestOutput (
4289       [["mkdir"; "/a"];
4290        ["mkdir"; "/a/bbb"];
4291        ["touch"; "/a/bbb/c"];
4292        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
4293     InitBasicFS, Always, TestLastFail (
4294       [["mkdir"; "/a"];
4295        ["mkdir"; "/a/bbb"];
4296        ["touch"; "/a/bbb/c"];
4297        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
4298    "return true path on case-insensitive filesystem",
4299    "\
4300 This can be used to resolve case insensitive paths on
4301 a filesystem which is case sensitive.  The use case is
4302 to resolve paths which you have read from Windows configuration
4303 files or the Windows Registry, to the true path.
4304
4305 The command handles a peculiarity of the Linux ntfs-3g
4306 filesystem driver (and probably others), which is that although
4307 the underlying filesystem is case-insensitive, the driver
4308 exports the filesystem to Linux as case-sensitive.
4309
4310 One consequence of this is that special directories such
4311 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
4312 (or other things) depending on the precise details of how
4313 they were created.  In Windows itself this would not be
4314 a problem.
4315
4316 Bug or feature?  You decide:
4317 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
4318
4319 This function resolves the true case of each element in the
4320 path and returns the case-sensitive path.
4321
4322 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
4323 might return C<\"/WINDOWS/system32\"> (the exact return value
4324 would depend on details of how the directories were originally
4325 created under Windows).
4326
4327 I<Note>:
4328 This function does not handle drive names, backslashes etc.
4329
4330 See also C<guestfs_realpath>.");
4331
4332   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
4333    [InitBasicFS, Always, TestOutput (
4334       [["vfs_type"; "/dev/sda1"]], "ext2")],
4335    "get the Linux VFS type corresponding to a mounted device",
4336    "\
4337 This command gets the filesystem type corresponding to
4338 the filesystem on C<device>.
4339
4340 For most filesystems, the result is the name of the Linux
4341 VFS module which would be used to mount this filesystem
4342 if you mounted it without specifying the filesystem type.
4343 For example a string such as C<ext3> or C<ntfs>.");
4344
4345   ("truncate", (RErr, [Pathname "path"]), 199, [],
4346    [InitBasicFS, Always, TestOutputStruct (
4347       [["write"; "/test"; "some stuff so size is not zero"];
4348        ["truncate"; "/test"];
4349        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
4350    "truncate a file to zero size",
4351    "\
4352 This command truncates C<path> to a zero-length file.  The
4353 file must exist already.");
4354
4355   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
4356    [InitBasicFS, Always, TestOutputStruct (
4357       [["touch"; "/test"];
4358        ["truncate_size"; "/test"; "1000"];
4359        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
4360    "truncate a file to a particular size",
4361    "\
4362 This command truncates C<path> to size C<size> bytes.  The file
4363 must exist already.
4364
4365 If the current file size is less than C<size> then
4366 the file is extended to the required size with zero bytes.
4367 This creates a sparse file (ie. disk blocks are not allocated
4368 for the file until you write to it).  To create a non-sparse
4369 file of zeroes, use C<guestfs_fallocate64> instead.");
4370
4371   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
4372    [InitBasicFS, Always, TestOutputStruct (
4373       [["touch"; "/test"];
4374        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
4375        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
4376    "set timestamp of a file with nanosecond precision",
4377    "\
4378 This command sets the timestamps of a file with nanosecond
4379 precision.
4380
4381 C<atsecs, atnsecs> are the last access time (atime) in secs and
4382 nanoseconds from the epoch.
4383
4384 C<mtsecs, mtnsecs> are the last modification time (mtime) in
4385 secs and nanoseconds from the epoch.
4386
4387 If the C<*nsecs> field contains the special value C<-1> then
4388 the corresponding timestamp is set to the current time.  (The
4389 C<*secs> field is ignored in this case).
4390
4391 If the C<*nsecs> field contains the special value C<-2> then
4392 the corresponding timestamp is left unchanged.  (The
4393 C<*secs> field is ignored in this case).");
4394
4395   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
4396    [InitBasicFS, Always, TestOutputStruct (
4397       [["mkdir_mode"; "/test"; "0o111"];
4398        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
4399    "create a directory with a particular mode",
4400    "\
4401 This command creates a directory, setting the initial permissions
4402 of the directory to C<mode>.
4403
4404 For common Linux filesystems, the actual mode which is set will
4405 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
4406 interpret the mode in other ways.
4407
4408 See also C<guestfs_mkdir>, C<guestfs_umask>");
4409
4410   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
4411    [], (* XXX *)
4412    "change file owner and group",
4413    "\
4414 Change the file owner to C<owner> and group to C<group>.
4415 This is like C<guestfs_chown> but if C<path> is a symlink then
4416 the link itself is changed, not the target.
4417
4418 Only numeric uid and gid are supported.  If you want to use
4419 names, you will need to locate and parse the password file
4420 yourself (Augeas support makes this relatively easy).");
4421
4422   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
4423    [], (* XXX *)
4424    "lstat on multiple files",
4425    "\
4426 This call allows you to perform the C<guestfs_lstat> operation
4427 on multiple files, where all files are in the directory C<path>.
4428 C<names> is the list of files from this directory.
4429
4430 On return you get a list of stat structs, with a one-to-one
4431 correspondence to the C<names> list.  If any name did not exist
4432 or could not be lstat'd, then the C<ino> field of that structure
4433 is set to C<-1>.
4434
4435 This call is intended for programs that want to efficiently
4436 list a directory contents without making many round-trips.
4437 See also C<guestfs_lxattrlist> for a similarly efficient call
4438 for getting extended attributes.  Very long directory listings
4439 might cause the protocol message size to be exceeded, causing
4440 this call to fail.  The caller must split up such requests
4441 into smaller groups of names.");
4442
4443   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
4444    [], (* XXX *)
4445    "lgetxattr on multiple files",
4446    "\
4447 This call allows you to get the extended attributes
4448 of multiple files, where all files are in the directory C<path>.
4449 C<names> is the list of files from this directory.
4450
4451 On return you get a flat list of xattr structs which must be
4452 interpreted sequentially.  The first xattr struct always has a zero-length
4453 C<attrname>.  C<attrval> in this struct is zero-length
4454 to indicate there was an error doing C<lgetxattr> for this
4455 file, I<or> is a C string which is a decimal number
4456 (the number of following attributes for this file, which could
4457 be C<\"0\">).  Then after the first xattr struct are the
4458 zero or more attributes for the first named file.
4459 This repeats for the second and subsequent files.
4460
4461 This call is intended for programs that want to efficiently
4462 list a directory contents without making many round-trips.
4463 See also C<guestfs_lstatlist> for a similarly efficient call
4464 for getting standard stats.  Very long directory listings
4465 might cause the protocol message size to be exceeded, causing
4466 this call to fail.  The caller must split up such requests
4467 into smaller groups of names.");
4468
4469   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
4470    [], (* XXX *)
4471    "readlink on multiple files",
4472    "\
4473 This call allows you to do a C<readlink> operation
4474 on multiple files, where all files are in the directory C<path>.
4475 C<names> is the list of files from this directory.
4476
4477 On return you get a list of strings, with a one-to-one
4478 correspondence to the C<names> list.  Each string is the
4479 value of the symbolic link.
4480
4481 If the C<readlink(2)> operation fails on any name, then
4482 the corresponding result string is the empty string C<\"\">.
4483 However the whole operation is completed even if there
4484 were C<readlink(2)> errors, and so you can call this
4485 function with names where you don't know if they are
4486 symbolic links already (albeit slightly less efficient).
4487
4488 This call is intended for programs that want to efficiently
4489 list a directory contents without making many round-trips.
4490 Very long directory listings might cause the protocol
4491 message size to be exceeded, causing
4492 this call to fail.  The caller must split up such requests
4493 into smaller groups of names.");
4494
4495   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4496    [InitISOFS, Always, TestOutputBuffer (
4497       [["pread"; "/known-4"; "1"; "3"]], "\n");
4498     InitISOFS, Always, TestOutputBuffer (
4499       [["pread"; "/empty"; "0"; "100"]], "")],
4500    "read part of a file",
4501    "\
4502 This command lets you read part of a file.  It reads C<count>
4503 bytes of the file, starting at C<offset>, from file C<path>.
4504
4505 This may read fewer bytes than requested.  For further details
4506 see the L<pread(2)> system call.
4507
4508 See also C<guestfs_pwrite>.");
4509
4510   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4511    [InitEmpty, Always, TestRun (
4512       [["part_init"; "/dev/sda"; "gpt"]])],
4513    "create an empty partition table",
4514    "\
4515 This creates an empty partition table on C<device> of one of the
4516 partition types listed below.  Usually C<parttype> should be
4517 either C<msdos> or C<gpt> (for large disks).
4518
4519 Initially there are no partitions.  Following this, you should
4520 call C<guestfs_part_add> for each partition required.
4521
4522 Possible values for C<parttype> are:
4523
4524 =over 4
4525
4526 =item B<efi> | B<gpt>
4527
4528 Intel EFI / GPT partition table.
4529
4530 This is recommended for >= 2 TB partitions that will be accessed
4531 from Linux and Intel-based Mac OS X.  It also has limited backwards
4532 compatibility with the C<mbr> format.
4533
4534 =item B<mbr> | B<msdos>
4535
4536 The standard PC \"Master Boot Record\" (MBR) format used
4537 by MS-DOS and Windows.  This partition type will B<only> work
4538 for device sizes up to 2 TB.  For large disks we recommend
4539 using C<gpt>.
4540
4541 =back
4542
4543 Other partition table types that may work but are not
4544 supported include:
4545
4546 =over 4
4547
4548 =item B<aix>
4549
4550 AIX disk labels.
4551
4552 =item B<amiga> | B<rdb>
4553
4554 Amiga \"Rigid Disk Block\" format.
4555
4556 =item B<bsd>
4557
4558 BSD disk labels.
4559
4560 =item B<dasd>
4561
4562 DASD, used on IBM mainframes.
4563
4564 =item B<dvh>
4565
4566 MIPS/SGI volumes.
4567
4568 =item B<mac>
4569
4570 Old Mac partition format.  Modern Macs use C<gpt>.
4571
4572 =item B<pc98>
4573
4574 NEC PC-98 format, common in Japan apparently.
4575
4576 =item B<sun>
4577
4578 Sun disk labels.
4579
4580 =back");
4581
4582   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4583    [InitEmpty, Always, TestRun (
4584       [["part_init"; "/dev/sda"; "mbr"];
4585        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4586     InitEmpty, Always, TestRun (
4587       [["part_init"; "/dev/sda"; "gpt"];
4588        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4589        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4590     InitEmpty, Always, TestRun (
4591       [["part_init"; "/dev/sda"; "mbr"];
4592        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4593        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4594        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4595        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4596    "add a partition to the device",
4597    "\
4598 This command adds a partition to C<device>.  If there is no partition
4599 table on the device, call C<guestfs_part_init> first.
4600
4601 The C<prlogex> parameter is the type of partition.  Normally you
4602 should pass C<p> or C<primary> here, but MBR partition tables also
4603 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4604 types.
4605
4606 C<startsect> and C<endsect> are the start and end of the partition
4607 in I<sectors>.  C<endsect> may be negative, which means it counts
4608 backwards from the end of the disk (C<-1> is the last sector).
4609
4610 Creating a partition which covers the whole disk is not so easy.
4611 Use C<guestfs_part_disk> to do that.");
4612
4613   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4614    [InitEmpty, Always, TestRun (
4615       [["part_disk"; "/dev/sda"; "mbr"]]);
4616     InitEmpty, Always, TestRun (
4617       [["part_disk"; "/dev/sda"; "gpt"]])],
4618    "partition whole disk with a single primary partition",
4619    "\
4620 This command is simply a combination of C<guestfs_part_init>
4621 followed by C<guestfs_part_add> to create a single primary partition
4622 covering the whole disk.
4623
4624 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4625 but other possible values are described in C<guestfs_part_init>.");
4626
4627   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4628    [InitEmpty, Always, TestRun (
4629       [["part_disk"; "/dev/sda"; "mbr"];
4630        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4631    "make a partition bootable",
4632    "\
4633 This sets the bootable flag on partition numbered C<partnum> on
4634 device C<device>.  Note that partitions are numbered from 1.
4635
4636 The bootable flag is used by some operating systems (notably
4637 Windows) to determine which partition to boot from.  It is by
4638 no means universally recognized.");
4639
4640   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4641    [InitEmpty, Always, TestRun (
4642       [["part_disk"; "/dev/sda"; "gpt"];
4643        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4644    "set partition name",
4645    "\
4646 This sets the partition name on partition numbered C<partnum> on
4647 device C<device>.  Note that partitions are numbered from 1.
4648
4649 The partition name can only be set on certain types of partition
4650 table.  This works on C<gpt> but not on C<mbr> partitions.");
4651
4652   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4653    [], (* XXX Add a regression test for this. *)
4654    "list partitions on a device",
4655    "\
4656 This command parses the partition table on C<device> and
4657 returns the list of partitions found.
4658
4659 The fields in the returned structure are:
4660
4661 =over 4
4662
4663 =item B<part_num>
4664
4665 Partition number, counting from 1.
4666
4667 =item B<part_start>
4668
4669 Start of the partition I<in bytes>.  To get sectors you have to
4670 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4671
4672 =item B<part_end>
4673
4674 End of the partition in bytes.
4675
4676 =item B<part_size>
4677
4678 Size of the partition in bytes.
4679
4680 =back");
4681
4682   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4683    [InitEmpty, Always, TestOutput (
4684       [["part_disk"; "/dev/sda"; "gpt"];
4685        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4686    "get the partition table type",
4687    "\
4688 This command examines the partition table on C<device> and
4689 returns the partition table type (format) being used.
4690
4691 Common return values include: C<msdos> (a DOS/Windows style MBR
4692 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4693 values are possible, although unusual.  See C<guestfs_part_init>
4694 for a full list.");
4695
4696   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [Progress],
4697    [InitBasicFS, Always, TestOutputBuffer (
4698       [["fill"; "0x63"; "10"; "/test"];
4699        ["read_file"; "/test"]], "cccccccccc")],
4700    "fill a file with octets",
4701    "\
4702 This command creates a new file called C<path>.  The initial
4703 content of the file is C<len> octets of C<c>, where C<c>
4704 must be a number in the range C<[0..255]>.
4705
4706 To fill a file with zero bytes (sparsely), it is
4707 much more efficient to use C<guestfs_truncate_size>.
4708 To create a file with a pattern of repeating bytes
4709 use C<guestfs_fill_pattern>.");
4710
4711   ("available", (RErr, [StringList "groups"]), 216, [],
4712    [InitNone, Always, TestRun [["available"; ""]]],
4713    "test availability of some parts of the API",
4714    "\
4715 This command is used to check the availability of some
4716 groups of functionality in the appliance, which not all builds of
4717 the libguestfs appliance will be able to provide.
4718
4719 The libguestfs groups, and the functions that those
4720 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4721 You can also fetch this list at runtime by calling
4722 C<guestfs_available_all_groups>.
4723
4724 The argument C<groups> is a list of group names, eg:
4725 C<[\"inotify\", \"augeas\"]> would check for the availability of
4726 the Linux inotify functions and Augeas (configuration file
4727 editing) functions.
4728
4729 The command returns no error if I<all> requested groups are available.
4730
4731 It fails with an error if one or more of the requested
4732 groups is unavailable in the appliance.
4733
4734 If an unknown group name is included in the
4735 list of groups then an error is always returned.
4736
4737 I<Notes:>
4738
4739 =over 4
4740
4741 =item *
4742
4743 You must call C<guestfs_launch> before calling this function.
4744
4745 The reason is because we don't know what groups are
4746 supported by the appliance/daemon until it is running and can
4747 be queried.
4748
4749 =item *
4750
4751 If a group of functions is available, this does not necessarily
4752 mean that they will work.  You still have to check for errors
4753 when calling individual API functions even if they are
4754 available.
4755
4756 =item *
4757
4758 It is usually the job of distro packagers to build
4759 complete functionality into the libguestfs appliance.
4760 Upstream libguestfs, if built from source with all
4761 requirements satisfied, will support everything.
4762
4763 =item *
4764
4765 This call was added in version C<1.0.80>.  In previous
4766 versions of libguestfs all you could do would be to speculatively
4767 execute a command to find out if the daemon implemented it.
4768 See also C<guestfs_version>.
4769
4770 =back");
4771
4772   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4773    [InitBasicFS, Always, TestOutputBuffer (
4774       [["write"; "/src"; "hello, world"];
4775        ["dd"; "/src"; "/dest"];
4776        ["read_file"; "/dest"]], "hello, world")],
4777    "copy from source to destination using dd",
4778    "\
4779 This command copies from one source device or file C<src>
4780 to another destination device or file C<dest>.  Normally you
4781 would use this to copy to or from a device or partition, for
4782 example to duplicate a filesystem.
4783
4784 If the destination is a device, it must be as large or larger
4785 than the source file or device, otherwise the copy will fail.
4786 This command cannot do partial copies (see C<guestfs_copy_size>).");
4787
4788   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4789    [InitBasicFS, Always, TestOutputInt (
4790       [["write"; "/file"; "hello, world"];
4791        ["filesize"; "/file"]], 12)],
4792    "return the size of the file in bytes",
4793    "\
4794 This command returns the size of C<file> in bytes.
4795
4796 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4797 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4798 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4799
4800   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4801    [InitBasicFSonLVM, Always, TestOutputList (
4802       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4803        ["lvs"]], ["/dev/VG/LV2"])],
4804    "rename an LVM logical volume",
4805    "\
4806 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4807
4808   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4809    [InitBasicFSonLVM, Always, TestOutputList (
4810       [["umount"; "/"];
4811        ["vg_activate"; "false"; "VG"];
4812        ["vgrename"; "VG"; "VG2"];
4813        ["vg_activate"; "true"; "VG2"];
4814        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4815        ["vgs"]], ["VG2"])],
4816    "rename an LVM volume group",
4817    "\
4818 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4819
4820   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4821    [InitISOFS, Always, TestOutputBuffer (
4822       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4823    "list the contents of a single file in an initrd",
4824    "\
4825 This command unpacks the file C<filename> from the initrd file
4826 called C<initrdpath>.  The filename must be given I<without> the
4827 initial C</> character.
4828
4829 For example, in guestfish you could use the following command
4830 to examine the boot script (usually called C</init>)
4831 contained in a Linux initrd or initramfs image:
4832
4833  initrd-cat /boot/initrd-<version>.img init
4834
4835 See also C<guestfs_initrd_list>.");
4836
4837   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4838    [],
4839    "get the UUID of a physical volume",
4840    "\
4841 This command returns the UUID of the LVM PV C<device>.");
4842
4843   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4844    [],
4845    "get the UUID of a volume group",
4846    "\
4847 This command returns the UUID of the LVM VG named C<vgname>.");
4848
4849   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4850    [],
4851    "get the UUID of a logical volume",
4852    "\
4853 This command returns the UUID of the LVM LV C<device>.");
4854
4855   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4856    [],
4857    "get the PV UUIDs containing the volume group",
4858    "\
4859 Given a VG called C<vgname>, this returns the UUIDs of all
4860 the physical volumes that this volume group resides on.
4861
4862 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4863 calls to associate physical volumes and volume groups.
4864
4865 See also C<guestfs_vglvuuids>.");
4866
4867   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4868    [],
4869    "get the LV UUIDs of all LVs in the volume group",
4870    "\
4871 Given a VG called C<vgname>, this returns the UUIDs of all
4872 the logical volumes created in this volume group.
4873
4874 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4875 calls to associate logical volumes and volume groups.
4876
4877 See also C<guestfs_vgpvuuids>.");
4878
4879   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [Progress],
4880    [InitBasicFS, Always, TestOutputBuffer (
4881       [["write"; "/src"; "hello, world"];
4882        ["copy_size"; "/src"; "/dest"; "5"];
4883        ["read_file"; "/dest"]], "hello")],
4884    "copy size bytes from source to destination using dd",
4885    "\
4886 This command copies exactly C<size> bytes from one source device
4887 or file C<src> to another destination device or file C<dest>.
4888
4889 Note this will fail if the source is too short or if the destination
4890 is not large enough.");
4891
4892   ("zero_device", (RErr, [Device "device"]), 228, [DangerWillRobinson; Progress],
4893    [InitBasicFSonLVM, Always, TestRun (
4894       [["zero_device"; "/dev/VG/LV"]])],
4895    "write zeroes to an entire device",
4896    "\
4897 This command writes zeroes over the entire C<device>.  Compare
4898 with C<guestfs_zero> which just zeroes the first few blocks of
4899 a device.");
4900
4901   ("txz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 229, [Optional "xz"],
4902    [InitBasicFS, Always, TestOutput (
4903       [["txz_in"; "../images/helloworld.tar.xz"; "/"];
4904        ["cat"; "/hello"]], "hello\n")],
4905    "unpack compressed tarball to directory",
4906    "\
4907 This command uploads and unpacks local file C<tarball> (an
4908 I<xz compressed> tar file) into C<directory>.");
4909
4910   ("txz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 230, [Optional "xz"],
4911    [],
4912    "pack directory into compressed tarball",
4913    "\
4914 This command packs the contents of C<directory> and downloads
4915 it to local file C<tarball> (as an xz compressed tar archive).");
4916
4917   ("ntfsresize", (RErr, [Device "device"]), 231, [Optional "ntfsprogs"],
4918    [],
4919    "resize an NTFS filesystem",
4920    "\
4921 This command resizes an NTFS filesystem, expanding or
4922 shrinking it to the size of the underlying device.
4923 See also L<ntfsresize(8)>.");
4924
4925   ("vgscan", (RErr, []), 232, [],
4926    [InitEmpty, Always, TestRun (
4927       [["vgscan"]])],
4928    "rescan for LVM physical volumes, volume groups and logical volumes",
4929    "\
4930 This rescans all block devices and rebuilds the list of LVM
4931 physical volumes, volume groups and logical volumes.");
4932
4933   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4934    [InitEmpty, Always, TestRun (
4935       [["part_init"; "/dev/sda"; "mbr"];
4936        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4937        ["part_del"; "/dev/sda"; "1"]])],
4938    "delete a partition",
4939    "\
4940 This command deletes the partition numbered C<partnum> on C<device>.
4941
4942 Note that in the case of MBR partitioning, deleting an
4943 extended partition also deletes any logical partitions
4944 it contains.");
4945
4946   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4947    [InitEmpty, Always, TestOutputTrue (
4948       [["part_init"; "/dev/sda"; "mbr"];
4949        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4950        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4951        ["part_get_bootable"; "/dev/sda"; "1"]])],
4952    "return true if a partition is bootable",
4953    "\
4954 This command returns true if the partition C<partnum> on
4955 C<device> has the bootable flag set.
4956
4957 See also C<guestfs_part_set_bootable>.");
4958
4959   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [FishOutput FishOutputHexadecimal],
4960    [InitEmpty, Always, TestOutputInt (
4961       [["part_init"; "/dev/sda"; "mbr"];
4962        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4963        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4964        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4965    "get the MBR type byte (ID byte) from a partition",
4966    "\
4967 Returns the MBR type byte (also known as the ID byte) from
4968 the numbered partition C<partnum>.
4969
4970 Note that only MBR (old DOS-style) partitions have type bytes.
4971 You will get undefined results for other partition table
4972 types (see C<guestfs_part_get_parttype>).");
4973
4974   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4975    [], (* tested by part_get_mbr_id *)
4976    "set the MBR type byte (ID byte) of a partition",
4977    "\
4978 Sets the MBR type byte (also known as the ID byte) of
4979 the numbered partition C<partnum> to C<idbyte>.  Note
4980 that the type bytes quoted in most documentation are
4981 in fact hexadecimal numbers, but usually documented
4982 without any leading \"0x\" which might be confusing.
4983
4984 Note that only MBR (old DOS-style) partitions have type bytes.
4985 You will get undefined results for other partition table
4986 types (see C<guestfs_part_get_parttype>).");
4987
4988   ("checksum_device", (RString "checksum", [String "csumtype"; Device "device"]), 237, [],
4989    [InitISOFS, Always, TestOutput (
4990       [["checksum_device"; "md5"; "/dev/sdd"]],
4991       (Digest.to_hex (Digest.file "images/test.iso")))],
4992    "compute MD5, SHAx or CRC checksum of the contents of a device",
4993    "\
4994 This call computes the MD5, SHAx or CRC checksum of the
4995 contents of the device named C<device>.  For the types of
4996 checksums supported see the C<guestfs_checksum> command.");
4997
4998   ("lvresize_free", (RErr, [Device "lv"; Int "percent"]), 238, [Optional "lvm2"],
4999    [InitNone, Always, TestRun (
5000       [["part_disk"; "/dev/sda"; "mbr"];
5001        ["pvcreate"; "/dev/sda1"];
5002        ["vgcreate"; "VG"; "/dev/sda1"];
5003        ["lvcreate"; "LV"; "VG"; "10"];
5004        ["lvresize_free"; "/dev/VG/LV"; "100"]])],
5005    "expand an LV to fill free space",
5006    "\
5007 This expands an existing logical volume C<lv> so that it fills
5008 C<pc>% of the remaining free space in the volume group.  Commonly
5009 you would call this with pc = 100 which expands the logical volume
5010 as much as possible, using all remaining free space in the volume
5011 group.");
5012
5013   ("aug_clear", (RErr, [String "augpath"]), 239, [Optional "augeas"],
5014    [], (* XXX Augeas code needs tests. *)
5015    "clear Augeas path",
5016    "\
5017 Set the value associated with C<path> to C<NULL>.  This
5018 is the same as the L<augtool(1)> C<clear> command.");
5019
5020   ("get_umask", (RInt "mask", []), 240, [FishOutput FishOutputOctal],
5021    [InitEmpty, Always, TestOutputInt (
5022       [["get_umask"]], 0o22)],
5023    "get the current umask",
5024    "\
5025 Return the current umask.  By default the umask is C<022>
5026 unless it has been set by calling C<guestfs_umask>.");
5027
5028   ("debug_upload", (RErr, [FileIn "filename"; String "tmpname"; Int "mode"]), 241, [],
5029    [],
5030    "upload a file to the appliance (internal use only)",
5031    "\
5032 The C<guestfs_debug_upload> command uploads a file to
5033 the libguestfs appliance.
5034
5035 There is no comprehensive help for this command.  You have
5036 to look at the file C<daemon/debug.c> in the libguestfs source
5037 to find out what it is for.");
5038
5039   ("base64_in", (RErr, [FileIn "base64file"; Pathname "filename"]), 242, [],
5040    [InitBasicFS, Always, TestOutput (
5041       [["base64_in"; "../images/hello.b64"; "/hello"];
5042        ["cat"; "/hello"]], "hello\n")],
5043    "upload base64-encoded data to file",
5044    "\
5045 This command uploads base64-encoded data from C<base64file>
5046 to C<filename>.");
5047
5048   ("base64_out", (RErr, [Pathname "filename"; FileOut "base64file"]), 243, [],
5049    [],
5050    "download file and encode as base64",
5051    "\
5052 This command downloads the contents of C<filename>, writing
5053 it out to local file C<base64file> encoded as base64.");
5054
5055   ("checksums_out", (RErr, [String "csumtype"; Pathname "directory"; FileOut "sumsfile"]), 244, [],
5056    [],
5057    "compute MD5, SHAx or CRC checksum of files in a directory",
5058    "\
5059 This command computes the checksums of all regular files in
5060 C<directory> and then emits a list of those checksums to
5061 the local output file C<sumsfile>.
5062
5063 This can be used for verifying the integrity of a virtual
5064 machine.  However to be properly secure you should pay
5065 attention to the output of the checksum command (it uses
5066 the ones from GNU coreutils).  In particular when the
5067 filename is not printable, coreutils uses a special
5068 backslash syntax.  For more information, see the GNU
5069 coreutils info file.");
5070
5071   ("fill_pattern", (RErr, [String "pattern"; Int "len"; Pathname "path"]), 245, [Progress],
5072    [InitBasicFS, Always, TestOutputBuffer (
5073       [["fill_pattern"; "abcdefghijklmnopqrstuvwxyz"; "28"; "/test"];
5074        ["read_file"; "/test"]], "abcdefghijklmnopqrstuvwxyzab")],
5075    "fill a file with a repeating pattern of bytes",
5076    "\
5077 This function is like C<guestfs_fill> except that it creates
5078 a new file of length C<len> containing the repeating pattern
5079 of bytes in C<pattern>.  The pattern is truncated if necessary
5080 to ensure the length of the file is exactly C<len> bytes.");
5081
5082   ("write", (RErr, [Pathname "path"; BufferIn "content"]), 246, [ProtocolLimitWarning],
5083    [InitBasicFS, Always, TestOutput (
5084       [["write"; "/new"; "new file contents"];
5085        ["cat"; "/new"]], "new file contents");
5086     InitBasicFS, Always, TestOutput (
5087       [["write"; "/new"; "\nnew file contents\n"];
5088        ["cat"; "/new"]], "\nnew file contents\n");
5089     InitBasicFS, Always, TestOutput (
5090       [["write"; "/new"; "\n\n"];
5091        ["cat"; "/new"]], "\n\n");
5092     InitBasicFS, Always, TestOutput (
5093       [["write"; "/new"; ""];
5094        ["cat"; "/new"]], "");
5095     InitBasicFS, Always, TestOutput (
5096       [["write"; "/new"; "\n\n\n"];
5097        ["cat"; "/new"]], "\n\n\n");
5098     InitBasicFS, Always, TestOutput (
5099       [["write"; "/new"; "\n"];
5100        ["cat"; "/new"]], "\n")],
5101    "create a new file",
5102    "\
5103 This call creates a file called C<path>.  The content of the
5104 file is the string C<content> (which can contain any 8 bit data).");
5105
5106   ("pwrite", (RInt "nbytes", [Pathname "path"; BufferIn "content"; Int64 "offset"]), 247, [ProtocolLimitWarning],
5107    [InitBasicFS, Always, TestOutput (
5108       [["write"; "/new"; "new file contents"];
5109        ["pwrite"; "/new"; "data"; "4"];
5110        ["cat"; "/new"]], "new data contents");
5111     InitBasicFS, Always, TestOutput (
5112       [["write"; "/new"; "new file contents"];
5113        ["pwrite"; "/new"; "is extended"; "9"];
5114        ["cat"; "/new"]], "new file is extended");
5115     InitBasicFS, Always, TestOutput (
5116       [["write"; "/new"; "new file contents"];
5117        ["pwrite"; "/new"; ""; "4"];
5118        ["cat"; "/new"]], "new file contents")],
5119    "write to part of a file",
5120    "\
5121 This command writes to part of a file.  It writes the data
5122 buffer C<content> to the file C<path> starting at offset C<offset>.
5123
5124 This command implements the L<pwrite(2)> system call, and like
5125 that system call it may not write the full data requested.  The
5126 return value is the number of bytes that were actually written
5127 to the file.  This could even be 0, although short writes are
5128 unlikely for regular files in ordinary circumstances.
5129
5130 See also C<guestfs_pread>.");
5131
5132   ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
5133    [],
5134    "resize an ext2, ext3 or ext4 filesystem (with size)",
5135    "\
5136 This command is the same as C<guestfs_resize2fs> except that it
5137 allows you to specify the new size (in bytes) explicitly.");
5138
5139   ("pvresize_size", (RErr, [Device "device"; Int64 "size"]), 249, [Optional "lvm2"],
5140    [],
5141    "resize an LVM physical volume (with size)",
5142    "\
5143 This command is the same as C<guestfs_pvresize> except that it
5144 allows you to specify the new size (in bytes) explicitly.");
5145
5146   ("ntfsresize_size", (RErr, [Device "device"; Int64 "size"]), 250, [Optional "ntfsprogs"],
5147    [],
5148    "resize an NTFS filesystem (with size)",
5149    "\
5150 This command is the same as C<guestfs_ntfsresize> except that it
5151 allows you to specify the new size (in bytes) explicitly.");
5152
5153   ("available_all_groups", (RStringList "groups", []), 251, [],
5154    [InitNone, Always, TestRun [["available_all_groups"]]],
5155    "return a list of all optional groups",
5156    "\
5157 This command returns a list of all optional groups that this
5158 daemon knows about.  Note this returns both supported and unsupported
5159 groups.  To find out which ones the daemon can actually support
5160 you have to call C<guestfs_available> on each member of the
5161 returned list.
5162
5163 See also C<guestfs_available> and L<guestfs(3)/AVAILABILITY>.");
5164
5165   ("fallocate64", (RErr, [Pathname "path"; Int64 "len"]), 252, [],
5166    [InitBasicFS, Always, TestOutputStruct (
5167       [["fallocate64"; "/a"; "1000000"];
5168        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
5169    "preallocate a file in the guest filesystem",
5170    "\
5171 This command preallocates a file (containing zero bytes) named
5172 C<path> of size C<len> bytes.  If the file exists already, it
5173 is overwritten.
5174
5175 Note that this call allocates disk blocks for the file.
5176 To create a sparse file use C<guestfs_truncate_size> instead.
5177
5178 The deprecated call C<guestfs_fallocate> does the same,
5179 but owing to an oversight it only allowed 30 bit lengths
5180 to be specified, effectively limiting the maximum size
5181 of files created through that call to 1GB.
5182
5183 Do not confuse this with the guestfish-specific
5184 C<alloc> and C<sparse> commands which create
5185 a file in the host and attach it as a device.");
5186
5187   ("vfs_label", (RString "label", [Device "device"]), 253, [],
5188    [InitBasicFS, Always, TestOutput (
5189        [["set_e2label"; "/dev/sda1"; "LTEST"];
5190         ["vfs_label"; "/dev/sda1"]], "LTEST")],
5191    "get the filesystem label",
5192    "\
5193 This returns the filesystem label of the filesystem on
5194 C<device>.
5195
5196 If the filesystem is unlabeled, this returns the empty string.
5197
5198 To find a filesystem from the label, use C<guestfs_findfs_label>.");
5199
5200   ("vfs_uuid", (RString "uuid", [Device "device"]), 254, [],
5201    (let uuid = uuidgen () in
5202     [InitBasicFS, Always, TestOutput (
5203        [["set_e2uuid"; "/dev/sda1"; uuid];
5204         ["vfs_uuid"; "/dev/sda1"]], uuid)]),
5205    "get the filesystem UUID",
5206    "\
5207 This returns the filesystem UUID of the filesystem on
5208 C<device>.
5209
5210 If the filesystem does not have a UUID, this returns the empty string.
5211
5212 To find a filesystem from the UUID, use C<guestfs_findfs_uuid>.");
5213
5214   ("lvm_set_filter", (RErr, [DeviceList "devices"]), 255, [Optional "lvm2"],
5215    (* Can't be tested with the current framework because
5216     * the VG is being used by the mounted filesystem, so
5217     * the vgchange -an command we do first will fail.
5218     *)
5219     [],
5220    "set LVM device filter",
5221    "\
5222 This sets the LVM device filter so that LVM will only be
5223 able to \"see\" the block devices in the list C<devices>,
5224 and will ignore all other attached block devices.
5225
5226 Where disk image(s) contain duplicate PVs or VGs, this
5227 command is useful to get LVM to ignore the duplicates, otherwise
5228 LVM can get confused.  Note also there are two types
5229 of duplication possible: either cloned PVs/VGs which have
5230 identical UUIDs; or VGs that are not cloned but just happen
5231 to have the same name.  In normal operation you cannot
5232 create this situation, but you can do it outside LVM, eg.
5233 by cloning disk images or by bit twiddling inside the LVM
5234 metadata.
5235
5236 This command also clears the LVM cache and performs a volume
5237 group scan.
5238
5239 You can filter whole block devices or individual partitions.
5240
5241 You cannot use this if any VG is currently in use (eg.
5242 contains a mounted filesystem), even if you are not
5243 filtering out that VG.");
5244
5245   ("lvm_clear_filter", (RErr, []), 256, [],
5246    [], (* see note on lvm_set_filter *)
5247    "clear LVM device filter",
5248    "\
5249 This undoes the effect of C<guestfs_lvm_set_filter>.  LVM
5250 will be able to see every block device.
5251
5252 This command also clears the LVM cache and performs a volume
5253 group scan.");
5254
5255   ("luks_open", (RErr, [Device "device"; Key "key"; String "mapname"]), 257, [Optional "luks"],
5256    [],
5257    "open a LUKS-encrypted block device",
5258    "\
5259 This command opens a block device which has been encrypted
5260 according to the Linux Unified Key Setup (LUKS) standard.
5261
5262 C<device> is the encrypted block device or partition.
5263
5264 The caller must supply one of the keys associated with the
5265 LUKS block device, in the C<key> parameter.
5266
5267 This creates a new block device called C</dev/mapper/mapname>.
5268 Reads and writes to this block device are decrypted from and
5269 encrypted to the underlying C<device> respectively.
5270
5271 If this block device contains LVM volume groups, then
5272 calling C<guestfs_vgscan> followed by C<guestfs_vg_activate_all>
5273 will make them visible.");
5274
5275   ("luks_open_ro", (RErr, [Device "device"; Key "key"; String "mapname"]), 258, [Optional "luks"],
5276    [],
5277    "open a LUKS-encrypted block device read-only",
5278    "\
5279 This is the same as C<guestfs_luks_open> except that a read-only
5280 mapping is created.");
5281
5282   ("luks_close", (RErr, [Device "device"]), 259, [Optional "luks"],
5283    [],
5284    "close a LUKS device",
5285    "\
5286 This closes a LUKS device that was created earlier by
5287 C<guestfs_luks_open> or C<guestfs_luks_open_ro>.  The
5288 C<device> parameter must be the name of the LUKS mapping
5289 device (ie. C</dev/mapper/mapname>) and I<not> the name
5290 of the underlying block device.");
5291
5292   ("luks_format", (RErr, [Device "device"; Key "key"; Int "keyslot"]), 260, [Optional "luks"; DangerWillRobinson],
5293    [],
5294    "format a block device as a LUKS encrypted device",
5295    "\
5296 This command erases existing data on C<device> and formats
5297 the device as a LUKS encrypted device.  C<key> is the
5298 initial key, which is added to key slot C<slot>.  (LUKS
5299 supports 8 key slots, numbered 0-7).");
5300
5301   ("luks_format_cipher", (RErr, [Device "device"; Key "key"; Int "keyslot"; String "cipher"]), 261, [Optional "luks"; DangerWillRobinson],
5302    [],
5303    "format a block device as a LUKS encrypted device",
5304    "\
5305 This command is the same as C<guestfs_luks_format> but
5306 it also allows you to set the C<cipher> used.");
5307
5308   ("luks_add_key", (RErr, [Device "device"; Key "key"; Key "newkey"; Int "keyslot"]), 262, [Optional "luks"],
5309    [],
5310    "add a key on a LUKS encrypted device",
5311    "\
5312 This command adds a new key on LUKS device C<device>.
5313 C<key> is any existing key, and is used to access the device.
5314 C<newkey> is the new key to add.  C<keyslot> is the key slot
5315 that will be replaced.
5316
5317 Note that if C<keyslot> already contains a key, then this
5318 command will fail.  You have to use C<guestfs_luks_kill_slot>
5319 first to remove that key.");
5320
5321   ("luks_kill_slot", (RErr, [Device "device"; Key "key"; Int "keyslot"]), 263, [Optional "luks"],
5322    [],
5323    "remove a key from a LUKS encrypted device",
5324    "\
5325 This command deletes the key in key slot C<keyslot> from the
5326 encrypted LUKS device C<device>.  C<key> must be one of the
5327 I<other> keys.");
5328
5329   ("is_lv", (RBool "lvflag", [Device "device"]), 264, [Optional "lvm2"],
5330    [InitBasicFSonLVM, IfAvailable "lvm2", TestOutputTrue (
5331       [["is_lv"; "/dev/VG/LV"]]);
5332     InitBasicFSonLVM, IfAvailable "lvm2", TestOutputFalse (
5333       [["is_lv"; "/dev/sda1"]])],
5334    "test if device is a logical volume",
5335    "\
5336 This command tests whether C<device> is a logical volume, and
5337 returns true iff this is the case.");
5338
5339   ("findfs_uuid", (RString "device", [String "uuid"]), 265, [],
5340    [],
5341    "find a filesystem by UUID",
5342    "\
5343 This command searches the filesystems and returns the one
5344 which has the given UUID.  An error is returned if no such
5345 filesystem can be found.
5346
5347 To find the UUID of a filesystem, use C<guestfs_vfs_uuid>.");
5348
5349   ("findfs_label", (RString "device", [String "label"]), 266, [],
5350    [],
5351    "find a filesystem by label",
5352    "\
5353 This command searches the filesystems and returns the one
5354 which has the given label.  An error is returned if no such
5355 filesystem can be found.
5356
5357 To find the label of a filesystem, use C<guestfs_vfs_label>.");
5358
5359 ]
5360
5361 let all_functions = non_daemon_functions @ daemon_functions
5362
5363 (* In some places we want the functions to be displayed sorted
5364  * alphabetically, so this is useful:
5365  *)
5366 let all_functions_sorted =
5367   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
5368                compare n1 n2) all_functions
5369
5370 (* This is used to generate the src/MAX_PROC_NR file which
5371  * contains the maximum procedure number, a surrogate for the
5372  * ABI version number.  See src/Makefile.am for the details.
5373  *)
5374 let max_proc_nr =
5375   let proc_nrs = List.map (
5376     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
5377   ) daemon_functions in
5378   List.fold_left max 0 proc_nrs
5379
5380 (* Field types for structures. *)
5381 type field =
5382   | FChar                       (* C 'char' (really, a 7 bit byte). *)
5383   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
5384   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
5385   | FUInt32
5386   | FInt32
5387   | FUInt64
5388   | FInt64
5389   | FBytes                      (* Any int measure that counts bytes. *)
5390   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
5391   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
5392
5393 (* Because we generate extra parsing code for LVM command line tools,
5394  * we have to pull out the LVM columns separately here.
5395  *)
5396 let lvm_pv_cols = [
5397   "pv_name", FString;
5398   "pv_uuid", FUUID;
5399   "pv_fmt", FString;
5400   "pv_size", FBytes;
5401   "dev_size", FBytes;
5402   "pv_free", FBytes;
5403   "pv_used", FBytes;
5404   "pv_attr", FString (* XXX *);
5405   "pv_pe_count", FInt64;
5406   "pv_pe_alloc_count", FInt64;
5407   "pv_tags", FString;
5408   "pe_start", FBytes;
5409   "pv_mda_count", FInt64;
5410   "pv_mda_free", FBytes;
5411   (* Not in Fedora 10:
5412      "pv_mda_size", FBytes;
5413   *)
5414 ]
5415 let lvm_vg_cols = [
5416   "vg_name", FString;
5417   "vg_uuid", FUUID;
5418   "vg_fmt", FString;
5419   "vg_attr", FString (* XXX *);
5420   "vg_size", FBytes;
5421   "vg_free", FBytes;
5422   "vg_sysid", FString;
5423   "vg_extent_size", FBytes;
5424   "vg_extent_count", FInt64;
5425   "vg_free_count", FInt64;
5426   "max_lv", FInt64;
5427   "max_pv", FInt64;
5428   "pv_count", FInt64;
5429   "lv_count", FInt64;
5430   "snap_count", FInt64;
5431   "vg_seqno", FInt64;
5432   "vg_tags", FString;
5433   "vg_mda_count", FInt64;
5434   "vg_mda_free", FBytes;
5435   (* Not in Fedora 10:
5436      "vg_mda_size", FBytes;
5437   *)
5438 ]
5439 let lvm_lv_cols = [
5440   "lv_name", FString;
5441   "lv_uuid", FUUID;
5442   "lv_attr", FString (* XXX *);
5443   "lv_major", FInt64;
5444   "lv_minor", FInt64;
5445   "lv_kernel_major", FInt64;
5446   "lv_kernel_minor", FInt64;
5447   "lv_size", FBytes;
5448   "seg_count", FInt64;
5449   "origin", FString;
5450   "snap_percent", FOptPercent;
5451   "copy_percent", FOptPercent;
5452   "move_pv", FString;
5453   "lv_tags", FString;
5454   "mirror_log", FString;
5455   "modules", FString;
5456 ]
5457
5458 (* Names and fields in all structures (in RStruct and RStructList)
5459  * that we support.
5460  *)
5461 let structs = [
5462   (* The old RIntBool return type, only ever used for aug_defnode.  Do
5463    * not use this struct in any new code.
5464    *)
5465   "int_bool", [
5466     "i", FInt32;                (* for historical compatibility *)
5467     "b", FInt32;                (* for historical compatibility *)
5468   ];
5469
5470   (* LVM PVs, VGs, LVs. *)
5471   "lvm_pv", lvm_pv_cols;
5472   "lvm_vg", lvm_vg_cols;
5473   "lvm_lv", lvm_lv_cols;
5474
5475   (* Column names and types from stat structures.
5476    * NB. Can't use things like 'st_atime' because glibc header files
5477    * define some of these as macros.  Ugh.
5478    *)
5479   "stat", [
5480     "dev", FInt64;
5481     "ino", FInt64;
5482     "mode", FInt64;
5483     "nlink", FInt64;
5484     "uid", FInt64;
5485     "gid", FInt64;
5486     "rdev", FInt64;
5487     "size", FInt64;
5488     "blksize", FInt64;
5489     "blocks", FInt64;
5490     "atime", FInt64;
5491     "mtime", FInt64;
5492     "ctime", FInt64;
5493   ];
5494   "statvfs", [
5495     "bsize", FInt64;
5496     "frsize", FInt64;
5497     "blocks", FInt64;
5498     "bfree", FInt64;
5499     "bavail", FInt64;
5500     "files", FInt64;
5501     "ffree", FInt64;
5502     "favail", FInt64;
5503     "fsid", FInt64;
5504     "flag", FInt64;
5505     "namemax", FInt64;
5506   ];
5507
5508   (* Column names in dirent structure. *)
5509   "dirent", [
5510     "ino", FInt64;
5511     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
5512     "ftyp", FChar;
5513     "name", FString;
5514   ];
5515
5516   (* Version numbers. *)
5517   "version", [
5518     "major", FInt64;
5519     "minor", FInt64;
5520     "release", FInt64;
5521     "extra", FString;
5522   ];
5523
5524   (* Extended attribute. *)
5525   "xattr", [
5526     "attrname", FString;
5527     "attrval", FBuffer;
5528   ];
5529
5530   (* Inotify events. *)
5531   "inotify_event", [
5532     "in_wd", FInt64;
5533     "in_mask", FUInt32;
5534     "in_cookie", FUInt32;
5535     "in_name", FString;
5536   ];
5537
5538   (* Partition table entry. *)
5539   "partition", [
5540     "part_num", FInt32;
5541     "part_start", FBytes;
5542     "part_end", FBytes;
5543     "part_size", FBytes;
5544   ];
5545 ] (* end of structs *)
5546
5547 (* Ugh, Java has to be different ..
5548  * These names are also used by the Haskell bindings.
5549  *)
5550 let java_structs = [
5551   "int_bool", "IntBool";
5552   "lvm_pv", "PV";
5553   "lvm_vg", "VG";
5554   "lvm_lv", "LV";
5555   "stat", "Stat";
5556   "statvfs", "StatVFS";
5557   "dirent", "Dirent";
5558   "version", "Version";
5559   "xattr", "XAttr";
5560   "inotify_event", "INotifyEvent";
5561   "partition", "Partition";
5562 ]
5563
5564 (* What structs are actually returned. *)
5565 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
5566
5567 (* Returns a list of RStruct/RStructList structs that are returned
5568  * by any function.  Each element of returned list is a pair:
5569  *
5570  * (structname, RStructOnly)
5571  *    == there exists function which returns RStruct (_, structname)
5572  * (structname, RStructListOnly)
5573  *    == there exists function which returns RStructList (_, structname)
5574  * (structname, RStructAndList)
5575  *    == there are functions returning both RStruct (_, structname)
5576  *                                      and RStructList (_, structname)
5577  *)
5578 let rstructs_used_by functions =
5579   (* ||| is a "logical OR" for rstructs_used_t *)
5580   let (|||) a b =
5581     match a, b with
5582     | RStructAndList, _
5583     | _, RStructAndList -> RStructAndList
5584     | RStructOnly, RStructListOnly
5585     | RStructListOnly, RStructOnly -> RStructAndList
5586     | RStructOnly, RStructOnly -> RStructOnly
5587     | RStructListOnly, RStructListOnly -> RStructListOnly
5588   in
5589
5590   let h = Hashtbl.create 13 in
5591
5592   (* if elem->oldv exists, update entry using ||| operator,
5593    * else just add elem->newv to the hash
5594    *)
5595   let update elem newv =
5596     try  let oldv = Hashtbl.find h elem in
5597          Hashtbl.replace h elem (newv ||| oldv)
5598     with Not_found -> Hashtbl.add h elem newv
5599   in
5600
5601   List.iter (
5602     fun (_, style, _, _, _, _, _) ->
5603       match fst style with
5604       | RStruct (_, structname) -> update structname RStructOnly
5605       | RStructList (_, structname) -> update structname RStructListOnly
5606       | _ -> ()
5607   ) functions;
5608
5609   (* return key->values as a list of (key,value) *)
5610   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
5611
5612 (* Used for testing language bindings. *)
5613 type callt =
5614   | CallString of string
5615   | CallOptString of string option
5616   | CallStringList of string list
5617   | CallInt of int
5618   | CallInt64 of int64
5619   | CallBool of bool
5620   | CallBuffer of string
5621
5622 (* Used for the guestfish -N (prepared disk images) option.
5623  * Note that the longdescs are indented by 2 spaces.
5624  *)
5625 let prepopts = [
5626   ("disk",
5627    "create a blank disk",
5628    [ "size", "100M", "the size of the disk image" ],
5629    "  Create a blank disk, size 100MB (by default).
5630
5631   The default size can be changed by supplying an optional parameter.");
5632
5633   ("part",
5634    "create a partitioned disk",
5635    [ "size", "100M", "the size of the disk image";
5636      "partition", "mbr", "partition table type" ],
5637    "  Create a disk with a single partition.  By default the size of the disk
5638   is 100MB (the available space in the partition will be a tiny bit smaller)
5639   and the partition table will be MBR (old DOS-style).
5640
5641   These defaults can be changed by supplying optional parameters.");
5642
5643   ("fs",
5644    "create a filesystem",
5645    [ "filesystem", "ext2", "the type of filesystem to use";
5646      "size", "100M", "the size of the disk image";
5647      "partition", "mbr", "partition table type" ],
5648    "  Create a disk with a single partition, with the partition containing
5649   an empty filesystem.  This defaults to creating a 100MB disk (the available
5650   space in the filesystem will be a tiny bit smaller) with an MBR (old
5651   DOS-style) partition table and an ext2 filesystem.
5652
5653   These defaults can be changed by supplying optional parameters.");
5654
5655   ("lv",
5656    "create a disk with logical volume",
5657    [ "name", "/dev/VG/LV", "the name of the VG and LV to use";
5658      "size", "100M", "the size of the disk image";
5659      "partition", "mbr", "partition table type" ],
5660    "  Create a disk with a single partition, set up the partition as an
5661   LVM2 physical volume, and place a volume group and logical volume
5662   on there.  This defaults to creating a 100MB disk with the VG and
5663   LV called /dev/VG/LV.  You can change the name of the VG and LV
5664   by supplying an alternate name as the first optional parameter.
5665
5666   Note this does not create a filesystem.  Use 'lvfs' to do that.");
5667
5668   ("lvfs",
5669    "create a disk with logical volume and filesystem",
5670    [ "name", "/dev/VG/LV", "the name of the VG and LV to use";
5671      "filesystem", "ext2", "the type of filesystem to use";
5672      "size", "100M", "the size of the disk image";
5673      "partition", "mbr", "partition table type" ],
5674    "  Create a disk with a single partition, set up the partition as an
5675   LVM2 physical volume, and place a volume group and logical volume
5676   on there.  Then format the LV with a filesystem.  This defaults to
5677   creating a 100MB disk with the VG and LV called /dev/VG/LV, with an
5678   ext2 filesystem.");
5679
5680   ("bootroot",
5681    "create a boot and root filesystem",
5682    [ "bootfs", "ext2", "the type of filesystem to use for boot";
5683      "rootfs", "ext2", "the type of filesystem to use for root";
5684      "size", "100M", "the size of the disk image";
5685      "bootsize", "32M", "the size of the boot filesystem";
5686      "partition", "mbr", "partition table type" ],
5687    "  Create a disk with two partitions, for boot and root filesystem.
5688   Format the two filesystems independently.  There are several optional
5689   parameters which control the exact layout and filesystem types.");
5690
5691   ("bootrootlv",
5692    "create a boot and root filesystem using LVM",
5693    [ "name", "/dev/VG/LV", "the name of the VG and LV for root";
5694      "bootfs", "ext2", "the type of filesystem to use for boot";
5695      "rootfs", "ext2", "the type of filesystem to use for root";
5696      "size", "100M", "the size of the disk image";
5697      "bootsize", "32M", "the size of the boot filesystem";
5698      "partition", "mbr", "partition table type" ],
5699    "  This is the same as 'bootroot' but the root filesystem (only) is
5700   placed on a logical volume, named by default '/dev/VG/LV'.  There are
5701   several optional parameters which control the exact layout.");
5702
5703 ]
5704
5705 (* Used to memoize the result of pod2text. *)
5706 let pod2text_memo_filename = "src/.pod2text.data"
5707 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
5708   try
5709     let chan = open_in pod2text_memo_filename in
5710     let v = input_value chan in
5711     close_in chan;
5712     v
5713   with
5714     _ -> Hashtbl.create 13
5715 let pod2text_memo_updated () =
5716   let chan = open_out pod2text_memo_filename in
5717   output_value chan pod2text_memo;
5718   close_out chan
5719
5720 (* Useful functions.
5721  * Note we don't want to use any external OCaml libraries which
5722  * makes this a bit harder than it should be.
5723  *)
5724 module StringMap = Map.Make (String)
5725
5726 let failwithf fs = ksprintf failwith fs
5727
5728 let unique = let i = ref 0 in fun () -> incr i; !i
5729
5730 let replace_char s c1 c2 =
5731   let s2 = String.copy s in
5732   let r = ref false in
5733   for i = 0 to String.length s2 - 1 do
5734     if String.unsafe_get s2 i = c1 then (
5735       String.unsafe_set s2 i c2;
5736       r := true
5737     )
5738   done;
5739   if not !r then s else s2
5740
5741 let isspace c =
5742   c = ' '
5743   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
5744
5745 let triml ?(test = isspace) str =
5746   let i = ref 0 in
5747   let n = ref (String.length str) in
5748   while !n > 0 && test str.[!i]; do
5749     decr n;
5750     incr i
5751   done;
5752   if !i = 0 then str
5753   else String.sub str !i !n
5754
5755 let trimr ?(test = isspace) str =
5756   let n = ref (String.length str) in
5757   while !n > 0 && test str.[!n-1]; do
5758     decr n
5759   done;
5760   if !n = String.length str then str
5761   else String.sub str 0 !n
5762
5763 let trim ?(test = isspace) str =
5764   trimr ~test (triml ~test str)
5765
5766 let rec find s sub =
5767   let len = String.length s in
5768   let sublen = String.length sub in
5769   let rec loop i =
5770     if i <= len-sublen then (
5771       let rec loop2 j =
5772         if j < sublen then (
5773           if s.[i+j] = sub.[j] then loop2 (j+1)
5774           else -1
5775         ) else
5776           i (* found *)
5777       in
5778       let r = loop2 0 in
5779       if r = -1 then loop (i+1) else r
5780     ) else
5781       -1 (* not found *)
5782   in
5783   loop 0
5784
5785 let rec replace_str s s1 s2 =
5786   let len = String.length s in
5787   let sublen = String.length s1 in
5788   let i = find s s1 in
5789   if i = -1 then s
5790   else (
5791     let s' = String.sub s 0 i in
5792     let s'' = String.sub s (i+sublen) (len-i-sublen) in
5793     s' ^ s2 ^ replace_str s'' s1 s2
5794   )
5795
5796 let rec string_split sep str =
5797   let len = String.length str in
5798   let seplen = String.length sep in
5799   let i = find str sep in
5800   if i = -1 then [str]
5801   else (
5802     let s' = String.sub str 0 i in
5803     let s'' = String.sub str (i+seplen) (len-i-seplen) in
5804     s' :: string_split sep s''
5805   )
5806
5807 let files_equal n1 n2 =
5808   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
5809   match Sys.command cmd with
5810   | 0 -> true
5811   | 1 -> false
5812   | i -> failwithf "%s: failed with error code %d" cmd i
5813
5814 let rec filter_map f = function
5815   | [] -> []
5816   | x :: xs ->
5817       match f x with
5818       | Some y -> y :: filter_map f xs
5819       | None -> filter_map f xs
5820
5821 let rec find_map f = function
5822   | [] -> raise Not_found
5823   | x :: xs ->
5824       match f x with
5825       | Some y -> y
5826       | None -> find_map f xs
5827
5828 let iteri f xs =
5829   let rec loop i = function
5830     | [] -> ()
5831     | x :: xs -> f i x; loop (i+1) xs
5832   in
5833   loop 0 xs
5834
5835 let mapi f xs =
5836   let rec loop i = function
5837     | [] -> []
5838     | x :: xs -> let r = f i x in r :: loop (i+1) xs
5839   in
5840   loop 0 xs
5841
5842 let count_chars c str =
5843   let count = ref 0 in
5844   for i = 0 to String.length str - 1 do
5845     if c = String.unsafe_get str i then incr count
5846   done;
5847   !count
5848
5849 let explode str =
5850   let r = ref [] in
5851   for i = 0 to String.length str - 1 do
5852     let c = String.unsafe_get str i in
5853     r := c :: !r;
5854   done;
5855   List.rev !r
5856
5857 let map_chars f str =
5858   List.map f (explode str)
5859
5860 let name_of_argt = function
5861   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
5862   | StringList n | DeviceList n | Bool n | Int n | Int64 n
5863   | FileIn n | FileOut n | BufferIn n | Key n -> n
5864
5865 let java_name_of_struct typ =
5866   try List.assoc typ java_structs
5867   with Not_found ->
5868     failwithf
5869       "java_name_of_struct: no java_structs entry corresponding to %s" typ
5870
5871 let cols_of_struct typ =
5872   try List.assoc typ structs
5873   with Not_found ->
5874     failwithf "cols_of_struct: unknown struct %s" typ
5875
5876 let seq_of_test = function
5877   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
5878   | TestOutputListOfDevices (s, _)
5879   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
5880   | TestOutputTrue s | TestOutputFalse s
5881   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
5882   | TestOutputStruct (s, _)
5883   | TestLastFail s -> s
5884
5885 (* Handling for function flags. *)
5886 let progress_message =
5887   "This long-running command can generate progress notification messages
5888 so that the caller can display a progress bar or indicator.
5889 To receive these messages, the caller must register a progress
5890 callback.  See L<guestfs(3)/guestfs_set_progress_callback>."
5891
5892 let protocol_limit_warning =
5893   "Because of the message protocol, there is a transfer limit
5894 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
5895
5896 let danger_will_robinson =
5897   "B<This command is dangerous.  Without careful use you
5898 can easily destroy all your data>."
5899
5900 let deprecation_notice flags =
5901   try
5902     let alt =
5903       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
5904     let txt =
5905       sprintf "This function is deprecated.
5906 In new code, use the C<%s> call instead.
5907
5908 Deprecated functions will not be removed from the API, but the
5909 fact that they are deprecated indicates that there are problems
5910 with correct use of these functions." alt in
5911     Some txt
5912   with
5913     Not_found -> None
5914
5915 (* Create list of optional groups. *)
5916 let optgroups =
5917   let h = Hashtbl.create 13 in
5918   List.iter (
5919     fun (name, _, _, flags, _, _, _) ->
5920       List.iter (
5921         function
5922         | Optional group ->
5923             let names = try Hashtbl.find h group with Not_found -> [] in
5924             Hashtbl.replace h group (name :: names)
5925         | _ -> ()
5926       ) flags
5927   ) daemon_functions;
5928   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
5929   let groups =
5930     List.map (
5931       fun group -> group, List.sort compare (Hashtbl.find h group)
5932     ) groups in
5933   List.sort (fun x y -> compare (fst x) (fst y)) groups
5934
5935 (* Check function names etc. for consistency. *)
5936 let check_functions () =
5937   let contains_uppercase str =
5938     let len = String.length str in
5939     let rec loop i =
5940       if i >= len then false
5941       else (
5942         let c = str.[i] in
5943         if c >= 'A' && c <= 'Z' then true
5944         else loop (i+1)
5945       )
5946     in
5947     loop 0
5948   in
5949
5950   (* Check function names. *)
5951   List.iter (
5952     fun (name, _, _, _, _, _, _) ->
5953       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
5954         failwithf "function name %s does not need 'guestfs' prefix" name;
5955       if name = "" then
5956         failwithf "function name is empty";
5957       if name.[0] < 'a' || name.[0] > 'z' then
5958         failwithf "function name %s must start with lowercase a-z" name;
5959       if String.contains name '-' then
5960         failwithf "function name %s should not contain '-', use '_' instead."
5961           name
5962   ) all_functions;
5963
5964   (* Check function parameter/return names. *)
5965   List.iter (
5966     fun (name, style, _, _, _, _, _) ->
5967       let check_arg_ret_name n =
5968         if contains_uppercase n then
5969           failwithf "%s param/ret %s should not contain uppercase chars"
5970             name n;
5971         if String.contains n '-' || String.contains n '_' then
5972           failwithf "%s param/ret %s should not contain '-' or '_'"
5973             name n;
5974         if n = "value" then
5975           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;
5976         if n = "int" || n = "char" || n = "short" || n = "long" then
5977           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
5978         if n = "i" || n = "n" then
5979           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
5980         if n = "argv" || n = "args" then
5981           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
5982
5983         (* List Haskell, OCaml and C keywords here.
5984          * http://www.haskell.org/haskellwiki/Keywords
5985          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
5986          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
5987          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
5988          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
5989          * Omitting _-containing words, since they're handled above.
5990          * Omitting the OCaml reserved word, "val", is ok,
5991          * and saves us from renaming several parameters.
5992          *)
5993         let reserved = [
5994           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
5995           "char"; "class"; "const"; "constraint"; "continue"; "data";
5996           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
5997           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
5998           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
5999           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
6000           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
6001           "interface";
6002           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
6003           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
6004           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
6005           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
6006           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
6007           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
6008           "volatile"; "when"; "where"; "while";
6009           ] in
6010         if List.mem n reserved then
6011           failwithf "%s has param/ret using reserved word %s" name n;
6012       in
6013
6014       (match fst style with
6015        | RErr -> ()
6016        | RInt n | RInt64 n | RBool n
6017        | RConstString n | RConstOptString n | RString n
6018        | RStringList n | RStruct (n, _) | RStructList (n, _)
6019        | RHashtable n | RBufferOut n ->
6020            check_arg_ret_name n
6021       );
6022       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
6023   ) all_functions;
6024
6025   (* Check short descriptions. *)
6026   List.iter (
6027     fun (name, _, _, _, _, shortdesc, _) ->
6028       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
6029         failwithf "short description of %s should begin with lowercase." name;
6030       let c = shortdesc.[String.length shortdesc-1] in
6031       if c = '\n' || c = '.' then
6032         failwithf "short description of %s should not end with . or \\n." name
6033   ) all_functions;
6034
6035   (* Check long descriptions. *)
6036   List.iter (
6037     fun (name, _, _, _, _, _, longdesc) ->
6038       if longdesc.[String.length longdesc-1] = '\n' then
6039         failwithf "long description of %s should not end with \\n." name
6040   ) all_functions;
6041
6042   (* Check proc_nrs. *)
6043   List.iter (
6044     fun (name, _, proc_nr, _, _, _, _) ->
6045       if proc_nr <= 0 then
6046         failwithf "daemon function %s should have proc_nr > 0" name
6047   ) daemon_functions;
6048
6049   List.iter (
6050     fun (name, _, proc_nr, _, _, _, _) ->
6051       if proc_nr <> -1 then
6052         failwithf "non-daemon function %s should have proc_nr -1" name
6053   ) non_daemon_functions;
6054
6055   let proc_nrs =
6056     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
6057       daemon_functions in
6058   let proc_nrs =
6059     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
6060   let rec loop = function
6061     | [] -> ()
6062     | [_] -> ()
6063     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
6064         loop rest
6065     | (name1,nr1) :: (name2,nr2) :: _ ->
6066         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
6067           name1 name2 nr1 nr2
6068   in
6069   loop proc_nrs;
6070
6071   (* Check tests. *)
6072   List.iter (
6073     function
6074       (* Ignore functions that have no tests.  We generate a
6075        * warning when the user does 'make check' instead.
6076        *)
6077     | name, _, _, _, [], _, _ -> ()
6078     | name, _, _, _, tests, _, _ ->
6079         let funcs =
6080           List.map (
6081             fun (_, _, test) ->
6082               match seq_of_test test with
6083               | [] ->
6084                   failwithf "%s has a test containing an empty sequence" name
6085               | cmds -> List.map List.hd cmds
6086           ) tests in
6087         let funcs = List.flatten funcs in
6088
6089         let tested = List.mem name funcs in
6090
6091         if not tested then
6092           failwithf "function %s has tests but does not test itself" name
6093   ) all_functions
6094
6095 (* 'pr' prints to the current output file. *)
6096 let chan = ref Pervasives.stdout
6097 let lines = ref 0
6098 let pr fs =
6099   ksprintf
6100     (fun str ->
6101        let i = count_chars '\n' str in
6102        lines := !lines + i;
6103        output_string !chan str
6104     ) fs
6105
6106 let copyright_years =
6107   let this_year = 1900 + (localtime (time ())).tm_year in
6108   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
6109
6110 (* Generate a header block in a number of standard styles. *)
6111 type comment_style =
6112     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
6113 type license = GPLv2plus | LGPLv2plus
6114
6115 let generate_header ?(extra_inputs = []) comment license =
6116   let inputs = "src/generator.ml" :: extra_inputs in
6117   let c = match comment with
6118     | CStyle ->         pr "/* "; " *"
6119     | CPlusPlusStyle -> pr "// "; "//"
6120     | HashStyle ->      pr "# ";  "#"
6121     | OCamlStyle ->     pr "(* "; " *"
6122     | HaskellStyle ->   pr "{- "; "  " in
6123   pr "libguestfs generated file\n";
6124   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
6125   List.iter (pr "%s   %s\n" c) inputs;
6126   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
6127   pr "%s\n" c;
6128   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
6129   pr "%s\n" c;
6130   (match license with
6131    | GPLv2plus ->
6132        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
6133        pr "%s it under the terms of the GNU General Public License as published by\n" c;
6134        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
6135        pr "%s (at your option) any later version.\n" c;
6136        pr "%s\n" c;
6137        pr "%s This program is distributed in the hope that it will be useful,\n" c;
6138        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
6139        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
6140        pr "%s GNU General Public License for more details.\n" c;
6141        pr "%s\n" c;
6142        pr "%s You should have received a copy of the GNU General Public License along\n" c;
6143        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
6144        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
6145
6146    | LGPLv2plus ->
6147        pr "%s This library is free software; you can redistribute it and/or\n" c;
6148        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
6149        pr "%s License as published by the Free Software Foundation; either\n" c;
6150        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
6151        pr "%s\n" c;
6152        pr "%s This library is distributed in the hope that it will be useful,\n" c;
6153        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
6154        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
6155        pr "%s Lesser General Public License for more details.\n" c;
6156        pr "%s\n" c;
6157        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
6158        pr "%s License along with this library; if not, write to the Free Software\n" c;
6159        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
6160   );
6161   (match comment with
6162    | CStyle -> pr " */\n"
6163    | CPlusPlusStyle
6164    | HashStyle -> ()
6165    | OCamlStyle -> pr " *)\n"
6166    | HaskellStyle -> pr "-}\n"
6167   );
6168   pr "\n"
6169
6170 (* Start of main code generation functions below this line. *)
6171
6172 (* Generate the pod documentation for the C API. *)
6173 let rec generate_actions_pod () =
6174   List.iter (
6175     fun (shortname, style, _, flags, _, _, longdesc) ->
6176       if not (List.mem NotInDocs flags) then (
6177         let name = "guestfs_" ^ shortname in
6178         pr "=head2 %s\n\n" name;
6179         pr " ";
6180         generate_prototype ~extern:false ~handle:"g" name style;
6181         pr "\n\n";
6182         pr "%s\n\n" longdesc;
6183         (match fst style with
6184          | RErr ->
6185              pr "This function returns 0 on success or -1 on error.\n\n"
6186          | RInt _ ->
6187              pr "On error this function returns -1.\n\n"
6188          | RInt64 _ ->
6189              pr "On error this function returns -1.\n\n"
6190          | RBool _ ->
6191              pr "This function returns a C truth value on success or -1 on error.\n\n"
6192          | RConstString _ ->
6193              pr "This function returns a string, or NULL on error.
6194 The string is owned by the guest handle and must I<not> be freed.\n\n"
6195          | RConstOptString _ ->
6196              pr "This function returns a string which may be NULL.
6197 There is no way to return an error from this function.
6198 The string is owned by the guest handle and must I<not> be freed.\n\n"
6199          | RString _ ->
6200              pr "This function returns a string, or NULL on error.
6201 I<The caller must free the returned string after use>.\n\n"
6202          | RStringList _ ->
6203              pr "This function returns a NULL-terminated array of strings
6204 (like L<environ(3)>), or NULL if there was an error.
6205 I<The caller must free the strings and the array after use>.\n\n"
6206          | RStruct (_, typ) ->
6207              pr "This function returns a C<struct guestfs_%s *>,
6208 or NULL if there was an error.
6209 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
6210          | RStructList (_, typ) ->
6211              pr "This function returns a C<struct guestfs_%s_list *>
6212 (see E<lt>guestfs-structs.hE<gt>),
6213 or NULL if there was an error.
6214 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
6215          | RHashtable _ ->
6216              pr "This function returns a NULL-terminated array of
6217 strings, or NULL if there was an error.
6218 The array of strings will always have length C<2n+1>, where
6219 C<n> keys and values alternate, followed by the trailing NULL entry.
6220 I<The caller must free the strings and the array after use>.\n\n"
6221          | RBufferOut _ ->
6222              pr "This function returns a buffer, or NULL on error.
6223 The size of the returned buffer is written to C<*size_r>.
6224 I<The caller must free the returned buffer after use>.\n\n"
6225         );
6226         if List.mem Progress flags then
6227           pr "%s\n\n" progress_message;
6228         if List.mem ProtocolLimitWarning flags then
6229           pr "%s\n\n" protocol_limit_warning;
6230         if List.mem DangerWillRobinson flags then
6231           pr "%s\n\n" danger_will_robinson;
6232         if List.exists (function Key _ -> true | _ -> false) (snd style) then
6233           pr "This function takes a key or passphrase parameter which
6234 could contain sensitive material.  Read the section
6235 L</KEYS AND PASSPHRASES> for more information.\n\n";
6236         match deprecation_notice flags with
6237         | None -> ()
6238         | Some txt -> pr "%s\n\n" txt
6239       )
6240   ) all_functions_sorted
6241
6242 and generate_structs_pod () =
6243   (* Structs documentation. *)
6244   List.iter (
6245     fun (typ, cols) ->
6246       pr "=head2 guestfs_%s\n" typ;
6247       pr "\n";
6248       pr " struct guestfs_%s {\n" typ;
6249       List.iter (
6250         function
6251         | name, FChar -> pr "   char %s;\n" name
6252         | name, FUInt32 -> pr "   uint32_t %s;\n" name
6253         | name, FInt32 -> pr "   int32_t %s;\n" name
6254         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
6255         | name, FInt64 -> pr "   int64_t %s;\n" name
6256         | name, FString -> pr "   char *%s;\n" name
6257         | name, FBuffer ->
6258             pr "   /* The next two fields describe a byte array. */\n";
6259             pr "   uint32_t %s_len;\n" name;
6260             pr "   char *%s;\n" name
6261         | name, FUUID ->
6262             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
6263             pr "   char %s[32];\n" name
6264         | name, FOptPercent ->
6265             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
6266             pr "   float %s;\n" name
6267       ) cols;
6268       pr " };\n";
6269       pr " \n";
6270       pr " struct guestfs_%s_list {\n" typ;
6271       pr "   uint32_t len; /* Number of elements in list. */\n";
6272       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
6273       pr " };\n";
6274       pr " \n";
6275       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
6276       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
6277         typ typ;
6278       pr "\n"
6279   ) structs
6280
6281 and generate_availability_pod () =
6282   (* Availability documentation. *)
6283   pr "=over 4\n";
6284   pr "\n";
6285   List.iter (
6286     fun (group, functions) ->
6287       pr "=item B<%s>\n" group;
6288       pr "\n";
6289       pr "The following functions:\n";
6290       List.iter (pr "L</guestfs_%s>\n") functions;
6291       pr "\n"
6292   ) optgroups;
6293   pr "=back\n";
6294   pr "\n"
6295
6296 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
6297  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
6298  *
6299  * We have to use an underscore instead of a dash because otherwise
6300  * rpcgen generates incorrect code.
6301  *
6302  * This header is NOT exported to clients, but see also generate_structs_h.
6303  *)
6304 and generate_xdr () =
6305   generate_header CStyle LGPLv2plus;
6306
6307   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
6308   pr "typedef string guestfs_str<>;\n";
6309   pr "\n";
6310
6311   (* Internal structures. *)
6312   List.iter (
6313     function
6314     | typ, cols ->
6315         pr "struct guestfs_int_%s {\n" typ;
6316         List.iter (function
6317                    | name, FChar -> pr "  char %s;\n" name
6318                    | name, FString -> pr "  string %s<>;\n" name
6319                    | name, FBuffer -> pr "  opaque %s<>;\n" name
6320                    | name, FUUID -> pr "  opaque %s[32];\n" name
6321                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
6322                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
6323                    | name, FOptPercent -> pr "  float %s;\n" name
6324                   ) cols;
6325         pr "};\n";
6326         pr "\n";
6327         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
6328         pr "\n";
6329   ) structs;
6330
6331   List.iter (
6332     fun (shortname, style, _, _, _, _, _) ->
6333       let name = "guestfs_" ^ shortname in
6334
6335       (match snd style with
6336        | [] -> ()
6337        | args ->
6338            pr "struct %s_args {\n" name;
6339            List.iter (
6340              function
6341              | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
6342                  pr "  string %s<>;\n" n
6343              | OptString n -> pr "  guestfs_str *%s;\n" n
6344              | StringList n | DeviceList n -> pr "  guestfs_str %s<>;\n" n
6345              | Bool n -> pr "  bool %s;\n" n
6346              | Int n -> pr "  int %s;\n" n
6347              | Int64 n -> pr "  hyper %s;\n" n
6348              | BufferIn n ->
6349                  pr "  opaque %s<>;\n" n
6350              | FileIn _ | FileOut _ -> ()
6351            ) args;
6352            pr "};\n\n"
6353       );
6354       (match fst style with
6355        | RErr -> ()
6356        | RInt n ->
6357            pr "struct %s_ret {\n" name;
6358            pr "  int %s;\n" n;
6359            pr "};\n\n"
6360        | RInt64 n ->
6361            pr "struct %s_ret {\n" name;
6362            pr "  hyper %s;\n" n;
6363            pr "};\n\n"
6364        | RBool n ->
6365            pr "struct %s_ret {\n" name;
6366            pr "  bool %s;\n" n;
6367            pr "};\n\n"
6368        | RConstString _ | RConstOptString _ ->
6369            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6370        | RString n ->
6371            pr "struct %s_ret {\n" name;
6372            pr "  string %s<>;\n" n;
6373            pr "};\n\n"
6374        | RStringList n ->
6375            pr "struct %s_ret {\n" name;
6376            pr "  guestfs_str %s<>;\n" n;
6377            pr "};\n\n"
6378        | RStruct (n, typ) ->
6379            pr "struct %s_ret {\n" name;
6380            pr "  guestfs_int_%s %s;\n" typ n;
6381            pr "};\n\n"
6382        | RStructList (n, typ) ->
6383            pr "struct %s_ret {\n" name;
6384            pr "  guestfs_int_%s_list %s;\n" typ n;
6385            pr "};\n\n"
6386        | RHashtable n ->
6387            pr "struct %s_ret {\n" name;
6388            pr "  guestfs_str %s<>;\n" n;
6389            pr "};\n\n"
6390        | RBufferOut n ->
6391            pr "struct %s_ret {\n" name;
6392            pr "  opaque %s<>;\n" n;
6393            pr "};\n\n"
6394       );
6395   ) daemon_functions;
6396
6397   (* Table of procedure numbers. *)
6398   pr "enum guestfs_procedure {\n";
6399   List.iter (
6400     fun (shortname, _, proc_nr, _, _, _, _) ->
6401       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
6402   ) daemon_functions;
6403   pr "  GUESTFS_PROC_NR_PROCS\n";
6404   pr "};\n";
6405   pr "\n";
6406
6407   (* Having to choose a maximum message size is annoying for several
6408    * reasons (it limits what we can do in the API), but it (a) makes
6409    * the protocol a lot simpler, and (b) provides a bound on the size
6410    * of the daemon which operates in limited memory space.
6411    *)
6412   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
6413   pr "\n";
6414
6415   (* Message header, etc. *)
6416   pr "\
6417 /* The communication protocol is now documented in the guestfs(3)
6418  * manpage.
6419  */
6420
6421 const GUESTFS_PROGRAM = 0x2000F5F5;
6422 const GUESTFS_PROTOCOL_VERSION = 2;
6423
6424 /* These constants must be larger than any possible message length. */
6425 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
6426 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
6427 const GUESTFS_PROGRESS_FLAG = 0xffff5555;
6428
6429 enum guestfs_message_direction {
6430   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
6431   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
6432 };
6433
6434 enum guestfs_message_status {
6435   GUESTFS_STATUS_OK = 0,
6436   GUESTFS_STATUS_ERROR = 1
6437 };
6438
6439 ";
6440
6441   pr "const GUESTFS_ERROR_LEN = %d;\n" (64 * 1024);
6442   pr "\n";
6443
6444   pr "\
6445 struct guestfs_message_error {
6446   int linux_errno;                   /* Linux errno if available. */
6447   string error_message<GUESTFS_ERROR_LEN>;
6448 };
6449
6450 struct guestfs_message_header {
6451   unsigned prog;                     /* GUESTFS_PROGRAM */
6452   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
6453   guestfs_procedure proc;            /* GUESTFS_PROC_x */
6454   guestfs_message_direction direction;
6455   unsigned serial;                   /* message serial number */
6456   guestfs_message_status status;
6457 };
6458
6459 const GUESTFS_MAX_CHUNK_SIZE = 8192;
6460
6461 struct guestfs_chunk {
6462   int cancel;                        /* if non-zero, transfer is cancelled */
6463   /* data size is 0 bytes if the transfer has finished successfully */
6464   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
6465 };
6466
6467 /* Progress notifications.  Daemon self-limits these messages to
6468  * at most one per second.  The daemon can send these messages
6469  * at any time, and the caller should discard unexpected messages.
6470  * 'position' and 'total' have undefined units; however they may
6471  * have meaning for some calls.
6472  *
6473  * NB. guestfs___recv_from_daemon assumes the XDR-encoded
6474  * structure is 24 bytes long.
6475  */
6476 struct guestfs_progress {
6477   guestfs_procedure proc;            /* @0:  GUESTFS_PROC_x */
6478   unsigned serial;                   /* @4:  message serial number */
6479   unsigned hyper position;           /* @8:  0 <= position <= total */
6480   unsigned hyper total;              /* @16: total size of operation */
6481                                      /* @24: size of structure */
6482 };
6483 "
6484
6485 (* Generate the guestfs-structs.h file. *)
6486 and generate_structs_h () =
6487   generate_header CStyle LGPLv2plus;
6488
6489   (* This is a public exported header file containing various
6490    * structures.  The structures are carefully written to have
6491    * exactly the same in-memory format as the XDR structures that
6492    * we use on the wire to the daemon.  The reason for creating
6493    * copies of these structures here is just so we don't have to
6494    * export the whole of guestfs_protocol.h (which includes much
6495    * unrelated and XDR-dependent stuff that we don't want to be
6496    * public, or required by clients).
6497    *
6498    * To reiterate, we will pass these structures to and from the
6499    * client with a simple assignment or memcpy, so the format
6500    * must be identical to what rpcgen / the RFC defines.
6501    *)
6502
6503   (* Public structures. *)
6504   List.iter (
6505     fun (typ, cols) ->
6506       pr "struct guestfs_%s {\n" typ;
6507       List.iter (
6508         function
6509         | name, FChar -> pr "  char %s;\n" name
6510         | name, FString -> pr "  char *%s;\n" name
6511         | name, FBuffer ->
6512             pr "  uint32_t %s_len;\n" name;
6513             pr "  char *%s;\n" name
6514         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
6515         | name, FUInt32 -> pr "  uint32_t %s;\n" name
6516         | name, FInt32 -> pr "  int32_t %s;\n" name
6517         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
6518         | name, FInt64 -> pr "  int64_t %s;\n" name
6519         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
6520       ) cols;
6521       pr "};\n";
6522       pr "\n";
6523       pr "struct guestfs_%s_list {\n" typ;
6524       pr "  uint32_t len;\n";
6525       pr "  struct guestfs_%s *val;\n" typ;
6526       pr "};\n";
6527       pr "\n";
6528       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
6529       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
6530       pr "\n"
6531   ) structs
6532
6533 (* Generate the guestfs-actions.h file. *)
6534 and generate_actions_h () =
6535   generate_header CStyle LGPLv2plus;
6536   List.iter (
6537     fun (shortname, style, _, flags, _, _, _) ->
6538       let name = "guestfs_" ^ shortname in
6539
6540       let deprecated =
6541         List.exists (function DeprecatedBy _ -> true | _ -> false) flags in
6542       let test0 =
6543         String.length shortname >= 5 && String.sub shortname 0 5 = "test0" in
6544       let debug =
6545         String.length shortname >= 5 && String.sub shortname 0 5 = "debug" in
6546       if not deprecated && not test0 && not debug then
6547         pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
6548
6549       generate_prototype ~single_line:true ~newline:true ~handle:"g"
6550         name style
6551   ) all_functions_sorted
6552
6553 (* Generate the guestfs-internal-actions.h file. *)
6554 and generate_internal_actions_h () =
6555   generate_header CStyle LGPLv2plus;
6556   List.iter (
6557     fun (shortname, style, _, _, _, _, _) ->
6558       let name = "guestfs__" ^ shortname in
6559       generate_prototype ~single_line:true ~newline:true ~handle:"g"
6560         name style
6561   ) non_daemon_functions
6562
6563 (* Generate the client-side dispatch stubs. *)
6564 and generate_client_actions () =
6565   generate_header CStyle LGPLv2plus;
6566
6567   pr "\
6568 #include <stdio.h>
6569 #include <stdlib.h>
6570 #include <stdint.h>
6571 #include <string.h>
6572 #include <inttypes.h>
6573
6574 #include \"guestfs.h\"
6575 #include \"guestfs-internal.h\"
6576 #include \"guestfs-internal-actions.h\"
6577 #include \"guestfs_protocol.h\"
6578
6579 /* Check the return message from a call for validity. */
6580 static int
6581 check_reply_header (guestfs_h *g,
6582                     const struct guestfs_message_header *hdr,
6583                     unsigned int proc_nr, unsigned int serial)
6584 {
6585   if (hdr->prog != GUESTFS_PROGRAM) {
6586     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
6587     return -1;
6588   }
6589   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
6590     error (g, \"wrong protocol version (%%d/%%d)\",
6591            hdr->vers, GUESTFS_PROTOCOL_VERSION);
6592     return -1;
6593   }
6594   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
6595     error (g, \"unexpected message direction (%%d/%%d)\",
6596            hdr->direction, GUESTFS_DIRECTION_REPLY);
6597     return -1;
6598   }
6599   if (hdr->proc != proc_nr) {
6600     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
6601     return -1;
6602   }
6603   if (hdr->serial != serial) {
6604     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
6605     return -1;
6606   }
6607
6608   return 0;
6609 }
6610
6611 /* Check we are in the right state to run a high-level action. */
6612 static int
6613 check_state (guestfs_h *g, const char *caller)
6614 {
6615   if (!guestfs__is_ready (g)) {
6616     if (guestfs__is_config (g) || guestfs__is_launching (g))
6617       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
6618         caller);
6619     else
6620       error (g, \"%%s called from the wrong state, %%d != READY\",
6621         caller, guestfs__get_state (g));
6622     return -1;
6623   }
6624   return 0;
6625 }
6626
6627 ";
6628
6629   let error_code_of = function
6630     | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
6631     | RConstString _ | RConstOptString _
6632     | RString _ | RStringList _
6633     | RStruct _ | RStructList _
6634     | RHashtable _ | RBufferOut _ -> "NULL"
6635   in
6636
6637   (* Generate code to check String-like parameters are not passed in
6638    * as NULL (returning an error if they are).
6639    *)
6640   let check_null_strings shortname style =
6641     let pr_newline = ref false in
6642     List.iter (
6643       function
6644       (* parameters which should not be NULL *)
6645       | String n
6646       | Device n
6647       | Pathname n
6648       | Dev_or_Path n
6649       | FileIn n
6650       | FileOut n
6651       | BufferIn n
6652       | StringList n
6653       | DeviceList n
6654       | Key n ->
6655           pr "  if (%s == NULL) {\n" n;
6656           pr "    error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
6657           pr "           \"%s\", \"%s\");\n" shortname n;
6658           pr "    return %s;\n" (error_code_of (fst style));
6659           pr "  }\n";
6660           pr_newline := true
6661
6662       (* can be NULL *)
6663       | OptString _
6664
6665       (* not applicable *)
6666       | Bool _
6667       | Int _
6668       | Int64 _ -> ()
6669     ) (snd style);
6670
6671     if !pr_newline then pr "\n";
6672   in
6673
6674   (* Generate code to generate guestfish call traces. *)
6675   let trace_call shortname style =
6676     pr "  if (guestfs__get_trace (g)) {\n";
6677
6678     let needs_i =
6679       List.exists (function
6680                    | StringList _ | DeviceList _ -> true
6681                    | _ -> false) (snd style) in
6682     if needs_i then (
6683       pr "    size_t i;\n";
6684       pr "\n"
6685     );
6686
6687     pr "    fprintf (stderr, \"%s\");\n" shortname;
6688     List.iter (
6689       function
6690       | String n                        (* strings *)
6691       | Device n
6692       | Pathname n
6693       | Dev_or_Path n
6694       | FileIn n
6695       | FileOut n
6696       | BufferIn n
6697       | Key n ->
6698           (* guestfish doesn't support string escaping, so neither do we *)
6699           pr "    fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
6700       | OptString n ->                  (* string option *)
6701           pr "    if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
6702           pr "    else fprintf (stderr, \" null\");\n"
6703       | StringList n
6704       | DeviceList n ->                 (* string list *)
6705           pr "    fputc (' ', stderr);\n";
6706           pr "    fputc ('\"', stderr);\n";
6707           pr "    for (i = 0; %s[i]; ++i) {\n" n;
6708           pr "      if (i > 0) fputc (' ', stderr);\n";
6709           pr "      fputs (%s[i], stderr);\n" n;
6710           pr "    }\n";
6711           pr "    fputc ('\"', stderr);\n";
6712       | Bool n ->                       (* boolean *)
6713           pr "    fputs (%s ? \" true\" : \" false\", stderr);\n" n
6714       | Int n ->                        (* int *)
6715           pr "    fprintf (stderr, \" %%d\", %s);\n" n
6716       | Int64 n ->
6717           pr "    fprintf (stderr, \" %%\" PRIi64, %s);\n" n
6718     ) (snd style);
6719     pr "    fputc ('\\n', stderr);\n";
6720     pr "  }\n";
6721     pr "\n";
6722   in
6723
6724   (* For non-daemon functions, generate a wrapper around each function. *)
6725   List.iter (
6726     fun (shortname, style, _, _, _, _, _) ->
6727       let name = "guestfs_" ^ shortname in
6728
6729       generate_prototype ~extern:false ~semicolon:false ~newline:true
6730         ~handle:"g" name style;
6731       pr "{\n";
6732       check_null_strings shortname style;
6733       trace_call shortname style;
6734       pr "  return guestfs__%s " shortname;
6735       generate_c_call_args ~handle:"g" style;
6736       pr ";\n";
6737       pr "}\n";
6738       pr "\n"
6739   ) non_daemon_functions;
6740
6741   (* Client-side stubs for each function. *)
6742   List.iter (
6743     fun (shortname, style, _, _, _, _, _) ->
6744       let name = "guestfs_" ^ shortname in
6745       let error_code = error_code_of (fst style) in
6746
6747       (* Generate the action stub. *)
6748       generate_prototype ~extern:false ~semicolon:false ~newline:true
6749         ~handle:"g" name style;
6750
6751       pr "{\n";
6752
6753       (match snd style with
6754        | [] -> ()
6755        | _ -> pr "  struct %s_args args;\n" name
6756       );
6757
6758       pr "  guestfs_message_header hdr;\n";
6759       pr "  guestfs_message_error err;\n";
6760       let has_ret =
6761         match fst style with
6762         | RErr -> false
6763         | RConstString _ | RConstOptString _ ->
6764             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6765         | RInt _ | RInt64 _
6766         | RBool _ | RString _ | RStringList _
6767         | RStruct _ | RStructList _
6768         | RHashtable _ | RBufferOut _ ->
6769             pr "  struct %s_ret ret;\n" name;
6770             true in
6771
6772       pr "  int serial;\n";
6773       pr "  int r;\n";
6774       pr "\n";
6775       check_null_strings shortname style;
6776       trace_call shortname style;
6777       pr "  if (check_state (g, \"%s\") == -1) return %s;\n"
6778         shortname error_code;
6779       pr "  guestfs___set_busy (g);\n";
6780       pr "\n";
6781
6782       (* Send the main header and arguments. *)
6783       (match snd style with
6784        | [] ->
6785            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
6786              (String.uppercase shortname)
6787        | args ->
6788            List.iter (
6789              function
6790              | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
6791                  pr "  args.%s = (char *) %s;\n" n n
6792              | OptString n ->
6793                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
6794              | StringList n | DeviceList n ->
6795                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
6796                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
6797              | Bool n ->
6798                  pr "  args.%s = %s;\n" n n
6799              | Int n ->
6800                  pr "  args.%s = %s;\n" n n
6801              | Int64 n ->
6802                  pr "  args.%s = %s;\n" n n
6803              | FileIn _ | FileOut _ -> ()
6804              | BufferIn n ->
6805                  pr "  /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
6806                  pr "  if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
6807                  pr "    error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
6808                    shortname;
6809                  pr "    guestfs___end_busy (g);\n";
6810                  pr "    return %s;\n" error_code;
6811                  pr "  }\n";
6812                  pr "  args.%s.%s_val = (char *) %s;\n" n n n;
6813                  pr "  args.%s.%s_len = %s_size;\n" n n n
6814            ) args;
6815            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
6816              (String.uppercase shortname);
6817            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
6818              name;
6819       );
6820       pr "  if (serial == -1) {\n";
6821       pr "    guestfs___end_busy (g);\n";
6822       pr "    return %s;\n" error_code;
6823       pr "  }\n";
6824       pr "\n";
6825
6826       (* Send any additional files (FileIn) requested. *)
6827       let need_read_reply_label = ref false in
6828       List.iter (
6829         function
6830         | FileIn n ->
6831             pr "  r = guestfs___send_file (g, %s);\n" n;
6832             pr "  if (r == -1) {\n";
6833             pr "    guestfs___end_busy (g);\n";
6834             pr "    return %s;\n" error_code;
6835             pr "  }\n";
6836             pr "  if (r == -2) /* daemon cancelled */\n";
6837             pr "    goto read_reply;\n";
6838             need_read_reply_label := true;
6839             pr "\n";
6840         | _ -> ()
6841       ) (snd style);
6842
6843       (* Wait for the reply from the remote end. *)
6844       if !need_read_reply_label then pr " read_reply:\n";
6845       pr "  memset (&hdr, 0, sizeof hdr);\n";
6846       pr "  memset (&err, 0, sizeof err);\n";
6847       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
6848       pr "\n";
6849       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
6850       if not has_ret then
6851         pr "NULL, NULL"
6852       else
6853         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
6854       pr ");\n";
6855
6856       pr "  if (r == -1) {\n";
6857       pr "    guestfs___end_busy (g);\n";
6858       pr "    return %s;\n" error_code;
6859       pr "  }\n";
6860       pr "\n";
6861
6862       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
6863         (String.uppercase shortname);
6864       pr "    guestfs___end_busy (g);\n";
6865       pr "    return %s;\n" error_code;
6866       pr "  }\n";
6867       pr "\n";
6868
6869       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
6870       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
6871       pr "    free (err.error_message);\n";
6872       pr "    guestfs___end_busy (g);\n";
6873       pr "    return %s;\n" error_code;
6874       pr "  }\n";
6875       pr "\n";
6876
6877       (* Expecting to receive further files (FileOut)? *)
6878       List.iter (
6879         function
6880         | FileOut n ->
6881             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
6882             pr "    guestfs___end_busy (g);\n";
6883             pr "    return %s;\n" error_code;
6884             pr "  }\n";
6885             pr "\n";
6886         | _ -> ()
6887       ) (snd style);
6888
6889       pr "  guestfs___end_busy (g);\n";
6890
6891       (match fst style with
6892        | RErr -> pr "  return 0;\n"
6893        | RInt n | RInt64 n | RBool n ->
6894            pr "  return ret.%s;\n" n
6895        | RConstString _ | RConstOptString _ ->
6896            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6897        | RString n ->
6898            pr "  return ret.%s; /* caller will free */\n" n
6899        | RStringList n | RHashtable n ->
6900            pr "  /* caller will free this, but we need to add a NULL entry */\n";
6901            pr "  ret.%s.%s_val =\n" n n;
6902            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
6903            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
6904              n n;
6905            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
6906            pr "  return ret.%s.%s_val;\n" n n
6907        | RStruct (n, _) ->
6908            pr "  /* caller will free this */\n";
6909            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
6910        | RStructList (n, _) ->
6911            pr "  /* caller will free this */\n";
6912            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
6913        | RBufferOut n ->
6914            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
6915            pr "   * _val might be NULL here.  To make the API saner for\n";
6916            pr "   * callers, we turn this case into a unique pointer (using\n";
6917            pr "   * malloc(1)).\n";
6918            pr "   */\n";
6919            pr "  if (ret.%s.%s_len > 0) {\n" n n;
6920            pr "    *size_r = ret.%s.%s_len;\n" n n;
6921            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
6922            pr "  } else {\n";
6923            pr "    free (ret.%s.%s_val);\n" n n;
6924            pr "    char *p = safe_malloc (g, 1);\n";
6925            pr "    *size_r = ret.%s.%s_len;\n" n n;
6926            pr "    return p;\n";
6927            pr "  }\n";
6928       );
6929
6930       pr "}\n\n"
6931   ) daemon_functions;
6932
6933   (* Functions to free structures. *)
6934   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
6935   pr " * structure format is identical to the XDR format.  See note in\n";
6936   pr " * generator.ml.\n";
6937   pr " */\n";
6938   pr "\n";
6939
6940   List.iter (
6941     fun (typ, _) ->
6942       pr "void\n";
6943       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
6944       pr "{\n";
6945       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
6946       pr "  free (x);\n";
6947       pr "}\n";
6948       pr "\n";
6949
6950       pr "void\n";
6951       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
6952       pr "{\n";
6953       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
6954       pr "  free (x);\n";
6955       pr "}\n";
6956       pr "\n";
6957
6958   ) structs;
6959
6960 (* Generate daemon/actions.h. *)
6961 and generate_daemon_actions_h () =
6962   generate_header CStyle GPLv2plus;
6963
6964   pr "#include \"../src/guestfs_protocol.h\"\n";
6965   pr "\n";
6966
6967   List.iter (
6968     fun (name, style, _, _, _, _, _) ->
6969       generate_prototype
6970         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
6971         name style;
6972   ) daemon_functions
6973
6974 (* Generate the linker script which controls the visibility of
6975  * symbols in the public ABI and ensures no other symbols get
6976  * exported accidentally.
6977  *)
6978 and generate_linker_script () =
6979   generate_header HashStyle GPLv2plus;
6980
6981   let globals = [
6982     "guestfs_create";
6983     "guestfs_close";
6984     "guestfs_get_error_handler";
6985     "guestfs_get_out_of_memory_handler";
6986     "guestfs_get_private";
6987     "guestfs_last_error";
6988     "guestfs_set_close_callback";
6989     "guestfs_set_error_handler";
6990     "guestfs_set_launch_done_callback";
6991     "guestfs_set_log_message_callback";
6992     "guestfs_set_out_of_memory_handler";
6993     "guestfs_set_private";
6994     "guestfs_set_progress_callback";
6995     "guestfs_set_subprocess_quit_callback";
6996
6997     (* Unofficial parts of the API: the bindings code use these
6998      * functions, so it is useful to export them.
6999      *)
7000     "guestfs_safe_calloc";
7001     "guestfs_safe_malloc";
7002     "guestfs_safe_strdup";
7003     "guestfs_safe_memdup";
7004   ] in
7005   let functions =
7006     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
7007       all_functions in
7008   let structs =
7009     List.concat (
7010       List.map (fun (typ, _) ->
7011                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
7012         structs
7013     ) in
7014   let globals = List.sort compare (globals @ functions @ structs) in
7015
7016   pr "{\n";
7017   pr "    global:\n";
7018   List.iter (pr "        %s;\n") globals;
7019   pr "\n";
7020
7021   pr "    local:\n";
7022   pr "        *;\n";
7023   pr "};\n"
7024
7025 (* Generate the server-side stubs. *)
7026 and generate_daemon_actions () =
7027   generate_header CStyle GPLv2plus;
7028
7029   pr "#include <config.h>\n";
7030   pr "\n";
7031   pr "#include <stdio.h>\n";
7032   pr "#include <stdlib.h>\n";
7033   pr "#include <string.h>\n";
7034   pr "#include <inttypes.h>\n";
7035   pr "#include <rpc/types.h>\n";
7036   pr "#include <rpc/xdr.h>\n";
7037   pr "\n";
7038   pr "#include \"daemon.h\"\n";
7039   pr "#include \"c-ctype.h\"\n";
7040   pr "#include \"../src/guestfs_protocol.h\"\n";
7041   pr "#include \"actions.h\"\n";
7042   pr "\n";
7043
7044   List.iter (
7045     fun (name, style, _, _, _, _, _) ->
7046       (* Generate server-side stubs. *)
7047       pr "static void %s_stub (XDR *xdr_in)\n" name;
7048       pr "{\n";
7049       let error_code =
7050         match fst style with
7051         | RErr | RInt _ -> pr "  int r;\n"; "-1"
7052         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
7053         | RBool _ -> pr "  int r;\n"; "-1"
7054         | RConstString _ | RConstOptString _ ->
7055             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
7056         | RString _ -> pr "  char *r;\n"; "NULL"
7057         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
7058         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
7059         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
7060         | RBufferOut _ ->
7061             pr "  size_t size = 1;\n";
7062             pr "  char *r;\n";
7063             "NULL" in
7064
7065       (match snd style with
7066        | [] -> ()
7067        | args ->
7068            pr "  struct guestfs_%s_args args;\n" name;
7069            List.iter (
7070              function
7071              | Device n | Dev_or_Path n
7072              | Pathname n
7073              | String n
7074              | Key n -> ()
7075              | OptString n -> pr "  char *%s;\n" n
7076              | StringList n | DeviceList n -> pr "  char **%s;\n" n
7077              | Bool n -> pr "  int %s;\n" n
7078              | Int n -> pr "  int %s;\n" n
7079              | Int64 n -> pr "  int64_t %s;\n" n
7080              | FileIn _ | FileOut _ -> ()
7081              | BufferIn n ->
7082                  pr "  const char *%s;\n" n;
7083                  pr "  size_t %s_size;\n" n
7084            ) args
7085       );
7086       pr "\n";
7087
7088       let is_filein =
7089         List.exists (function FileIn _ -> true | _ -> false) (snd style) in
7090
7091       (match snd style with
7092        | [] -> ()
7093        | args ->
7094            pr "  memset (&args, 0, sizeof args);\n";
7095            pr "\n";
7096            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
7097            if is_filein then
7098              pr "    if (cancel_receive () != -2)\n";
7099            pr "      reply_with_error (\"daemon failed to decode procedure arguments\");\n";
7100            pr "    goto done;\n";
7101            pr "  }\n";
7102            let pr_args n =
7103              pr "  char *%s = args.%s;\n" n n
7104            in
7105            let pr_list_handling_code n =
7106              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
7107              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
7108              pr "  if (%s == NULL) {\n" n;
7109              if is_filein then
7110                pr "    if (cancel_receive () != -2)\n";
7111              pr "      reply_with_perror (\"realloc\");\n";
7112              pr "    goto done;\n";
7113              pr "  }\n";
7114              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
7115              pr "  args.%s.%s_val = %s;\n" n n n;
7116            in
7117            List.iter (
7118              function
7119              | Pathname n ->
7120                  pr_args n;
7121                  pr "  ABS_PATH (%s, %s, goto done);\n"
7122                    n (if is_filein then "cancel_receive ()" else "0");
7123              | Device n ->
7124                  pr_args n;
7125                  pr "  RESOLVE_DEVICE (%s, %s, goto done);\n"
7126                    n (if is_filein then "cancel_receive ()" else "0");
7127              | Dev_or_Path n ->
7128                  pr_args n;
7129                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, %s, goto done);\n"
7130                    n (if is_filein then "cancel_receive ()" else "0");
7131              | String n | Key n -> pr_args n
7132              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
7133              | StringList n ->
7134                  pr_list_handling_code n;
7135              | DeviceList n ->
7136                  pr_list_handling_code n;
7137                  pr "  /* Ensure that each is a device,\n";
7138                  pr "   * and perform device name translation.\n";
7139                  pr "   */\n";
7140                  pr "  {\n";
7141                  pr "    size_t i;\n";
7142                  pr "    for (i = 0; %s[i] != NULL; ++i)\n" n;
7143                  pr "      RESOLVE_DEVICE (%s[i], %s, goto done);\n" n
7144                    (if is_filein then "cancel_receive ()" else "0");
7145                  pr "  }\n";
7146              | Bool n -> pr "  %s = args.%s;\n" n n
7147              | Int n -> pr "  %s = args.%s;\n" n n
7148              | Int64 n -> pr "  %s = args.%s;\n" n n
7149              | FileIn _ | FileOut _ -> ()
7150              | BufferIn n ->
7151                  pr "  %s = args.%s.%s_val;\n" n n n;
7152                  pr "  %s_size = args.%s.%s_len;\n" n n n
7153            ) args;
7154            pr "\n"
7155       );
7156
7157       (* this is used at least for do_equal *)
7158       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
7159         (* Emit NEED_ROOT just once, even when there are two or
7160            more Pathname args *)
7161         pr "  NEED_ROOT (%s, goto done);\n"
7162           (if is_filein then "cancel_receive ()" else "0");
7163       );
7164
7165       (* Don't want to call the impl with any FileIn or FileOut
7166        * parameters, since these go "outside" the RPC protocol.
7167        *)
7168       let args' =
7169         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
7170           (snd style) in
7171       pr "  r = do_%s " name;
7172       generate_c_call_args (fst style, args');
7173       pr ";\n";
7174
7175       (match fst style with
7176        | RErr | RInt _ | RInt64 _ | RBool _
7177        | RConstString _ | RConstOptString _
7178        | RString _ | RStringList _ | RHashtable _
7179        | RStruct (_, _) | RStructList (_, _) ->
7180            pr "  if (r == %s)\n" error_code;
7181            pr "    /* do_%s has already called reply_with_error */\n" name;
7182            pr "    goto done;\n";
7183            pr "\n"
7184        | RBufferOut _ ->
7185            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
7186            pr "   * an ordinary zero-length buffer), so be careful ...\n";
7187            pr "   */\n";
7188            pr "  if (size == 1 && r == %s)\n" error_code;
7189            pr "    /* do_%s has already called reply_with_error */\n" name;
7190            pr "    goto done;\n";
7191            pr "\n"
7192       );
7193
7194       (* If there are any FileOut parameters, then the impl must
7195        * send its own reply.
7196        *)
7197       let no_reply =
7198         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
7199       if no_reply then
7200         pr "  /* do_%s has already sent a reply */\n" name
7201       else (
7202         match fst style with
7203         | RErr -> pr "  reply (NULL, NULL);\n"
7204         | RInt n | RInt64 n | RBool n ->
7205             pr "  struct guestfs_%s_ret ret;\n" name;
7206             pr "  ret.%s = r;\n" n;
7207             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
7208               name
7209         | RConstString _ | RConstOptString _ ->
7210             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
7211         | RString n ->
7212             pr "  struct guestfs_%s_ret ret;\n" name;
7213             pr "  ret.%s = r;\n" n;
7214             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
7215               name;
7216             pr "  free (r);\n"
7217         | RStringList n | RHashtable n ->
7218             pr "  struct guestfs_%s_ret ret;\n" name;
7219             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
7220             pr "  ret.%s.%s_val = r;\n" n n;
7221             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
7222               name;
7223             pr "  free_strings (r);\n"
7224         | RStruct (n, _) ->
7225             pr "  struct guestfs_%s_ret ret;\n" name;
7226             pr "  ret.%s = *r;\n" n;
7227             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
7228               name;
7229             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
7230               name
7231         | RStructList (n, _) ->
7232             pr "  struct guestfs_%s_ret ret;\n" name;
7233             pr "  ret.%s = *r;\n" n;
7234             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
7235               name;
7236             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
7237               name
7238         | RBufferOut n ->
7239             pr "  struct guestfs_%s_ret ret;\n" name;
7240             pr "  ret.%s.%s_val = r;\n" n n;
7241             pr "  ret.%s.%s_len = size;\n" n n;
7242             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
7243               name;
7244             pr "  free (r);\n"
7245       );
7246
7247       (* Free the args. *)
7248       pr "done:\n";
7249       (match snd style with
7250        | [] -> ()
7251        | _ ->
7252            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
7253              name
7254       );
7255       pr "  return;\n";
7256       pr "}\n\n";
7257   ) daemon_functions;
7258
7259   (* Dispatch function. *)
7260   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
7261   pr "{\n";
7262   pr "  switch (proc_nr) {\n";
7263
7264   List.iter (
7265     fun (name, style, _, _, _, _, _) ->
7266       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
7267       pr "      %s_stub (xdr_in);\n" name;
7268       pr "      break;\n"
7269   ) daemon_functions;
7270
7271   pr "    default:\n";
7272   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";
7273   pr "  }\n";
7274   pr "}\n";
7275   pr "\n";
7276
7277   (* LVM columns and tokenization functions. *)
7278   (* XXX This generates crap code.  We should rethink how we
7279    * do this parsing.
7280    *)
7281   List.iter (
7282     function
7283     | typ, cols ->
7284         pr "static const char *lvm_%s_cols = \"%s\";\n"
7285           typ (String.concat "," (List.map fst cols));
7286         pr "\n";
7287
7288         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
7289         pr "{\n";
7290         pr "  char *tok, *p, *next;\n";
7291         pr "  size_t i, j;\n";
7292         pr "\n";
7293         (*
7294           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
7295           pr "\n";
7296         *)
7297         pr "  if (!str) {\n";
7298         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
7299         pr "    return -1;\n";
7300         pr "  }\n";
7301         pr "  if (!*str || c_isspace (*str)) {\n";
7302         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
7303         pr "    return -1;\n";
7304         pr "  }\n";
7305         pr "  tok = str;\n";
7306         List.iter (
7307           fun (name, coltype) ->
7308             pr "  if (!tok) {\n";
7309             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
7310             pr "    return -1;\n";
7311             pr "  }\n";
7312             pr "  p = strchrnul (tok, ',');\n";
7313             pr "  if (*p) next = p+1; else next = NULL;\n";
7314             pr "  *p = '\\0';\n";
7315             (match coltype with
7316              | FString ->
7317                  pr "  r->%s = strdup (tok);\n" name;
7318                  pr "  if (r->%s == NULL) {\n" name;
7319                  pr "    perror (\"strdup\");\n";
7320                  pr "    return -1;\n";
7321                  pr "  }\n"
7322              | FUUID ->
7323                  pr "  for (i = j = 0; i < 32; ++j) {\n";
7324                  pr "    if (tok[j] == '\\0') {\n";
7325                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
7326                  pr "      return -1;\n";
7327                  pr "    } else if (tok[j] != '-')\n";
7328                  pr "      r->%s[i++] = tok[j];\n" name;
7329                  pr "  }\n";
7330              | FBytes ->
7331                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
7332                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
7333                  pr "    return -1;\n";
7334                  pr "  }\n";
7335              | FInt64 ->
7336                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
7337                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
7338                  pr "    return -1;\n";
7339                  pr "  }\n";
7340              | FOptPercent ->
7341                  pr "  if (tok[0] == '\\0')\n";
7342                  pr "    r->%s = -1;\n" name;
7343                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
7344                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
7345                  pr "    return -1;\n";
7346                  pr "  }\n";
7347              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
7348                  assert false (* can never be an LVM column *)
7349             );
7350             pr "  tok = next;\n";
7351         ) cols;
7352
7353         pr "  if (tok != NULL) {\n";
7354         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
7355         pr "    return -1;\n";
7356         pr "  }\n";
7357         pr "  return 0;\n";
7358         pr "}\n";
7359         pr "\n";
7360
7361         pr "guestfs_int_lvm_%s_list *\n" typ;
7362         pr "parse_command_line_%ss (void)\n" typ;
7363         pr "{\n";
7364         pr "  char *out, *err;\n";
7365         pr "  char *p, *pend;\n";
7366         pr "  int r, i;\n";
7367         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
7368         pr "  void *newp;\n";
7369         pr "\n";
7370         pr "  ret = malloc (sizeof *ret);\n";
7371         pr "  if (!ret) {\n";
7372         pr "    reply_with_perror (\"malloc\");\n";
7373         pr "    return NULL;\n";
7374         pr "  }\n";
7375         pr "\n";
7376         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
7377         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
7378         pr "\n";
7379         pr "  r = command (&out, &err,\n";
7380         pr "           \"lvm\", \"%ss\",\n" typ;
7381         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
7382         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
7383         pr "  if (r == -1) {\n";
7384         pr "    reply_with_error (\"%%s\", err);\n";
7385         pr "    free (out);\n";
7386         pr "    free (err);\n";
7387         pr "    free (ret);\n";
7388         pr "    return NULL;\n";
7389         pr "  }\n";
7390         pr "\n";
7391         pr "  free (err);\n";
7392         pr "\n";
7393         pr "  /* Tokenize each line of the output. */\n";
7394         pr "  p = out;\n";
7395         pr "  i = 0;\n";
7396         pr "  while (p) {\n";
7397         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
7398         pr "    if (pend) {\n";
7399         pr "      *pend = '\\0';\n";
7400         pr "      pend++;\n";
7401         pr "    }\n";
7402         pr "\n";
7403         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
7404         pr "      p++;\n";
7405         pr "\n";
7406         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
7407         pr "      p = pend;\n";
7408         pr "      continue;\n";
7409         pr "    }\n";
7410         pr "\n";
7411         pr "    /* Allocate some space to store this next entry. */\n";
7412         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
7413         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
7414         pr "    if (newp == NULL) {\n";
7415         pr "      reply_with_perror (\"realloc\");\n";
7416         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
7417         pr "      free (ret);\n";
7418         pr "      free (out);\n";
7419         pr "      return NULL;\n";
7420         pr "    }\n";
7421         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
7422         pr "\n";
7423         pr "    /* Tokenize the next entry. */\n";
7424         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
7425         pr "    if (r == -1) {\n";
7426         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
7427         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
7428         pr "      free (ret);\n";
7429         pr "      free (out);\n";
7430         pr "      return NULL;\n";
7431         pr "    }\n";
7432         pr "\n";
7433         pr "    ++i;\n";
7434         pr "    p = pend;\n";
7435         pr "  }\n";
7436         pr "\n";
7437         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
7438         pr "\n";
7439         pr "  free (out);\n";
7440         pr "  return ret;\n";
7441         pr "}\n"
7442
7443   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
7444
7445 (* Generate a list of function names, for debugging in the daemon.. *)
7446 and generate_daemon_names () =
7447   generate_header CStyle GPLv2plus;
7448
7449   pr "#include <config.h>\n";
7450   pr "\n";
7451   pr "#include \"daemon.h\"\n";
7452   pr "\n";
7453
7454   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
7455   pr "const char *function_names[] = {\n";
7456   List.iter (
7457     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
7458   ) daemon_functions;
7459   pr "};\n";
7460
7461 (* Generate the optional groups for the daemon to implement
7462  * guestfs_available.
7463  *)
7464 and generate_daemon_optgroups_c () =
7465   generate_header CStyle GPLv2plus;
7466
7467   pr "#include <config.h>\n";
7468   pr "\n";
7469   pr "#include \"daemon.h\"\n";
7470   pr "#include \"optgroups.h\"\n";
7471   pr "\n";
7472
7473   pr "struct optgroup optgroups[] = {\n";
7474   List.iter (
7475     fun (group, _) ->
7476       pr "  { \"%s\", optgroup_%s_available },\n" group group
7477   ) optgroups;
7478   pr "  { NULL, NULL }\n";
7479   pr "};\n"
7480
7481 and generate_daemon_optgroups_h () =
7482   generate_header CStyle GPLv2plus;
7483
7484   List.iter (
7485     fun (group, _) ->
7486       pr "extern int optgroup_%s_available (void);\n" group
7487   ) optgroups
7488
7489 (* Generate the tests. *)
7490 and generate_tests () =
7491   generate_header CStyle GPLv2plus;
7492
7493   pr "\
7494 #include <stdio.h>
7495 #include <stdlib.h>
7496 #include <string.h>
7497 #include <unistd.h>
7498 #include <sys/types.h>
7499 #include <fcntl.h>
7500
7501 #include \"guestfs.h\"
7502 #include \"guestfs-internal.h\"
7503
7504 static guestfs_h *g;
7505 static int suppress_error = 0;
7506
7507 static void print_error (guestfs_h *g, void *data, const char *msg)
7508 {
7509   if (!suppress_error)
7510     fprintf (stderr, \"%%s\\n\", msg);
7511 }
7512
7513 /* FIXME: nearly identical code appears in fish.c */
7514 static void print_strings (char *const *argv)
7515 {
7516   size_t argc;
7517
7518   for (argc = 0; argv[argc] != NULL; ++argc)
7519     printf (\"\\t%%s\\n\", argv[argc]);
7520 }
7521
7522 /*
7523 static void print_table (char const *const *argv)
7524 {
7525   size_t i;
7526
7527   for (i = 0; argv[i] != NULL; i += 2)
7528     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
7529 }
7530 */
7531
7532 static int
7533 is_available (const char *group)
7534 {
7535   const char *groups[] = { group, NULL };
7536   int r;
7537
7538   suppress_error = 1;
7539   r = guestfs_available (g, (char **) groups);
7540   suppress_error = 0;
7541
7542   return r == 0;
7543 }
7544
7545 static void
7546 incr (guestfs_h *g, void *iv)
7547 {
7548   int *i = (int *) iv;
7549   (*i)++;
7550 }
7551
7552 ";
7553
7554   (* Generate a list of commands which are not tested anywhere. *)
7555   pr "static void no_test_warnings (void)\n";
7556   pr "{\n";
7557
7558   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
7559   List.iter (
7560     fun (_, _, _, _, tests, _, _) ->
7561       let tests = filter_map (
7562         function
7563         | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
7564         | (_, Disabled, _) -> None
7565       ) tests in
7566       let seq = List.concat (List.map seq_of_test tests) in
7567       let cmds_tested = List.map List.hd seq in
7568       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
7569   ) all_functions;
7570
7571   List.iter (
7572     fun (name, _, _, _, _, _, _) ->
7573       if not (Hashtbl.mem hash name) then
7574         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
7575   ) all_functions;
7576
7577   pr "}\n";
7578   pr "\n";
7579
7580   (* Generate the actual tests.  Note that we generate the tests
7581    * in reverse order, deliberately, so that (in general) the
7582    * newest tests run first.  This makes it quicker and easier to
7583    * debug them.
7584    *)
7585   let test_names =
7586     List.map (
7587       fun (name, _, _, flags, tests, _, _) ->
7588         mapi (generate_one_test name flags) tests
7589     ) (List.rev all_functions) in
7590   let test_names = List.concat test_names in
7591   let nr_tests = List.length test_names in
7592
7593   pr "\
7594 int main (int argc, char *argv[])
7595 {
7596   char c = 0;
7597   unsigned long int n_failed = 0;
7598   const char *filename;
7599   int fd;
7600   int nr_tests, test_num = 0;
7601
7602   setbuf (stdout, NULL);
7603
7604   no_test_warnings ();
7605
7606   g = guestfs_create ();
7607   if (g == NULL) {
7608     printf (\"guestfs_create FAILED\\n\");
7609     exit (EXIT_FAILURE);
7610   }
7611
7612   guestfs_set_error_handler (g, print_error, NULL);
7613
7614   guestfs_set_path (g, \"../appliance\");
7615
7616   filename = \"test1.img\";
7617   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
7618   if (fd == -1) {
7619     perror (filename);
7620     exit (EXIT_FAILURE);
7621   }
7622   if (lseek (fd, %d, SEEK_SET) == -1) {
7623     perror (\"lseek\");
7624     close (fd);
7625     unlink (filename);
7626     exit (EXIT_FAILURE);
7627   }
7628   if (write (fd, &c, 1) == -1) {
7629     perror (\"write\");
7630     close (fd);
7631     unlink (filename);
7632     exit (EXIT_FAILURE);
7633   }
7634   if (close (fd) == -1) {
7635     perror (filename);
7636     unlink (filename);
7637     exit (EXIT_FAILURE);
7638   }
7639   if (guestfs_add_drive (g, filename) == -1) {
7640     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
7641     exit (EXIT_FAILURE);
7642   }
7643
7644   filename = \"test2.img\";
7645   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
7646   if (fd == -1) {
7647     perror (filename);
7648     exit (EXIT_FAILURE);
7649   }
7650   if (lseek (fd, %d, SEEK_SET) == -1) {
7651     perror (\"lseek\");
7652     close (fd);
7653     unlink (filename);
7654     exit (EXIT_FAILURE);
7655   }
7656   if (write (fd, &c, 1) == -1) {
7657     perror (\"write\");
7658     close (fd);
7659     unlink (filename);
7660     exit (EXIT_FAILURE);
7661   }
7662   if (close (fd) == -1) {
7663     perror (filename);
7664     unlink (filename);
7665     exit (EXIT_FAILURE);
7666   }
7667   if (guestfs_add_drive (g, filename) == -1) {
7668     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
7669     exit (EXIT_FAILURE);
7670   }
7671
7672   filename = \"test3.img\";
7673   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
7674   if (fd == -1) {
7675     perror (filename);
7676     exit (EXIT_FAILURE);
7677   }
7678   if (lseek (fd, %d, SEEK_SET) == -1) {
7679     perror (\"lseek\");
7680     close (fd);
7681     unlink (filename);
7682     exit (EXIT_FAILURE);
7683   }
7684   if (write (fd, &c, 1) == -1) {
7685     perror (\"write\");
7686     close (fd);
7687     unlink (filename);
7688     exit (EXIT_FAILURE);
7689   }
7690   if (close (fd) == -1) {
7691     perror (filename);
7692     unlink (filename);
7693     exit (EXIT_FAILURE);
7694   }
7695   if (guestfs_add_drive (g, filename) == -1) {
7696     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
7697     exit (EXIT_FAILURE);
7698   }
7699
7700   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
7701     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
7702     exit (EXIT_FAILURE);
7703   }
7704
7705   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
7706   alarm (600);
7707
7708   if (guestfs_launch (g) == -1) {
7709     printf (\"guestfs_launch FAILED\\n\");
7710     exit (EXIT_FAILURE);
7711   }
7712
7713   /* Cancel previous alarm. */
7714   alarm (0);
7715
7716   nr_tests = %d;
7717
7718 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
7719
7720   iteri (
7721     fun i test_name ->
7722       pr "  test_num++;\n";
7723       pr "  if (guestfs_get_verbose (g))\n";
7724       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
7725       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
7726       pr "  if (%s () == -1) {\n" test_name;
7727       pr "    printf (\"%s FAILED\\n\");\n" test_name;
7728       pr "    n_failed++;\n";
7729       pr "  }\n";
7730   ) test_names;
7731   pr "\n";
7732
7733   pr "  /* Check close callback is called. */
7734   int close_sentinel = 1;
7735   guestfs_set_close_callback (g, incr, &close_sentinel);
7736
7737   guestfs_close (g);
7738
7739   if (close_sentinel != 2) {
7740     fprintf (stderr, \"close callback was not called\\n\");
7741     exit (EXIT_FAILURE);
7742   }
7743
7744   unlink (\"test1.img\");
7745   unlink (\"test2.img\");
7746   unlink (\"test3.img\");
7747
7748 ";
7749
7750   pr "  if (n_failed > 0) {\n";
7751   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
7752   pr "    exit (EXIT_FAILURE);\n";
7753   pr "  }\n";
7754   pr "\n";
7755
7756   pr "  exit (EXIT_SUCCESS);\n";
7757   pr "}\n"
7758
7759 and generate_one_test name flags i (init, prereq, test) =
7760   let test_name = sprintf "test_%s_%d" name i in
7761
7762   pr "\
7763 static int %s_skip (void)
7764 {
7765   const char *str;
7766
7767   str = getenv (\"TEST_ONLY\");
7768   if (str)
7769     return strstr (str, \"%s\") == NULL;
7770   str = getenv (\"SKIP_%s\");
7771   if (str && STREQ (str, \"1\")) return 1;
7772   str = getenv (\"SKIP_TEST_%s\");
7773   if (str && STREQ (str, \"1\")) return 1;
7774   return 0;
7775 }
7776
7777 " test_name name (String.uppercase test_name) (String.uppercase name);
7778
7779   (match prereq with
7780    | Disabled | Always | IfAvailable _ -> ()
7781    | If code | Unless code ->
7782        pr "static int %s_prereq (void)\n" test_name;
7783        pr "{\n";
7784        pr "  %s\n" code;
7785        pr "}\n";
7786        pr "\n";
7787   );
7788
7789   pr "\
7790 static int %s (void)
7791 {
7792   if (%s_skip ()) {
7793     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
7794     return 0;
7795   }
7796
7797 " test_name test_name test_name;
7798
7799   (* Optional functions should only be tested if the relevant
7800    * support is available in the daemon.
7801    *)
7802   List.iter (
7803     function
7804     | Optional group ->
7805         pr "  if (!is_available (\"%s\")) {\n" group;
7806         pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
7807         pr "    return 0;\n";
7808         pr "  }\n";
7809     | _ -> ()
7810   ) flags;
7811
7812   (match prereq with
7813    | Disabled ->
7814        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
7815    | If _ ->
7816        pr "  if (! %s_prereq ()) {\n" test_name;
7817        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
7818        pr "    return 0;\n";
7819        pr "  }\n";
7820        pr "\n";
7821        generate_one_test_body name i test_name init test;
7822    | Unless _ ->
7823        pr "  if (%s_prereq ()) {\n" test_name;
7824        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
7825        pr "    return 0;\n";
7826        pr "  }\n";
7827        pr "\n";
7828        generate_one_test_body name i test_name init test;
7829    | IfAvailable group ->
7830        pr "  if (!is_available (\"%s\")) {\n" group;
7831        pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
7832        pr "    return 0;\n";
7833        pr "  }\n";
7834        pr "\n";
7835        generate_one_test_body name i test_name init test;
7836    | Always ->
7837        generate_one_test_body name i test_name init test
7838   );
7839
7840   pr "  return 0;\n";
7841   pr "}\n";
7842   pr "\n";
7843   test_name
7844
7845 and generate_one_test_body name i test_name init test =
7846   (match init with
7847    | InitNone (* XXX at some point, InitNone and InitEmpty became
7848                * folded together as the same thing.  Really we should
7849                * make InitNone do nothing at all, but the tests may
7850                * need to be checked to make sure this is OK.
7851                *)
7852    | InitEmpty ->
7853        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
7854        List.iter (generate_test_command_call test_name)
7855          [["blockdev_setrw"; "/dev/sda"];
7856           ["umount_all"];
7857           ["lvm_remove_all"]]
7858    | InitPartition ->
7859        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
7860        List.iter (generate_test_command_call test_name)
7861          [["blockdev_setrw"; "/dev/sda"];
7862           ["umount_all"];
7863           ["lvm_remove_all"];
7864           ["part_disk"; "/dev/sda"; "mbr"]]
7865    | InitBasicFS ->
7866        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
7867        List.iter (generate_test_command_call test_name)
7868          [["blockdev_setrw"; "/dev/sda"];
7869           ["umount_all"];
7870           ["lvm_remove_all"];
7871           ["part_disk"; "/dev/sda"; "mbr"];
7872           ["mkfs"; "ext2"; "/dev/sda1"];
7873           ["mount_options"; ""; "/dev/sda1"; "/"]]
7874    | InitBasicFSonLVM ->
7875        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
7876          test_name;
7877        List.iter (generate_test_command_call test_name)
7878          [["blockdev_setrw"; "/dev/sda"];
7879           ["umount_all"];
7880           ["lvm_remove_all"];
7881           ["part_disk"; "/dev/sda"; "mbr"];
7882           ["pvcreate"; "/dev/sda1"];
7883           ["vgcreate"; "VG"; "/dev/sda1"];
7884           ["lvcreate"; "LV"; "VG"; "8"];
7885           ["mkfs"; "ext2"; "/dev/VG/LV"];
7886           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
7887    | InitISOFS ->
7888        pr "  /* InitISOFS for %s */\n" test_name;
7889        List.iter (generate_test_command_call test_name)
7890          [["blockdev_setrw"; "/dev/sda"];
7891           ["umount_all"];
7892           ["lvm_remove_all"];
7893           ["mount_ro"; "/dev/sdd"; "/"]]
7894   );
7895
7896   let get_seq_last = function
7897     | [] ->
7898         failwithf "%s: you cannot use [] (empty list) when expecting a command"
7899           test_name
7900     | seq ->
7901         let seq = List.rev seq in
7902         List.rev (List.tl seq), List.hd seq
7903   in
7904
7905   match test with
7906   | TestRun seq ->
7907       pr "  /* TestRun for %s (%d) */\n" name i;
7908       List.iter (generate_test_command_call test_name) seq
7909   | TestOutput (seq, expected) ->
7910       pr "  /* TestOutput for %s (%d) */\n" name i;
7911       pr "  const char *expected = \"%s\";\n" (c_quote expected);
7912       let seq, last = get_seq_last seq in
7913       let test () =
7914         pr "    if (STRNEQ (r, expected)) {\n";
7915         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
7916         pr "      return -1;\n";
7917         pr "    }\n"
7918       in
7919       List.iter (generate_test_command_call test_name) seq;
7920       generate_test_command_call ~test test_name last
7921   | TestOutputList (seq, expected) ->
7922       pr "  /* TestOutputList for %s (%d) */\n" name i;
7923       let seq, last = get_seq_last seq in
7924       let test () =
7925         iteri (
7926           fun i str ->
7927             pr "    if (!r[%d]) {\n" i;
7928             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
7929             pr "      print_strings (r);\n";
7930             pr "      return -1;\n";
7931             pr "    }\n";
7932             pr "    {\n";
7933             pr "      const char *expected = \"%s\";\n" (c_quote str);
7934             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
7935             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
7936             pr "        return -1;\n";
7937             pr "      }\n";
7938             pr "    }\n"
7939         ) expected;
7940         pr "    if (r[%d] != NULL) {\n" (List.length expected);
7941         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
7942           test_name;
7943         pr "      print_strings (r);\n";
7944         pr "      return -1;\n";
7945         pr "    }\n"
7946       in
7947       List.iter (generate_test_command_call test_name) seq;
7948       generate_test_command_call ~test test_name last
7949   | TestOutputListOfDevices (seq, expected) ->
7950       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
7951       let seq, last = get_seq_last seq in
7952       let test () =
7953         iteri (
7954           fun i str ->
7955             pr "    if (!r[%d]) {\n" i;
7956             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
7957             pr "      print_strings (r);\n";
7958             pr "      return -1;\n";
7959             pr "    }\n";
7960             pr "    {\n";
7961             pr "      const char *expected = \"%s\";\n" (c_quote str);
7962             pr "      r[%d][5] = 's';\n" i;
7963             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
7964             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
7965             pr "        return -1;\n";
7966             pr "      }\n";
7967             pr "    }\n"
7968         ) expected;
7969         pr "    if (r[%d] != NULL) {\n" (List.length expected);
7970         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
7971           test_name;
7972         pr "      print_strings (r);\n";
7973         pr "      return -1;\n";
7974         pr "    }\n"
7975       in
7976       List.iter (generate_test_command_call test_name) seq;
7977       generate_test_command_call ~test test_name last
7978   | TestOutputInt (seq, expected) ->
7979       pr "  /* TestOutputInt for %s (%d) */\n" name i;
7980       let seq, last = get_seq_last seq in
7981       let test () =
7982         pr "    if (r != %d) {\n" expected;
7983         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
7984           test_name expected;
7985         pr "               (int) r);\n";
7986         pr "      return -1;\n";
7987         pr "    }\n"
7988       in
7989       List.iter (generate_test_command_call test_name) seq;
7990       generate_test_command_call ~test test_name last
7991   | TestOutputIntOp (seq, op, expected) ->
7992       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
7993       let seq, last = get_seq_last seq in
7994       let test () =
7995         pr "    if (! (r %s %d)) {\n" op expected;
7996         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
7997           test_name op expected;
7998         pr "               (int) r);\n";
7999         pr "      return -1;\n";
8000         pr "    }\n"
8001       in
8002       List.iter (generate_test_command_call test_name) seq;
8003       generate_test_command_call ~test test_name last
8004   | TestOutputTrue seq ->
8005       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
8006       let seq, last = get_seq_last seq in
8007       let test () =
8008         pr "    if (!r) {\n";
8009         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
8010           test_name;
8011         pr "      return -1;\n";
8012         pr "    }\n"
8013       in
8014       List.iter (generate_test_command_call test_name) seq;
8015       generate_test_command_call ~test test_name last
8016   | TestOutputFalse seq ->
8017       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
8018       let seq, last = get_seq_last seq in
8019       let test () =
8020         pr "    if (r) {\n";
8021         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
8022           test_name;
8023         pr "      return -1;\n";
8024         pr "    }\n"
8025       in
8026       List.iter (generate_test_command_call test_name) seq;
8027       generate_test_command_call ~test test_name last
8028   | TestOutputLength (seq, expected) ->
8029       pr "  /* TestOutputLength for %s (%d) */\n" name i;
8030       let seq, last = get_seq_last seq in
8031       let test () =
8032         pr "    int j;\n";
8033         pr "    for (j = 0; j < %d; ++j)\n" expected;
8034         pr "      if (r[j] == NULL) {\n";
8035         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
8036           test_name;
8037         pr "        print_strings (r);\n";
8038         pr "        return -1;\n";
8039         pr "      }\n";
8040         pr "    if (r[j] != NULL) {\n";
8041         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
8042           test_name;
8043         pr "      print_strings (r);\n";
8044         pr "      return -1;\n";
8045         pr "    }\n"
8046       in
8047       List.iter (generate_test_command_call test_name) seq;
8048       generate_test_command_call ~test test_name last
8049   | TestOutputBuffer (seq, expected) ->
8050       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
8051       pr "  const char *expected = \"%s\";\n" (c_quote expected);
8052       let seq, last = get_seq_last seq in
8053       let len = String.length expected in
8054       let test () =
8055         pr "    if (size != %d) {\n" len;
8056         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
8057         pr "      return -1;\n";
8058         pr "    }\n";
8059         pr "    if (STRNEQLEN (r, expected, size)) {\n";
8060         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
8061         pr "      return -1;\n";
8062         pr "    }\n"
8063       in
8064       List.iter (generate_test_command_call test_name) seq;
8065       generate_test_command_call ~test test_name last
8066   | TestOutputStruct (seq, checks) ->
8067       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
8068       let seq, last = get_seq_last seq in
8069       let test () =
8070         List.iter (
8071           function
8072           | CompareWithInt (field, expected) ->
8073               pr "    if (r->%s != %d) {\n" field expected;
8074               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
8075                 test_name field expected;
8076               pr "               (int) r->%s);\n" field;
8077               pr "      return -1;\n";
8078               pr "    }\n"
8079           | CompareWithIntOp (field, op, expected) ->
8080               pr "    if (!(r->%s %s %d)) {\n" field op expected;
8081               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
8082                 test_name field op expected;
8083               pr "               (int) r->%s);\n" field;
8084               pr "      return -1;\n";
8085               pr "    }\n"
8086           | CompareWithString (field, expected) ->
8087               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
8088               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
8089                 test_name field expected;
8090               pr "               r->%s);\n" field;
8091               pr "      return -1;\n";
8092               pr "    }\n"
8093           | CompareFieldsIntEq (field1, field2) ->
8094               pr "    if (r->%s != r->%s) {\n" field1 field2;
8095               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
8096                 test_name field1 field2;
8097               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
8098               pr "      return -1;\n";
8099               pr "    }\n"
8100           | CompareFieldsStrEq (field1, field2) ->
8101               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
8102               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
8103                 test_name field1 field2;
8104               pr "               r->%s, r->%s);\n" field1 field2;
8105               pr "      return -1;\n";
8106               pr "    }\n"
8107         ) checks
8108       in
8109       List.iter (generate_test_command_call test_name) seq;
8110       generate_test_command_call ~test test_name last
8111   | TestLastFail seq ->
8112       pr "  /* TestLastFail for %s (%d) */\n" name i;
8113       let seq, last = get_seq_last seq in
8114       List.iter (generate_test_command_call test_name) seq;
8115       generate_test_command_call test_name ~expect_error:true last
8116
8117 (* Generate the code to run a command, leaving the result in 'r'.
8118  * If you expect to get an error then you should set expect_error:true.
8119  *)
8120 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
8121   match cmd with
8122   | [] -> assert false
8123   | name :: args ->
8124       (* Look up the command to find out what args/ret it has. *)
8125       let style =
8126         try
8127           let _, style, _, _, _, _, _ =
8128             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
8129           style
8130         with Not_found ->
8131           failwithf "%s: in test, command %s was not found" test_name name in
8132
8133       if List.length (snd style) <> List.length args then
8134         failwithf "%s: in test, wrong number of args given to %s"
8135           test_name name;
8136
8137       pr "  {\n";
8138
8139       List.iter (
8140         function
8141         | OptString n, "NULL" -> ()
8142         | Pathname n, arg
8143         | Device n, arg
8144         | Dev_or_Path n, arg
8145         | String n, arg
8146         | OptString n, arg
8147         | Key n, arg ->
8148             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
8149         | BufferIn n, arg ->
8150             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
8151             pr "    size_t %s_size = %d;\n" n (String.length arg)
8152         | Int _, _
8153         | Int64 _, _
8154         | Bool _, _
8155         | FileIn _, _ | FileOut _, _ -> ()
8156         | StringList n, "" | DeviceList n, "" ->
8157             pr "    const char *const %s[1] = { NULL };\n" n
8158         | StringList n, arg | DeviceList n, arg ->
8159             let strs = string_split " " arg in
8160             iteri (
8161               fun i str ->
8162                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
8163             ) strs;
8164             pr "    const char *const %s[] = {\n" n;
8165             iteri (
8166               fun i _ -> pr "      %s_%d,\n" n i
8167             ) strs;
8168             pr "      NULL\n";
8169             pr "    };\n";
8170       ) (List.combine (snd style) args);
8171
8172       let error_code =
8173         match fst style with
8174         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
8175         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
8176         | RConstString _ | RConstOptString _ ->
8177             pr "    const char *r;\n"; "NULL"
8178         | RString _ -> pr "    char *r;\n"; "NULL"
8179         | RStringList _ | RHashtable _ ->
8180             pr "    char **r;\n";
8181             pr "    size_t i;\n";
8182             "NULL"
8183         | RStruct (_, typ) ->
8184             pr "    struct guestfs_%s *r;\n" typ; "NULL"
8185         | RStructList (_, typ) ->
8186             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
8187         | RBufferOut _ ->
8188             pr "    char *r;\n";
8189             pr "    size_t size;\n";
8190             "NULL" in
8191
8192       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
8193       pr "    r = guestfs_%s (g" name;
8194
8195       (* Generate the parameters. *)
8196       List.iter (
8197         function
8198         | OptString _, "NULL" -> pr ", NULL"
8199         | Pathname n, _
8200         | Device n, _ | Dev_or_Path n, _
8201         | String n, _
8202         | OptString n, _
8203         | Key n, _ ->
8204             pr ", %s" n
8205         | BufferIn n, _ ->
8206             pr ", %s, %s_size" n n
8207         | FileIn _, arg | FileOut _, arg ->
8208             pr ", \"%s\"" (c_quote arg)
8209         | StringList n, _ | DeviceList n, _ ->
8210             pr ", (char **) %s" n
8211         | Int _, arg ->
8212             let i =
8213               try int_of_string arg
8214               with Failure "int_of_string" ->
8215                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
8216             pr ", %d" i
8217         | Int64 _, arg ->
8218             let i =
8219               try Int64.of_string arg
8220               with Failure "int_of_string" ->
8221                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
8222             pr ", %Ld" i
8223         | Bool _, arg ->
8224             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
8225       ) (List.combine (snd style) args);
8226
8227       (match fst style with
8228        | RBufferOut _ -> pr ", &size"
8229        | _ -> ()
8230       );
8231
8232       pr ");\n";
8233
8234       if not expect_error then
8235         pr "    if (r == %s)\n" error_code
8236       else
8237         pr "    if (r != %s)\n" error_code;
8238       pr "      return -1;\n";
8239
8240       (* Insert the test code. *)
8241       (match test with
8242        | None -> ()
8243        | Some f -> f ()
8244       );
8245
8246       (match fst style with
8247        | RErr | RInt _ | RInt64 _ | RBool _
8248        | RConstString _ | RConstOptString _ -> ()
8249        | RString _ | RBufferOut _ -> pr "    free (r);\n"
8250        | RStringList _ | RHashtable _ ->
8251            pr "    for (i = 0; r[i] != NULL; ++i)\n";
8252            pr "      free (r[i]);\n";
8253            pr "    free (r);\n"
8254        | RStruct (_, typ) ->
8255            pr "    guestfs_free_%s (r);\n" typ
8256        | RStructList (_, typ) ->
8257            pr "    guestfs_free_%s_list (r);\n" typ
8258       );
8259
8260       pr "  }\n"
8261
8262 and c_quote str =
8263   let str = replace_str str "\r" "\\r" in
8264   let str = replace_str str "\n" "\\n" in
8265   let str = replace_str str "\t" "\\t" in
8266   let str = replace_str str "\000" "\\0" in
8267   str
8268
8269 (* Generate a lot of different functions for guestfish. *)
8270 and generate_fish_cmds () =
8271   generate_header CStyle GPLv2plus;
8272
8273   let all_functions =
8274     List.filter (
8275       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
8276     ) all_functions in
8277   let all_functions_sorted =
8278     List.filter (
8279       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
8280     ) all_functions_sorted in
8281
8282   pr "#include <config.h>\n";
8283   pr "\n";
8284   pr "#include <stdio.h>\n";
8285   pr "#include <stdlib.h>\n";
8286   pr "#include <string.h>\n";
8287   pr "#include <inttypes.h>\n";
8288   pr "\n";
8289   pr "#include <guestfs.h>\n";
8290   pr "#include \"c-ctype.h\"\n";
8291   pr "#include \"full-write.h\"\n";
8292   pr "#include \"xstrtol.h\"\n";
8293   pr "#include \"fish.h\"\n";
8294   pr "\n";
8295   pr "/* Valid suffixes allowed for numbers.  See Gnulib xstrtol function. */\n";
8296   pr "static const char *xstrtol_suffixes = \"0kKMGTPEZY\";\n";
8297   pr "\n";
8298
8299   (* list_commands function, which implements guestfish -h *)
8300   pr "void list_commands (void)\n";
8301   pr "{\n";
8302   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
8303   pr "  list_builtin_commands ();\n";
8304   List.iter (
8305     fun (name, _, _, flags, _, shortdesc, _) ->
8306       let name = replace_char name '_' '-' in
8307       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
8308         name shortdesc
8309   ) all_functions_sorted;
8310   pr "  printf (\"    %%s\\n\",";
8311   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
8312   pr "}\n";
8313   pr "\n";
8314
8315   (* display_command function, which implements guestfish -h cmd *)
8316   pr "int display_command (const char *cmd)\n";
8317   pr "{\n";
8318   List.iter (
8319     fun (name, style, _, flags, _, shortdesc, longdesc) ->
8320       let name2 = replace_char name '_' '-' in
8321       let alias =
8322         try find_map (function FishAlias n -> Some n | _ -> None) flags
8323         with Not_found -> name in
8324       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
8325       let synopsis =
8326         match snd style with
8327         | [] -> name2
8328         | args ->
8329             let args = List.filter (function Key _ -> false | _ -> true) args in
8330             sprintf "%s %s"
8331               name2 (String.concat " " (List.map name_of_argt args)) in
8332
8333       let warnings =
8334         if List.exists (function Key _ -> true | _ -> false) (snd style) then
8335           "\n\nThis command has one or more key or passphrase parameters.
8336 Guestfish will prompt for these separately."
8337         else "" in
8338
8339       let warnings =
8340         warnings ^
8341           if List.mem ProtocolLimitWarning flags then
8342             ("\n\n" ^ protocol_limit_warning)
8343           else "" in
8344
8345       (* For DangerWillRobinson commands, we should probably have
8346        * guestfish prompt before allowing you to use them (especially
8347        * in interactive mode). XXX
8348        *)
8349       let warnings =
8350         warnings ^
8351           if List.mem DangerWillRobinson flags then
8352             ("\n\n" ^ danger_will_robinson)
8353           else "" in
8354
8355       let warnings =
8356         warnings ^
8357           match deprecation_notice flags with
8358           | None -> ""
8359           | Some txt -> "\n\n" ^ txt in
8360
8361       let describe_alias =
8362         if name <> alias then
8363           sprintf "\n\nYou can use '%s' as an alias for this command." alias
8364         else "" in
8365
8366       pr "  if (";
8367       pr "STRCASEEQ (cmd, \"%s\")" name;
8368       if name <> name2 then
8369         pr " || STRCASEEQ (cmd, \"%s\")" name2;
8370       if name <> alias then
8371         pr " || STRCASEEQ (cmd, \"%s\")" alias;
8372       pr ") {\n";
8373       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
8374         name2 shortdesc
8375         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
8376          "=head1 DESCRIPTION\n\n" ^
8377          longdesc ^ warnings ^ describe_alias);
8378       pr "    return 0;\n";
8379       pr "  }\n";
8380       pr "  else\n"
8381   ) all_functions;
8382   pr "    return display_builtin_command (cmd);\n";
8383   pr "}\n";
8384   pr "\n";
8385
8386   let emit_print_list_function typ =
8387     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
8388       typ typ typ;
8389     pr "{\n";
8390     pr "  unsigned int i;\n";
8391     pr "\n";
8392     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
8393     pr "    printf (\"[%%d] = {\\n\", i);\n";
8394     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
8395     pr "    printf (\"}\\n\");\n";
8396     pr "  }\n";
8397     pr "}\n";
8398     pr "\n";
8399   in
8400
8401   (* print_* functions *)
8402   List.iter (
8403     fun (typ, cols) ->
8404       let needs_i =
8405         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
8406
8407       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
8408       pr "{\n";
8409       if needs_i then (
8410         pr "  unsigned int i;\n";
8411         pr "\n"
8412       );
8413       List.iter (
8414         function
8415         | name, FString ->
8416             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
8417         | name, FUUID ->
8418             pr "  printf (\"%%s%s: \", indent);\n" name;
8419             pr "  for (i = 0; i < 32; ++i)\n";
8420             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
8421             pr "  printf (\"\\n\");\n"
8422         | name, FBuffer ->
8423             pr "  printf (\"%%s%s: \", indent);\n" name;
8424             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
8425             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
8426             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
8427             pr "    else\n";
8428             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
8429             pr "  printf (\"\\n\");\n"
8430         | name, (FUInt64|FBytes) ->
8431             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
8432               name typ name
8433         | name, FInt64 ->
8434             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
8435               name typ name
8436         | name, FUInt32 ->
8437             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
8438               name typ name
8439         | name, FInt32 ->
8440             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
8441               name typ name
8442         | name, FChar ->
8443             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
8444               name typ name
8445         | name, FOptPercent ->
8446             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
8447               typ name name typ name;
8448             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
8449       ) cols;
8450       pr "}\n";
8451       pr "\n";
8452   ) structs;
8453
8454   (* Emit a print_TYPE_list function definition only if that function is used. *)
8455   List.iter (
8456     function
8457     | typ, (RStructListOnly | RStructAndList) ->
8458         (* generate the function for typ *)
8459         emit_print_list_function typ
8460     | typ, _ -> () (* empty *)
8461   ) (rstructs_used_by all_functions);
8462
8463   (* Emit a print_TYPE function definition only if that function is used. *)
8464   List.iter (
8465     function
8466     | typ, (RStructOnly | RStructAndList) ->
8467         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
8468         pr "{\n";
8469         pr "  print_%s_indent (%s, \"\");\n" typ typ;
8470         pr "}\n";
8471         pr "\n";
8472     | typ, _ -> () (* empty *)
8473   ) (rstructs_used_by all_functions);
8474
8475   (* run_<action> actions *)
8476   List.iter (
8477     fun (name, style, _, flags, _, _, _) ->
8478       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
8479       pr "{\n";
8480       (match fst style with
8481        | RErr
8482        | RInt _
8483        | RBool _ -> pr "  int r;\n"
8484        | RInt64 _ -> pr "  int64_t r;\n"
8485        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
8486        | RString _ -> pr "  char *r;\n"
8487        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
8488        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
8489        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
8490        | RBufferOut _ ->
8491            pr "  char *r;\n";
8492            pr "  size_t size;\n";
8493       );
8494       List.iter (
8495         function
8496         | Device n
8497         | String n
8498         | OptString n -> pr "  const char *%s;\n" n
8499         | Pathname n
8500         | Dev_or_Path n
8501         | FileIn n
8502         | FileOut n
8503         | Key n -> pr "  char *%s;\n" n
8504         | BufferIn n ->
8505             pr "  const char *%s;\n" n;
8506             pr "  size_t %s_size;\n" n
8507         | StringList n | DeviceList n -> pr "  char **%s;\n" n
8508         | Bool n -> pr "  int %s;\n" n
8509         | Int n -> pr "  int %s;\n" n
8510         | Int64 n -> pr "  int64_t %s;\n" n
8511       ) (snd style);
8512
8513       (* Check and convert parameters. *)
8514       let argc_expected =
8515         let args_no_keys =
8516           List.filter (function Key _ -> false | _ -> true) (snd style) in
8517         List.length args_no_keys in
8518       pr "  if (argc != %d) {\n" argc_expected;
8519       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
8520         argc_expected;
8521       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
8522       pr "    return -1;\n";
8523       pr "  }\n";
8524
8525       let parse_integer fn fntyp rtyp range name =
8526         pr "  {\n";
8527         pr "    strtol_error xerr;\n";
8528         pr "    %s r;\n" fntyp;
8529         pr "\n";
8530         pr "    xerr = %s (argv[i++], NULL, 0, &r, xstrtol_suffixes);\n" fn;
8531         pr "    if (xerr != LONGINT_OK) {\n";
8532         pr "      fprintf (stderr,\n";
8533         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
8534         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
8535         pr "      return -1;\n";
8536         pr "    }\n";
8537         (match range with
8538          | None -> ()
8539          | Some (min, max, comment) ->
8540              pr "    /* %s */\n" comment;
8541              pr "    if (r < %s || r > %s) {\n" min max;
8542              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
8543                name;
8544              pr "      return -1;\n";
8545              pr "    }\n";
8546              pr "    /* The check above should ensure this assignment does not overflow. */\n";
8547         );
8548         pr "    %s = r;\n" name;
8549         pr "  }\n";
8550       in
8551
8552       if snd style <> [] then
8553         pr "  size_t i = 0;\n";
8554
8555       List.iter (
8556         function
8557         | Device name
8558         | String name ->
8559             pr "  %s = argv[i++];\n" name
8560         | Pathname name
8561         | Dev_or_Path name ->
8562             pr "  %s = resolve_win_path (argv[i++]);\n" name;
8563             pr "  if (%s == NULL) return -1;\n" name
8564         | OptString name ->
8565             pr "  %s = STRNEQ (argv[i], \"\") ? argv[i] : NULL;\n" name;
8566             pr "  i++;\n"
8567         | BufferIn name ->
8568             pr "  %s = argv[i];\n" name;
8569             pr "  %s_size = strlen (argv[i]);\n" name;
8570             pr "  i++;\n"
8571         | FileIn name ->
8572             pr "  %s = file_in (argv[i++]);\n" name;
8573             pr "  if (%s == NULL) return -1;\n" name
8574         | FileOut name ->
8575             pr "  %s = file_out (argv[i++]);\n" name;
8576             pr "  if (%s == NULL) return -1;\n" name
8577         | StringList name | DeviceList name ->
8578             pr "  %s = parse_string_list (argv[i++]);\n" name;
8579             pr "  if (%s == NULL) return -1;\n" name
8580         | Key name ->
8581             pr "  %s = read_key (\"%s\");\n" name name;
8582             pr "  if (%s == NULL) return -1;\n" name
8583         | Bool name ->
8584             pr "  %s = is_true (argv[i++]) ? 1 : 0;\n" name
8585         | Int name ->
8586             let range =
8587               let min = "(-(2LL<<30))"
8588               and max = "((2LL<<30)-1)"
8589               and comment =
8590                 "The Int type in the generator is a signed 31 bit int." in
8591               Some (min, max, comment) in
8592             parse_integer "xstrtoll" "long long" "int" range name
8593         | Int64 name ->
8594             parse_integer "xstrtoll" "long long" "int64_t" None name
8595       ) (snd style);
8596
8597       (* Call C API function. *)
8598       pr "  r = guestfs_%s " name;
8599       generate_c_call_args ~handle:"g" style;
8600       pr ";\n";
8601
8602       List.iter (
8603         function
8604         | Device _ | String _
8605         | OptString _ | Bool _
8606         | Int _ | Int64 _
8607         | BufferIn _ -> ()
8608         | Pathname name | Dev_or_Path name | FileOut name
8609         | Key name ->
8610             pr "  free (%s);\n" name
8611         | FileIn name ->
8612             pr "  free_file_in (%s);\n" name
8613         | StringList name | DeviceList name ->
8614             pr "  free_strings (%s);\n" name
8615       ) (snd style);
8616
8617       (* Any output flags? *)
8618       let fish_output =
8619         let flags = filter_map (
8620           function FishOutput flag -> Some flag | _ -> None
8621         ) flags in
8622         match flags with
8623         | [] -> None
8624         | [f] -> Some f
8625         | _ ->
8626             failwithf "%s: more than one FishOutput flag is not allowed" name in
8627
8628       (* Check return value for errors and display command results. *)
8629       (match fst style with
8630        | RErr -> pr "  return r;\n"
8631        | RInt _ ->
8632            pr "  if (r == -1) return -1;\n";
8633            (match fish_output with
8634             | None ->
8635                 pr "  printf (\"%%d\\n\", r);\n";
8636             | Some FishOutputOctal ->
8637                 pr "  printf (\"%%s%%o\\n\", r != 0 ? \"0\" : \"\", r);\n";
8638             | Some FishOutputHexadecimal ->
8639                 pr "  printf (\"%%s%%x\\n\", r != 0 ? \"0x\" : \"\", r);\n");
8640            pr "  return 0;\n"
8641        | RInt64 _ ->
8642            pr "  if (r == -1) return -1;\n";
8643            (match fish_output with
8644             | None ->
8645                 pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
8646             | Some FishOutputOctal ->
8647                 pr "  printf (\"%%s%%\" PRIo64 \"\\n\", r != 0 ? \"0\" : \"\", r);\n";
8648             | Some FishOutputHexadecimal ->
8649                 pr "  printf (\"%%s%%\" PRIx64 \"\\n\", r != 0 ? \"0x\" : \"\", r);\n");
8650            pr "  return 0;\n"
8651        | RBool _ ->
8652            pr "  if (r == -1) return -1;\n";
8653            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
8654            pr "  return 0;\n"
8655        | RConstString _ ->
8656            pr "  if (r == NULL) return -1;\n";
8657            pr "  printf (\"%%s\\n\", r);\n";
8658            pr "  return 0;\n"
8659        | RConstOptString _ ->
8660            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
8661            pr "  return 0;\n"
8662        | RString _ ->
8663            pr "  if (r == NULL) return -1;\n";
8664            pr "  printf (\"%%s\\n\", r);\n";
8665            pr "  free (r);\n";
8666            pr "  return 0;\n"
8667        | RStringList _ ->
8668            pr "  if (r == NULL) return -1;\n";
8669            pr "  print_strings (r);\n";
8670            pr "  free_strings (r);\n";
8671            pr "  return 0;\n"
8672        | RStruct (_, typ) ->
8673            pr "  if (r == NULL) return -1;\n";
8674            pr "  print_%s (r);\n" typ;
8675            pr "  guestfs_free_%s (r);\n" typ;
8676            pr "  return 0;\n"
8677        | RStructList (_, typ) ->
8678            pr "  if (r == NULL) return -1;\n";
8679            pr "  print_%s_list (r);\n" typ;
8680            pr "  guestfs_free_%s_list (r);\n" typ;
8681            pr "  return 0;\n"
8682        | RHashtable _ ->
8683            pr "  if (r == NULL) return -1;\n";
8684            pr "  print_table (r);\n";
8685            pr "  free_strings (r);\n";
8686            pr "  return 0;\n"
8687        | RBufferOut _ ->
8688            pr "  if (r == NULL) return -1;\n";
8689            pr "  if (full_write (1, r, size) != size) {\n";
8690            pr "    perror (\"write\");\n";
8691            pr "    free (r);\n";
8692            pr "    return -1;\n";
8693            pr "  }\n";
8694            pr "  free (r);\n";
8695            pr "  return 0;\n"
8696       );
8697       pr "}\n";
8698       pr "\n"
8699   ) all_functions;
8700
8701   (* run_action function *)
8702   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
8703   pr "{\n";
8704   List.iter (
8705     fun (name, _, _, flags, _, _, _) ->
8706       let name2 = replace_char name '_' '-' in
8707       let alias =
8708         try find_map (function FishAlias n -> Some n | _ -> None) flags
8709         with Not_found -> name in
8710       pr "  if (";
8711       pr "STRCASEEQ (cmd, \"%s\")" name;
8712       if name <> name2 then
8713         pr " || STRCASEEQ (cmd, \"%s\")" name2;
8714       if name <> alias then
8715         pr " || STRCASEEQ (cmd, \"%s\")" alias;
8716       pr ")\n";
8717       pr "    return run_%s (cmd, argc, argv);\n" name;
8718       pr "  else\n";
8719   ) all_functions;
8720   pr "    {\n";
8721   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
8722   pr "      if (command_num == 1)\n";
8723   pr "        extended_help_message ();\n";
8724   pr "      return -1;\n";
8725   pr "    }\n";
8726   pr "  return 0;\n";
8727   pr "}\n";
8728   pr "\n"
8729
8730 (* Readline completion for guestfish. *)
8731 and generate_fish_completion () =
8732   generate_header CStyle GPLv2plus;
8733
8734   let all_functions =
8735     List.filter (
8736       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
8737     ) all_functions in
8738
8739   pr "\
8740 #include <config.h>
8741
8742 #include <stdio.h>
8743 #include <stdlib.h>
8744 #include <string.h>
8745
8746 #ifdef HAVE_LIBREADLINE
8747 #include <readline/readline.h>
8748 #endif
8749
8750 #include \"fish.h\"
8751
8752 #ifdef HAVE_LIBREADLINE
8753
8754 static const char *const commands[] = {
8755   BUILTIN_COMMANDS_FOR_COMPLETION,
8756 ";
8757
8758   (* Get the commands, including the aliases.  They don't need to be
8759    * sorted - the generator() function just does a dumb linear search.
8760    *)
8761   let commands =
8762     List.map (
8763       fun (name, _, _, flags, _, _, _) ->
8764         let name2 = replace_char name '_' '-' in
8765         let alias =
8766           try find_map (function FishAlias n -> Some n | _ -> None) flags
8767           with Not_found -> name in
8768
8769         if name <> alias then [name2; alias] else [name2]
8770     ) all_functions in
8771   let commands = List.flatten commands in
8772
8773   List.iter (pr "  \"%s\",\n") commands;
8774
8775   pr "  NULL
8776 };
8777
8778 static char *
8779 generator (const char *text, int state)
8780 {
8781   static size_t index, len;
8782   const char *name;
8783
8784   if (!state) {
8785     index = 0;
8786     len = strlen (text);
8787   }
8788
8789   rl_attempted_completion_over = 1;
8790
8791   while ((name = commands[index]) != NULL) {
8792     index++;
8793     if (STRCASEEQLEN (name, text, len))
8794       return strdup (name);
8795   }
8796
8797   return NULL;
8798 }
8799
8800 #endif /* HAVE_LIBREADLINE */
8801
8802 #ifdef HAVE_RL_COMPLETION_MATCHES
8803 #define RL_COMPLETION_MATCHES rl_completion_matches
8804 #else
8805 #ifdef HAVE_COMPLETION_MATCHES
8806 #define RL_COMPLETION_MATCHES completion_matches
8807 #endif
8808 #endif /* else just fail if we don't have either symbol */
8809
8810 char **
8811 do_completion (const char *text, int start, int end)
8812 {
8813   char **matches = NULL;
8814
8815 #ifdef HAVE_LIBREADLINE
8816   rl_completion_append_character = ' ';
8817
8818   if (start == 0)
8819     matches = RL_COMPLETION_MATCHES (text, generator);
8820   else if (complete_dest_paths)
8821     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
8822 #endif
8823
8824   return matches;
8825 }
8826 ";
8827
8828 (* Generate the POD documentation for guestfish. *)
8829 and generate_fish_actions_pod () =
8830   let all_functions_sorted =
8831     List.filter (
8832       fun (_, _, _, flags, _, _, _) ->
8833         not (List.mem NotInFish flags || List.mem NotInDocs flags)
8834     ) all_functions_sorted in
8835
8836   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
8837
8838   List.iter (
8839     fun (name, style, _, flags, _, _, longdesc) ->
8840       let longdesc =
8841         Str.global_substitute rex (
8842           fun s ->
8843             let sub =
8844               try Str.matched_group 1 s
8845               with Not_found ->
8846                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
8847             "C<" ^ replace_char sub '_' '-' ^ ">"
8848         ) longdesc in
8849       let name = replace_char name '_' '-' in
8850       let alias =
8851         try find_map (function FishAlias n -> Some n | _ -> None) flags
8852         with Not_found -> name in
8853
8854       pr "=head2 %s" name;
8855       if name <> alias then
8856         pr " | %s" alias;
8857       pr "\n";
8858       pr "\n";
8859       pr " %s" name;
8860       List.iter (
8861         function
8862         | Pathname n | Device n | Dev_or_Path n | String n ->
8863             pr " %s" n
8864         | OptString n -> pr " %s" n
8865         | StringList n | DeviceList n -> pr " '%s ...'" n
8866         | Bool _ -> pr " true|false"
8867         | Int n -> pr " %s" n
8868         | Int64 n -> pr " %s" n
8869         | FileIn n | FileOut n -> pr " (%s|-)" n
8870         | BufferIn n -> pr " %s" n
8871         | Key _ -> () (* keys are entered at a prompt *)
8872       ) (snd style);
8873       pr "\n";
8874       pr "\n";
8875       pr "%s\n\n" longdesc;
8876
8877       if List.exists (function FileIn _ | FileOut _ -> true
8878                       | _ -> false) (snd style) then
8879         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
8880
8881       if List.exists (function Key _ -> true | _ -> false) (snd style) then
8882         pr "This command has one or more key or passphrase parameters.
8883 Guestfish will prompt for these separately.\n\n";
8884
8885       if List.mem ProtocolLimitWarning flags then
8886         pr "%s\n\n" protocol_limit_warning;
8887
8888       if List.mem DangerWillRobinson flags then
8889         pr "%s\n\n" danger_will_robinson;
8890
8891       match deprecation_notice flags with
8892       | None -> ()
8893       | Some txt -> pr "%s\n\n" txt
8894   ) all_functions_sorted
8895
8896 and generate_fish_prep_options_h () =
8897   generate_header CStyle GPLv2plus;
8898
8899   pr "#ifndef PREPOPTS_H\n";
8900   pr "\n";
8901
8902   pr "\
8903 struct prep {
8904   const char *name;             /* eg. \"fs\" */
8905
8906   size_t nr_params;             /* optional parameters */
8907   struct prep_param *params;
8908
8909   const char *shortdesc;        /* short description */
8910   const char *longdesc;         /* long description */
8911
8912                                 /* functions to implement it */
8913   void (*prelaunch) (const char *filename, prep_data *);
8914   void (*postlaunch) (const char *filename, prep_data *, const char *device);
8915 };
8916
8917 struct prep_param {
8918   const char *pname;            /* parameter name */
8919   const char *pdefault;         /* parameter default */
8920   const char *pdesc;            /* parameter description */
8921 };
8922
8923 extern const struct prep preps[];
8924 #define NR_PREPS %d
8925
8926 " (List.length prepopts);
8927
8928   List.iter (
8929     fun (name, shortdesc, args, longdesc) ->
8930       pr "\
8931 extern void prep_prelaunch_%s (const char *filename, prep_data *data);
8932 extern void prep_postlaunch_%s (const char *filename, prep_data *data, const char *device);
8933
8934 " name name;
8935   ) prepopts;
8936
8937   pr "\n";
8938   pr "#endif /* PREPOPTS_H */\n"
8939
8940 and generate_fish_prep_options_c () =
8941   generate_header CStyle GPLv2plus;
8942
8943   pr "\
8944 #include \"fish.h\"
8945 #include \"prepopts.h\"
8946
8947 ";
8948
8949   List.iter (
8950     fun (name, shortdesc, args, longdesc) ->
8951       pr "static struct prep_param %s_args[] = {\n" name;
8952       List.iter (
8953         fun (n, default, desc) ->
8954           pr "  { \"%s\", \"%s\", \"%s\" },\n" n default desc
8955       ) args;
8956       pr "};\n";
8957       pr "\n";
8958   ) prepopts;
8959
8960   pr "const struct prep preps[] = {\n";
8961   List.iter (
8962     fun (name, shortdesc, args, longdesc) ->
8963       pr "  { \"%s\", %d, %s_args,
8964     \"%s\",
8965     \"%s\",
8966     prep_prelaunch_%s, prep_postlaunch_%s },
8967 "
8968         name (List.length args) name
8969         (c_quote shortdesc) (c_quote longdesc)
8970         name name;
8971   ) prepopts;
8972   pr "};\n"
8973
8974 (* Generate a C function prototype. *)
8975 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
8976     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
8977     ?(prefix = "")
8978     ?handle name style =
8979   if extern then pr "extern ";
8980   if static then pr "static ";
8981   (match fst style with
8982    | RErr -> pr "int "
8983    | RInt _ -> pr "int "
8984    | RInt64 _ -> pr "int64_t "
8985    | RBool _ -> pr "int "
8986    | RConstString _ | RConstOptString _ -> pr "const char *"
8987    | RString _ | RBufferOut _ -> pr "char *"
8988    | RStringList _ | RHashtable _ -> pr "char **"
8989    | RStruct (_, typ) ->
8990        if not in_daemon then pr "struct guestfs_%s *" typ
8991        else pr "guestfs_int_%s *" typ
8992    | RStructList (_, typ) ->
8993        if not in_daemon then pr "struct guestfs_%s_list *" typ
8994        else pr "guestfs_int_%s_list *" typ
8995   );
8996   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
8997   pr "%s%s (" prefix name;
8998   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
8999     pr "void"
9000   else (
9001     let comma = ref false in
9002     (match handle with
9003      | None -> ()
9004      | Some handle -> pr "guestfs_h *%s" handle; comma := true
9005     );
9006     let next () =
9007       if !comma then (
9008         if single_line then pr ", " else pr ",\n\t\t"
9009       );
9010       comma := true
9011     in
9012     List.iter (
9013       function
9014       | Pathname n
9015       | Device n | Dev_or_Path n
9016       | String n
9017       | OptString n
9018       | Key n ->
9019           next ();
9020           pr "const char *%s" n
9021       | StringList n | DeviceList n ->
9022           next ();
9023           pr "char *const *%s" n
9024       | Bool n -> next (); pr "int %s" n
9025       | Int n -> next (); pr "int %s" n
9026       | Int64 n -> next (); pr "int64_t %s" n
9027       | FileIn n
9028       | FileOut n ->
9029           if not in_daemon then (next (); pr "const char *%s" n)
9030       | BufferIn n ->
9031           next ();
9032           pr "const char *%s" n;
9033           next ();
9034           pr "size_t %s_size" n
9035     ) (snd style);
9036     if is_RBufferOut then (next (); pr "size_t *size_r");
9037   );
9038   pr ")";
9039   if semicolon then pr ";";
9040   if newline then pr "\n"
9041
9042 (* Generate C call arguments, eg "(handle, foo, bar)" *)
9043 and generate_c_call_args ?handle ?(decl = false) style =
9044   pr "(";
9045   let comma = ref false in
9046   let next () =
9047     if !comma then pr ", ";
9048     comma := true
9049   in
9050   (match handle with
9051    | None -> ()
9052    | Some handle -> pr "%s" handle; comma := true
9053   );
9054   List.iter (
9055     function
9056     | BufferIn n ->
9057         next ();
9058         pr "%s, %s_size" n n
9059     | arg ->
9060         next ();
9061         pr "%s" (name_of_argt arg)
9062   ) (snd style);
9063   (* For RBufferOut calls, add implicit &size parameter. *)
9064   if not decl then (
9065     match fst style with
9066     | RBufferOut _ ->
9067         next ();
9068         pr "&size"
9069     | _ -> ()
9070   );
9071   pr ")"
9072
9073 (* Generate the OCaml bindings interface. *)
9074 and generate_ocaml_mli () =
9075   generate_header OCamlStyle LGPLv2plus;
9076
9077   pr "\
9078 (** For API documentation you should refer to the C API
9079     in the guestfs(3) manual page.  The OCaml API uses almost
9080     exactly the same calls. *)
9081
9082 type t
9083 (** A [guestfs_h] handle. *)
9084
9085 exception Error of string
9086 (** This exception is raised when there is an error. *)
9087
9088 exception Handle_closed of string
9089 (** This exception is raised if you use a {!Guestfs.t} handle
9090     after calling {!close} on it.  The string is the name of
9091     the function. *)
9092
9093 val create : unit -> t
9094 (** Create a {!Guestfs.t} handle. *)
9095
9096 val close : t -> unit
9097 (** Close the {!Guestfs.t} handle and free up all resources used
9098     by it immediately.
9099
9100     Handles are closed by the garbage collector when they become
9101     unreferenced, but callers can call this in order to provide
9102     predictable cleanup. *)
9103
9104 type progress_cb = int -> int -> int64 -> int64 -> unit
9105
9106 val set_progress_callback : t -> progress_cb -> unit
9107 (** [set_progress_callback g f] sets [f] as the progress callback function.
9108     For some long-running functions, [f] will be called repeatedly
9109     during the function with progress updates.
9110
9111     The callback is [f proc_nr serial position total].  See
9112     the description of [guestfs_set_progress_callback] in guestfs(3)
9113     for the meaning of these four numbers.
9114
9115     Note that if the closure captures a reference to the handle,
9116     this reference will prevent the handle from being
9117     automatically closed by the garbage collector.  There are
9118     three ways to avoid this: be careful not to capture the handle
9119     in the closure, or use a weak reference, or call
9120     {!Guestfs.clear_progress_callback} to remove the reference. *)
9121
9122 val clear_progress_callback : t -> unit
9123 (** [clear_progress_callback g] removes any progress callback function
9124     associated with the handle.  See {!Guestfs.set_progress_callback}. *)
9125
9126 ";
9127   generate_ocaml_structure_decls ();
9128
9129   (* The actions. *)
9130   List.iter (
9131     fun (name, style, _, _, _, shortdesc, _) ->
9132       generate_ocaml_prototype name style;
9133       pr "(** %s *)\n" shortdesc;
9134       pr "\n"
9135   ) all_functions_sorted
9136
9137 (* Generate the OCaml bindings implementation. *)
9138 and generate_ocaml_ml () =
9139   generate_header OCamlStyle LGPLv2plus;
9140
9141   pr "\
9142 type t
9143
9144 exception Error of string
9145 exception Handle_closed of string
9146
9147 external create : unit -> t = \"ocaml_guestfs_create\"
9148 external close : t -> unit = \"ocaml_guestfs_close\"
9149
9150 type progress_cb = int -> int -> int64 -> int64 -> unit
9151
9152 external set_progress_callback : t -> progress_cb -> unit
9153   = \"ocaml_guestfs_set_progress_callback\"
9154 external clear_progress_callback : t -> unit
9155   = \"ocaml_guestfs_clear_progress_callback\"
9156
9157 (* Give the exceptions names, so they can be raised from the C code. *)
9158 let () =
9159   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
9160   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
9161
9162 ";
9163
9164   generate_ocaml_structure_decls ();
9165
9166   (* The actions. *)
9167   List.iter (
9168     fun (name, style, _, _, _, shortdesc, _) ->
9169       generate_ocaml_prototype ~is_external:true name style;
9170   ) all_functions_sorted
9171
9172 (* Generate the OCaml bindings C implementation. *)
9173 and generate_ocaml_c () =
9174   generate_header CStyle LGPLv2plus;
9175
9176   pr "\
9177 #include <stdio.h>
9178 #include <stdlib.h>
9179 #include <string.h>
9180
9181 #include <caml/config.h>
9182 #include <caml/alloc.h>
9183 #include <caml/callback.h>
9184 #include <caml/fail.h>
9185 #include <caml/memory.h>
9186 #include <caml/mlvalues.h>
9187 #include <caml/signals.h>
9188
9189 #include \"guestfs.h\"
9190
9191 #include \"guestfs_c.h\"
9192
9193 /* Copy a hashtable of string pairs into an assoc-list.  We return
9194  * the list in reverse order, but hashtables aren't supposed to be
9195  * ordered anyway.
9196  */
9197 static CAMLprim value
9198 copy_table (char * const * argv)
9199 {
9200   CAMLparam0 ();
9201   CAMLlocal5 (rv, pairv, kv, vv, cons);
9202   size_t i;
9203
9204   rv = Val_int (0);
9205   for (i = 0; argv[i] != NULL; i += 2) {
9206     kv = caml_copy_string (argv[i]);
9207     vv = caml_copy_string (argv[i+1]);
9208     pairv = caml_alloc (2, 0);
9209     Store_field (pairv, 0, kv);
9210     Store_field (pairv, 1, vv);
9211     cons = caml_alloc (2, 0);
9212     Store_field (cons, 1, rv);
9213     rv = cons;
9214     Store_field (cons, 0, pairv);
9215   }
9216
9217   CAMLreturn (rv);
9218 }
9219
9220 ";
9221
9222   (* Struct copy functions. *)
9223
9224   let emit_ocaml_copy_list_function typ =
9225     pr "static CAMLprim value\n";
9226     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
9227     pr "{\n";
9228     pr "  CAMLparam0 ();\n";
9229     pr "  CAMLlocal2 (rv, v);\n";
9230     pr "  unsigned int i;\n";
9231     pr "\n";
9232     pr "  if (%ss->len == 0)\n" typ;
9233     pr "    CAMLreturn (Atom (0));\n";
9234     pr "  else {\n";
9235     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
9236     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
9237     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
9238     pr "      caml_modify (&Field (rv, i), v);\n";
9239     pr "    }\n";
9240     pr "    CAMLreturn (rv);\n";
9241     pr "  }\n";
9242     pr "}\n";
9243     pr "\n";
9244   in
9245
9246   List.iter (
9247     fun (typ, cols) ->
9248       let has_optpercent_col =
9249         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
9250
9251       pr "static CAMLprim value\n";
9252       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
9253       pr "{\n";
9254       pr "  CAMLparam0 ();\n";
9255       if has_optpercent_col then
9256         pr "  CAMLlocal3 (rv, v, v2);\n"
9257       else
9258         pr "  CAMLlocal2 (rv, v);\n";
9259       pr "\n";
9260       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
9261       iteri (
9262         fun i col ->
9263           (match col with
9264            | name, FString ->
9265                pr "  v = caml_copy_string (%s->%s);\n" typ name
9266            | name, FBuffer ->
9267                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
9268                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
9269                  typ name typ name
9270            | name, FUUID ->
9271                pr "  v = caml_alloc_string (32);\n";
9272                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
9273            | name, (FBytes|FInt64|FUInt64) ->
9274                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
9275            | name, (FInt32|FUInt32) ->
9276                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
9277            | name, FOptPercent ->
9278                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
9279                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
9280                pr "    v = caml_alloc (1, 0);\n";
9281                pr "    Store_field (v, 0, v2);\n";
9282                pr "  } else /* None */\n";
9283                pr "    v = Val_int (0);\n";
9284            | name, FChar ->
9285                pr "  v = Val_int (%s->%s);\n" typ name
9286           );
9287           pr "  Store_field (rv, %d, v);\n" i
9288       ) cols;
9289       pr "  CAMLreturn (rv);\n";
9290       pr "}\n";
9291       pr "\n";
9292   ) structs;
9293
9294   (* Emit a copy_TYPE_list function definition only if that function is used. *)
9295   List.iter (
9296     function
9297     | typ, (RStructListOnly | RStructAndList) ->
9298         (* generate the function for typ *)
9299         emit_ocaml_copy_list_function typ
9300     | typ, _ -> () (* empty *)
9301   ) (rstructs_used_by all_functions);
9302
9303   (* The wrappers. *)
9304   List.iter (
9305     fun (name, style, _, _, _, _, _) ->
9306       pr "/* Automatically generated wrapper for function\n";
9307       pr " * ";
9308       generate_ocaml_prototype name style;
9309       pr " */\n";
9310       pr "\n";
9311
9312       let params =
9313         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
9314
9315       let needs_extra_vs =
9316         match fst style with RConstOptString _ -> true | _ -> false in
9317
9318       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
9319       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
9320       List.iter (pr ", value %s") (List.tl params); pr ");\n";
9321       pr "\n";
9322
9323       pr "CAMLprim value\n";
9324       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
9325       List.iter (pr ", value %s") (List.tl params);
9326       pr ")\n";
9327       pr "{\n";
9328
9329       (match params with
9330        | [p1; p2; p3; p4; p5] ->
9331            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
9332        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
9333            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
9334            pr "  CAMLxparam%d (%s);\n"
9335              (List.length rest) (String.concat ", " rest)
9336        | ps ->
9337            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
9338       );
9339       if not needs_extra_vs then
9340         pr "  CAMLlocal1 (rv);\n"
9341       else
9342         pr "  CAMLlocal3 (rv, v, v2);\n";
9343       pr "\n";
9344
9345       pr "  guestfs_h *g = Guestfs_val (gv);\n";
9346       pr "  if (g == NULL)\n";
9347       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
9348       pr "\n";
9349
9350       List.iter (
9351         function
9352         | Pathname n
9353         | Device n | Dev_or_Path n
9354         | String n
9355         | FileIn n
9356         | FileOut n
9357         | Key n ->
9358             (* Copy strings in case the GC moves them: RHBZ#604691 *)
9359             pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
9360         | OptString n ->
9361             pr "  char *%s =\n" n;
9362             pr "    %sv != Val_int (0) ?" n;
9363             pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
9364         | BufferIn n ->
9365             pr "  size_t %s_size = caml_string_length (%sv);\n" n n;
9366             pr "  char *%s = guestfs_safe_memdup (g, String_val (%sv), %s_size);\n" n n n
9367         | StringList n | DeviceList n ->
9368             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
9369         | Bool n ->
9370             pr "  int %s = Bool_val (%sv);\n" n n
9371         | Int n ->
9372             pr "  int %s = Int_val (%sv);\n" n n
9373         | Int64 n ->
9374             pr "  int64_t %s = Int64_val (%sv);\n" n n
9375       ) (snd style);
9376       let error_code =
9377         match fst style with
9378         | RErr -> pr "  int r;\n"; "-1"
9379         | RInt _ -> pr "  int r;\n"; "-1"
9380         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9381         | RBool _ -> pr "  int r;\n"; "-1"
9382         | RConstString _ | RConstOptString _ ->
9383             pr "  const char *r;\n"; "NULL"
9384         | RString _ -> pr "  char *r;\n"; "NULL"
9385         | RStringList _ ->
9386             pr "  size_t i;\n";
9387             pr "  char **r;\n";
9388             "NULL"
9389         | RStruct (_, typ) ->
9390             pr "  struct guestfs_%s *r;\n" typ; "NULL"
9391         | RStructList (_, typ) ->
9392             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9393         | RHashtable _ ->
9394             pr "  size_t i;\n";
9395             pr "  char **r;\n";
9396             "NULL"
9397         | RBufferOut _ ->
9398             pr "  char *r;\n";
9399             pr "  size_t size;\n";
9400             "NULL" in
9401       pr "\n";
9402
9403       pr "  caml_enter_blocking_section ();\n";
9404       pr "  r = guestfs_%s " name;
9405       generate_c_call_args ~handle:"g" style;
9406       pr ";\n";
9407       pr "  caml_leave_blocking_section ();\n";
9408
9409       (* Free strings if we copied them above. *)
9410       List.iter (
9411         function
9412         | Pathname n | Device n | Dev_or_Path n | String n | OptString n
9413         | FileIn n | FileOut n | BufferIn n | Key n ->
9414             pr "  free (%s);\n" n
9415         | StringList n | DeviceList n ->
9416             pr "  ocaml_guestfs_free_strings (%s);\n" n;
9417         | Bool _ | Int _ | Int64 _ -> ()
9418       ) (snd style);
9419
9420       pr "  if (r == %s)\n" error_code;
9421       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
9422       pr "\n";
9423
9424       (match fst style with
9425        | RErr -> pr "  rv = Val_unit;\n"
9426        | RInt _ -> pr "  rv = Val_int (r);\n"
9427        | RInt64 _ ->
9428            pr "  rv = caml_copy_int64 (r);\n"
9429        | RBool _ -> pr "  rv = Val_bool (r);\n"
9430        | RConstString _ ->
9431            pr "  rv = caml_copy_string (r);\n"
9432        | RConstOptString _ ->
9433            pr "  if (r) { /* Some string */\n";
9434            pr "    v = caml_alloc (1, 0);\n";
9435            pr "    v2 = caml_copy_string (r);\n";
9436            pr "    Store_field (v, 0, v2);\n";
9437            pr "  } else /* None */\n";
9438            pr "    v = Val_int (0);\n";
9439        | RString _ ->
9440            pr "  rv = caml_copy_string (r);\n";
9441            pr "  free (r);\n"
9442        | RStringList _ ->
9443            pr "  rv = caml_copy_string_array ((const char **) r);\n";
9444            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
9445            pr "  free (r);\n"
9446        | RStruct (_, typ) ->
9447            pr "  rv = copy_%s (r);\n" typ;
9448            pr "  guestfs_free_%s (r);\n" typ;
9449        | RStructList (_, typ) ->
9450            pr "  rv = copy_%s_list (r);\n" typ;
9451            pr "  guestfs_free_%s_list (r);\n" typ;
9452        | RHashtable _ ->
9453            pr "  rv = copy_table (r);\n";
9454            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
9455            pr "  free (r);\n";
9456        | RBufferOut _ ->
9457            pr "  rv = caml_alloc_string (size);\n";
9458            pr "  memcpy (String_val (rv), r, size);\n";
9459       );
9460
9461       pr "  CAMLreturn (rv);\n";
9462       pr "}\n";
9463       pr "\n";
9464
9465       if List.length params > 5 then (
9466         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
9467         pr "CAMLprim value ";
9468         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
9469         pr "CAMLprim value\n";
9470         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
9471         pr "{\n";
9472         pr "  return ocaml_guestfs_%s (argv[0]" name;
9473         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
9474         pr ");\n";
9475         pr "}\n";
9476         pr "\n"
9477       )
9478   ) all_functions_sorted
9479
9480 and generate_ocaml_structure_decls () =
9481   List.iter (
9482     fun (typ, cols) ->
9483       pr "type %s = {\n" typ;
9484       List.iter (
9485         function
9486         | name, FString -> pr "  %s : string;\n" name
9487         | name, FBuffer -> pr "  %s : string;\n" name
9488         | name, FUUID -> pr "  %s : string;\n" name
9489         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
9490         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
9491         | name, FChar -> pr "  %s : char;\n" name
9492         | name, FOptPercent -> pr "  %s : float option;\n" name
9493       ) cols;
9494       pr "}\n";
9495       pr "\n"
9496   ) structs
9497
9498 and generate_ocaml_prototype ?(is_external = false) name style =
9499   if is_external then pr "external " else pr "val ";
9500   pr "%s : t -> " name;
9501   List.iter (
9502     function
9503     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _
9504     | BufferIn _ | Key _ -> pr "string -> "
9505     | OptString _ -> pr "string option -> "
9506     | StringList _ | DeviceList _ -> pr "string array -> "
9507     | Bool _ -> pr "bool -> "
9508     | Int _ -> pr "int -> "
9509     | Int64 _ -> pr "int64 -> "
9510   ) (snd style);
9511   (match fst style with
9512    | RErr -> pr "unit" (* all errors are turned into exceptions *)
9513    | RInt _ -> pr "int"
9514    | RInt64 _ -> pr "int64"
9515    | RBool _ -> pr "bool"
9516    | RConstString _ -> pr "string"
9517    | RConstOptString _ -> pr "string option"
9518    | RString _ | RBufferOut _ -> pr "string"
9519    | RStringList _ -> pr "string array"
9520    | RStruct (_, typ) -> pr "%s" typ
9521    | RStructList (_, typ) -> pr "%s array" typ
9522    | RHashtable _ -> pr "(string * string) list"
9523   );
9524   if is_external then (
9525     pr " = ";
9526     if List.length (snd style) + 1 > 5 then
9527       pr "\"ocaml_guestfs_%s_byte\" " name;
9528     pr "\"ocaml_guestfs_%s\"" name
9529   );
9530   pr "\n"
9531
9532 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
9533 and generate_perl_xs () =
9534   generate_header CStyle LGPLv2plus;
9535
9536   pr "\
9537 #include \"EXTERN.h\"
9538 #include \"perl.h\"
9539 #include \"XSUB.h\"
9540
9541 #include <guestfs.h>
9542
9543 #ifndef PRId64
9544 #define PRId64 \"lld\"
9545 #endif
9546
9547 static SV *
9548 my_newSVll(long long val) {
9549 #ifdef USE_64_BIT_ALL
9550   return newSViv(val);
9551 #else
9552   char buf[100];
9553   int len;
9554   len = snprintf(buf, 100, \"%%\" PRId64, val);
9555   return newSVpv(buf, len);
9556 #endif
9557 }
9558
9559 #ifndef PRIu64
9560 #define PRIu64 \"llu\"
9561 #endif
9562
9563 static SV *
9564 my_newSVull(unsigned long long val) {
9565 #ifdef USE_64_BIT_ALL
9566   return newSVuv(val);
9567 #else
9568   char buf[100];
9569   int len;
9570   len = snprintf(buf, 100, \"%%\" PRIu64, val);
9571   return newSVpv(buf, len);
9572 #endif
9573 }
9574
9575 /* http://www.perlmonks.org/?node_id=680842 */
9576 static char **
9577 XS_unpack_charPtrPtr (SV *arg) {
9578   char **ret;
9579   AV *av;
9580   I32 i;
9581
9582   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
9583     croak (\"array reference expected\");
9584
9585   av = (AV *)SvRV (arg);
9586   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
9587   if (!ret)
9588     croak (\"malloc failed\");
9589
9590   for (i = 0; i <= av_len (av); i++) {
9591     SV **elem = av_fetch (av, i, 0);
9592
9593     if (!elem || !*elem)
9594       croak (\"missing element in list\");
9595
9596     ret[i] = SvPV_nolen (*elem);
9597   }
9598
9599   ret[i] = NULL;
9600
9601   return ret;
9602 }
9603
9604 #define PROGRESS_KEY \"_perl_progress_cb\"
9605
9606 static void
9607 _clear_progress_callback (guestfs_h *g)
9608 {
9609   guestfs_set_progress_callback (g, NULL, NULL);
9610   SV *cb = guestfs_get_private (g, PROGRESS_KEY);
9611   if (cb) {
9612     guestfs_set_private (g, PROGRESS_KEY, NULL);
9613     SvREFCNT_dec (cb);
9614   }
9615 }
9616
9617 /* http://www.perlmonks.org/?node=338857 */
9618 static void
9619 _progress_callback (guestfs_h *g, void *cb,
9620                     int proc_nr, int serial, uint64_t position, uint64_t total)
9621 {
9622   dSP;
9623   ENTER;
9624   SAVETMPS;
9625   PUSHMARK (SP);
9626   XPUSHs (sv_2mortal (newSViv (proc_nr)));
9627   XPUSHs (sv_2mortal (newSViv (serial)));
9628   XPUSHs (sv_2mortal (my_newSVull (position)));
9629   XPUSHs (sv_2mortal (my_newSVull (total)));
9630   PUTBACK;
9631   call_sv ((SV *) cb, G_VOID | G_DISCARD | G_EVAL);
9632   FREETMPS;
9633   LEAVE;
9634 }
9635
9636 static void
9637 _close_handle (guestfs_h *g)
9638 {
9639   assert (g != NULL);
9640   _clear_progress_callback (g);
9641   guestfs_close (g);
9642 }
9643
9644 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
9645
9646 PROTOTYPES: ENABLE
9647
9648 guestfs_h *
9649 _create ()
9650    CODE:
9651       RETVAL = guestfs_create ();
9652       if (!RETVAL)
9653         croak (\"could not create guestfs handle\");
9654       guestfs_set_error_handler (RETVAL, NULL, NULL);
9655  OUTPUT:
9656       RETVAL
9657
9658 void
9659 DESTROY (sv)
9660       SV *sv;
9661  PPCODE:
9662       /* For the 'g' argument above we do the conversion explicitly and
9663        * don't rely on the typemap, because if the handle has been
9664        * explicitly closed we don't want the typemap conversion to
9665        * display an error.
9666        */
9667       HV *hv = (HV *) SvRV (sv);
9668       SV **svp = hv_fetch (hv, \"_g\", 2, 0);
9669       if (svp != NULL) {
9670         guestfs_h *g = (guestfs_h *) SvIV (*svp);
9671         _close_handle (g);
9672       }
9673
9674 void
9675 close (g)
9676       guestfs_h *g;
9677  PPCODE:
9678       _close_handle (g);
9679       /* Avoid double-free in DESTROY method. */
9680       HV *hv = (HV *) SvRV (ST(0));
9681       (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
9682
9683 void
9684 set_progress_callback (g, cb)
9685       guestfs_h *g;
9686       SV *cb;
9687  PPCODE:
9688       _clear_progress_callback (g);
9689       SvREFCNT_inc (cb);
9690       guestfs_set_private (g, PROGRESS_KEY, cb);
9691       guestfs_set_progress_callback (g, _progress_callback, cb);
9692
9693 void
9694 clear_progress_callback (g)
9695       guestfs_h *g;
9696  PPCODE:
9697       _clear_progress_callback (g);
9698
9699 ";
9700
9701   List.iter (
9702     fun (name, style, _, _, _, _, _) ->
9703       (match fst style with
9704        | RErr -> pr "void\n"
9705        | RInt _ -> pr "SV *\n"
9706        | RInt64 _ -> pr "SV *\n"
9707        | RBool _ -> pr "SV *\n"
9708        | RConstString _ -> pr "SV *\n"
9709        | RConstOptString _ -> pr "SV *\n"
9710        | RString _ -> pr "SV *\n"
9711        | RBufferOut _ -> pr "SV *\n"
9712        | RStringList _
9713        | RStruct _ | RStructList _
9714        | RHashtable _ ->
9715            pr "void\n" (* all lists returned implictly on the stack *)
9716       );
9717       (* Call and arguments. *)
9718       pr "%s (g" name;
9719       List.iter (
9720         fun arg -> pr ", %s" (name_of_argt arg)
9721       ) (snd style);
9722       pr ")\n";
9723       pr "      guestfs_h *g;\n";
9724       iteri (
9725         fun i ->
9726           function
9727           | Pathname n | Device n | Dev_or_Path n | String n
9728           | FileIn n | FileOut n | Key n ->
9729               pr "      char *%s;\n" n
9730           | BufferIn n ->
9731               pr "      char *%s;\n" n;
9732               pr "      size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
9733           | OptString n ->
9734               (* http://www.perlmonks.org/?node_id=554277
9735                * Note that the implicit handle argument means we have
9736                * to add 1 to the ST(x) operator.
9737                *)
9738               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
9739           | StringList n | DeviceList n -> pr "      char **%s;\n" n
9740           | Bool n -> pr "      int %s;\n" n
9741           | Int n -> pr "      int %s;\n" n
9742           | Int64 n -> pr "      int64_t %s;\n" n
9743       ) (snd style);
9744
9745       let do_cleanups () =
9746         List.iter (
9747           function
9748           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
9749           | Bool _ | Int _ | Int64 _
9750           | FileIn _ | FileOut _
9751           | BufferIn _ | Key _ -> ()
9752           | StringList n | DeviceList n -> pr "      free (%s);\n" n
9753         ) (snd style)
9754       in
9755
9756       (* Code. *)
9757       (match fst style with
9758        | RErr ->
9759            pr "PREINIT:\n";
9760            pr "      int r;\n";
9761            pr " PPCODE:\n";
9762            pr "      r = guestfs_%s " name;
9763            generate_c_call_args ~handle:"g" style;
9764            pr ";\n";
9765            do_cleanups ();
9766            pr "      if (r == -1)\n";
9767            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9768        | RInt n
9769        | RBool n ->
9770            pr "PREINIT:\n";
9771            pr "      int %s;\n" n;
9772            pr "   CODE:\n";
9773            pr "      %s = guestfs_%s " n name;
9774            generate_c_call_args ~handle:"g" style;
9775            pr ";\n";
9776            do_cleanups ();
9777            pr "      if (%s == -1)\n" n;
9778            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9779            pr "      RETVAL = newSViv (%s);\n" n;
9780            pr " OUTPUT:\n";
9781            pr "      RETVAL\n"
9782        | RInt64 n ->
9783            pr "PREINIT:\n";
9784            pr "      int64_t %s;\n" n;
9785            pr "   CODE:\n";
9786            pr "      %s = guestfs_%s " n name;
9787            generate_c_call_args ~handle:"g" style;
9788            pr ";\n";
9789            do_cleanups ();
9790            pr "      if (%s == -1)\n" n;
9791            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9792            pr "      RETVAL = my_newSVll (%s);\n" n;
9793            pr " OUTPUT:\n";
9794            pr "      RETVAL\n"
9795        | RConstString n ->
9796            pr "PREINIT:\n";
9797            pr "      const char *%s;\n" n;
9798            pr "   CODE:\n";
9799            pr "      %s = guestfs_%s " n name;
9800            generate_c_call_args ~handle:"g" style;
9801            pr ";\n";
9802            do_cleanups ();
9803            pr "      if (%s == NULL)\n" n;
9804            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9805            pr "      RETVAL = newSVpv (%s, 0);\n" n;
9806            pr " OUTPUT:\n";
9807            pr "      RETVAL\n"
9808        | RConstOptString n ->
9809            pr "PREINIT:\n";
9810            pr "      const char *%s;\n" n;
9811            pr "   CODE:\n";
9812            pr "      %s = guestfs_%s " n name;
9813            generate_c_call_args ~handle:"g" style;
9814            pr ";\n";
9815            do_cleanups ();
9816            pr "      if (%s == NULL)\n" n;
9817            pr "        RETVAL = &PL_sv_undef;\n";
9818            pr "      else\n";
9819            pr "        RETVAL = newSVpv (%s, 0);\n" n;
9820            pr " OUTPUT:\n";
9821            pr "      RETVAL\n"
9822        | RString n ->
9823            pr "PREINIT:\n";
9824            pr "      char *%s;\n" n;
9825            pr "   CODE:\n";
9826            pr "      %s = guestfs_%s " n name;
9827            generate_c_call_args ~handle:"g" style;
9828            pr ";\n";
9829            do_cleanups ();
9830            pr "      if (%s == NULL)\n" n;
9831            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9832            pr "      RETVAL = newSVpv (%s, 0);\n" n;
9833            pr "      free (%s);\n" n;
9834            pr " OUTPUT:\n";
9835            pr "      RETVAL\n"
9836        | RStringList n | RHashtable n ->
9837            pr "PREINIT:\n";
9838            pr "      char **%s;\n" n;
9839            pr "      size_t i, n;\n";
9840            pr " PPCODE:\n";
9841            pr "      %s = guestfs_%s " n name;
9842            generate_c_call_args ~handle:"g" style;
9843            pr ";\n";
9844            do_cleanups ();
9845            pr "      if (%s == NULL)\n" n;
9846            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9847            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
9848            pr "      EXTEND (SP, n);\n";
9849            pr "      for (i = 0; i < n; ++i) {\n";
9850            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
9851            pr "        free (%s[i]);\n" n;
9852            pr "      }\n";
9853            pr "      free (%s);\n" n;
9854        | RStruct (n, typ) ->
9855            let cols = cols_of_struct typ in
9856            generate_perl_struct_code typ cols name style n do_cleanups
9857        | RStructList (n, typ) ->
9858            let cols = cols_of_struct typ in
9859            generate_perl_struct_list_code typ cols name style n do_cleanups
9860        | RBufferOut n ->
9861            pr "PREINIT:\n";
9862            pr "      char *%s;\n" n;
9863            pr "      size_t size;\n";
9864            pr "   CODE:\n";
9865            pr "      %s = guestfs_%s " n name;
9866            generate_c_call_args ~handle:"g" style;
9867            pr ";\n";
9868            do_cleanups ();
9869            pr "      if (%s == NULL)\n" n;
9870            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9871            pr "      RETVAL = newSVpvn (%s, size);\n" n;
9872            pr "      free (%s);\n" n;
9873            pr " OUTPUT:\n";
9874            pr "      RETVAL\n"
9875       );
9876
9877       pr "\n"
9878   ) all_functions
9879
9880 and generate_perl_struct_list_code typ cols name style n do_cleanups =
9881   pr "PREINIT:\n";
9882   pr "      struct guestfs_%s_list *%s;\n" typ n;
9883   pr "      size_t i;\n";
9884   pr "      HV *hv;\n";
9885   pr " PPCODE:\n";
9886   pr "      %s = guestfs_%s " n name;
9887   generate_c_call_args ~handle:"g" style;
9888   pr ";\n";
9889   do_cleanups ();
9890   pr "      if (%s == NULL)\n" n;
9891   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9892   pr "      EXTEND (SP, %s->len);\n" n;
9893   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
9894   pr "        hv = newHV ();\n";
9895   List.iter (
9896     function
9897     | name, FString ->
9898         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
9899           name (String.length name) n name
9900     | name, FUUID ->
9901         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
9902           name (String.length name) n name
9903     | name, FBuffer ->
9904         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
9905           name (String.length name) n name n name
9906     | name, (FBytes|FUInt64) ->
9907         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
9908           name (String.length name) n name
9909     | name, FInt64 ->
9910         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
9911           name (String.length name) n name
9912     | name, (FInt32|FUInt32) ->
9913         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
9914           name (String.length name) n name
9915     | name, FChar ->
9916         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
9917           name (String.length name) n name
9918     | name, FOptPercent ->
9919         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
9920           name (String.length name) n name
9921   ) cols;
9922   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
9923   pr "      }\n";
9924   pr "      guestfs_free_%s_list (%s);\n" typ n
9925
9926 and generate_perl_struct_code typ cols name style n do_cleanups =
9927   pr "PREINIT:\n";
9928   pr "      struct guestfs_%s *%s;\n" typ n;
9929   pr " PPCODE:\n";
9930   pr "      %s = guestfs_%s " n name;
9931   generate_c_call_args ~handle:"g" style;
9932   pr ";\n";
9933   do_cleanups ();
9934   pr "      if (%s == NULL)\n" n;
9935   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
9936   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
9937   List.iter (
9938     fun ((name, _) as col) ->
9939       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
9940
9941       match col with
9942       | name, FString ->
9943           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
9944             n name
9945       | name, FBuffer ->
9946           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
9947             n name n name
9948       | name, FUUID ->
9949           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
9950             n name
9951       | name, (FBytes|FUInt64) ->
9952           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
9953             n name
9954       | name, FInt64 ->
9955           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
9956             n name
9957       | name, (FInt32|FUInt32) ->
9958           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
9959             n name
9960       | name, FChar ->
9961           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
9962             n name
9963       | name, FOptPercent ->
9964           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
9965             n name
9966   ) cols;
9967   pr "      free (%s);\n" n
9968
9969 (* Generate Sys/Guestfs.pm. *)
9970 and generate_perl_pm () =
9971   generate_header HashStyle LGPLv2plus;
9972
9973   pr "\
9974 =pod
9975
9976 =head1 NAME
9977
9978 Sys::Guestfs - Perl bindings for libguestfs
9979
9980 =head1 SYNOPSIS
9981
9982  use Sys::Guestfs;
9983
9984  my $h = Sys::Guestfs->new ();
9985  $h->add_drive ('guest.img');
9986  $h->launch ();
9987  $h->mount ('/dev/sda1', '/');
9988  $h->touch ('/hello');
9989  $h->sync ();
9990
9991 =head1 DESCRIPTION
9992
9993 The C<Sys::Guestfs> module provides a Perl XS binding to the
9994 libguestfs API for examining and modifying virtual machine
9995 disk images.
9996
9997 Amongst the things this is good for: making batch configuration
9998 changes to guests, getting disk used/free statistics (see also:
9999 virt-df), migrating between virtualization systems (see also:
10000 virt-p2v), performing partial backups, performing partial guest
10001 clones, cloning guests and changing registry/UUID/hostname info, and
10002 much else besides.
10003
10004 Libguestfs uses Linux kernel and qemu code, and can access any type of
10005 guest filesystem that Linux and qemu can, including but not limited
10006 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
10007 schemes, qcow, qcow2, vmdk.
10008
10009 Libguestfs provides ways to enumerate guest storage (eg. partitions,
10010 LVs, what filesystem is in each LV, etc.).  It can also run commands
10011 in the context of the guest.  Also you can access filesystems over
10012 FUSE.
10013
10014 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
10015 functions for using libguestfs from Perl, including integration
10016 with libvirt.
10017
10018 =head1 ERRORS
10019
10020 All errors turn into calls to C<croak> (see L<Carp(3)>).
10021
10022 =head1 METHODS
10023
10024 =over 4
10025
10026 =cut
10027
10028 package Sys::Guestfs;
10029
10030 use strict;
10031 use warnings;
10032
10033 # This version number changes whenever a new function
10034 # is added to the libguestfs API.  It is not directly
10035 # related to the libguestfs version number.
10036 use vars qw($VERSION);
10037 $VERSION = '0.%d';
10038
10039 require XSLoader;
10040 XSLoader::load ('Sys::Guestfs');
10041
10042 =item $h = Sys::Guestfs->new ();
10043
10044 Create a new guestfs handle.
10045
10046 =cut
10047
10048 sub new {
10049   my $proto = shift;
10050   my $class = ref ($proto) || $proto;
10051
10052   my $g = Sys::Guestfs::_create ();
10053   my $self = { _g => $g };
10054   bless $self, $class;
10055   return $self;
10056 }
10057
10058 =item $h->close ();
10059
10060 Explicitly close the guestfs handle.
10061
10062 B<Note:> You should not usually call this function.  The handle will
10063 be closed implicitly when its reference count goes to zero (eg.
10064 when it goes out of scope or the program ends).  This call is
10065 only required in some exceptional cases, such as where the program
10066 may contain cached references to the handle 'somewhere' and you
10067 really have to have the close happen right away.  After calling
10068 C<close> the program must not call any method (including C<close>)
10069 on the handle (but the implicit call to C<DESTROY> that happens
10070 when the final reference is cleaned up is OK).
10071
10072 =item $h->set_progress_callback (\\&cb);
10073
10074 Set the progress notification callback for this handle
10075 to the Perl closure C<cb>.
10076
10077 C<cb> will be called whenever a long-running operation
10078 generates a progress notification message.  The 4 parameters
10079 to the function are: C<proc_nr>, C<serial>, C<position>
10080 and C<total>.
10081
10082 You should carefully read the documentation for
10083 L<guestfs(3)/guestfs_set_progress_callback> before using
10084 this function.
10085
10086 =item $h->clear_progress_callback ();
10087
10088 This removes any progress callback function associated with
10089 the handle.
10090
10091 =cut
10092
10093 " max_proc_nr;
10094
10095   (* Actions.  We only need to print documentation for these as
10096    * they are pulled in from the XS code automatically.
10097    *)
10098   List.iter (
10099     fun (name, style, _, flags, _, _, longdesc) ->
10100       if not (List.mem NotInDocs flags) then (
10101         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
10102         pr "=item ";
10103         generate_perl_prototype name style;
10104         pr "\n\n";
10105         pr "%s\n\n" longdesc;
10106         if List.mem ProtocolLimitWarning flags then
10107           pr "%s\n\n" protocol_limit_warning;
10108         if List.mem DangerWillRobinson flags then
10109           pr "%s\n\n" danger_will_robinson;
10110         match deprecation_notice flags with
10111         | None -> ()
10112         | Some txt -> pr "%s\n\n" txt
10113       )
10114   ) all_functions_sorted;
10115
10116   (* End of file. *)
10117   pr "\
10118 =cut
10119
10120 1;
10121
10122 =back
10123
10124 =head1 AVAILABILITY
10125
10126 From time to time we add new libguestfs APIs.  Also some libguestfs
10127 APIs won't be available in all builds of libguestfs (the Fedora
10128 build is full-featured, but other builds may disable features).
10129 How do you test whether the APIs that your Perl program needs are
10130 available in the version of C<Sys::Guestfs> that you are using?
10131
10132 To test if a particular function is available in the C<Sys::Guestfs>
10133 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
10134 (see L<perlobj(1)>).  For example:
10135
10136  use Sys::Guestfs;
10137  if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
10138    print \"\\$h->set_verbose is available\\n\";
10139  }
10140
10141 To test if particular features are supported by the current
10142 build, use the L</available> method like the example below.  Note
10143 that the appliance must be launched first.
10144
10145  $h->available ( [\"augeas\"] );
10146
10147 Since the L</available> method croaks if the feature is not supported,
10148 you might also want to wrap this in an eval and return a boolean.
10149 In fact this has already been done for you: use
10150 L<Sys::Guestfs::Lib(3)/feature_available>.
10151
10152 For further discussion on this topic, refer to
10153 L<guestfs(3)/AVAILABILITY>.
10154
10155 =head1 STORING DATA IN THE HANDLE
10156
10157 The handle returned from L</new> is a hash reference.  The hash
10158 normally contains a single element:
10159
10160  {
10161    _g => [private data used by libguestfs]
10162  }
10163
10164 Callers can add other elements to this hash to store data for their own
10165 purposes.  The data lasts for the lifetime of the handle.
10166
10167 Any fields whose names begin with an underscore are reserved
10168 for private use by libguestfs.  We may add more in future.
10169
10170 It is recommended that callers prefix the name of their field(s)
10171 with some unique string, to avoid conflicts with other users.
10172
10173 =head1 COPYRIGHT
10174
10175 Copyright (C) %s Red Hat Inc.
10176
10177 =head1 LICENSE
10178
10179 Please see the file COPYING.LIB for the full license.
10180
10181 =head1 SEE ALSO
10182
10183 L<guestfs(3)>,
10184 L<guestfish(1)>,
10185 L<http://libguestfs.org>,
10186 L<Sys::Guestfs::Lib(3)>.
10187
10188 =cut
10189 " copyright_years
10190
10191 and generate_perl_prototype name style =
10192   (match fst style with
10193    | RErr -> ()
10194    | RBool n
10195    | RInt n
10196    | RInt64 n
10197    | RConstString n
10198    | RConstOptString n
10199    | RString n
10200    | RBufferOut n -> pr "$%s = " n
10201    | RStruct (n,_)
10202    | RHashtable n -> pr "%%%s = " n
10203    | RStringList n
10204    | RStructList (n,_) -> pr "@%s = " n
10205   );
10206   pr "$h->%s (" name;
10207   let comma = ref false in
10208   List.iter (
10209     fun arg ->
10210       if !comma then pr ", ";
10211       comma := true;
10212       match arg with
10213       | Pathname n | Device n | Dev_or_Path n | String n
10214       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
10215       | BufferIn n | Key n ->
10216           pr "$%s" n
10217       | StringList n | DeviceList n ->
10218           pr "\\@%s" n
10219   ) (snd style);
10220   pr ");"
10221
10222 (* Generate Python C module. *)
10223 and generate_python_c () =
10224   generate_header CStyle LGPLv2plus;
10225
10226   pr "\
10227 #define PY_SSIZE_T_CLEAN 1
10228 #include <Python.h>
10229
10230 #if PY_VERSION_HEX < 0x02050000
10231 typedef int Py_ssize_t;
10232 #define PY_SSIZE_T_MAX INT_MAX
10233 #define PY_SSIZE_T_MIN INT_MIN
10234 #endif
10235
10236 #include <stdio.h>
10237 #include <stdlib.h>
10238 #include <assert.h>
10239
10240 #include \"guestfs.h\"
10241
10242 #ifndef HAVE_PYCAPSULE_NEW
10243 typedef struct {
10244   PyObject_HEAD
10245   guestfs_h *g;
10246 } Pyguestfs_Object;
10247 #endif
10248
10249 static guestfs_h *
10250 get_handle (PyObject *obj)
10251 {
10252   assert (obj);
10253   assert (obj != Py_None);
10254 #ifndef HAVE_PYCAPSULE_NEW
10255   return ((Pyguestfs_Object *) obj)->g;
10256 #else
10257   return (guestfs_h*) PyCapsule_GetPointer(obj, \"guestfs_h\");
10258 #endif
10259 }
10260
10261 static PyObject *
10262 put_handle (guestfs_h *g)
10263 {
10264   assert (g);
10265 #ifndef HAVE_PYCAPSULE_NEW
10266   return
10267     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
10268 #else
10269   return PyCapsule_New ((void *) g, \"guestfs_h\", NULL);
10270 #endif
10271 }
10272
10273 /* This list should be freed (but not the strings) after use. */
10274 static char **
10275 get_string_list (PyObject *obj)
10276 {
10277   size_t i, len;
10278   char **r;
10279
10280   assert (obj);
10281
10282   if (!PyList_Check (obj)) {
10283     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
10284     return NULL;
10285   }
10286
10287   Py_ssize_t slen = PyList_Size (obj);
10288   if (slen == -1) {
10289     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
10290     return NULL;
10291   }
10292   len = (size_t) slen;
10293   r = malloc (sizeof (char *) * (len+1));
10294   if (r == NULL) {
10295     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
10296     return NULL;
10297   }
10298
10299   for (i = 0; i < len; ++i)
10300     r[i] = PyString_AsString (PyList_GetItem (obj, i));
10301   r[len] = NULL;
10302
10303   return r;
10304 }
10305
10306 static PyObject *
10307 put_string_list (char * const * const argv)
10308 {
10309   PyObject *list;
10310   int argc, i;
10311
10312   for (argc = 0; argv[argc] != NULL; ++argc)
10313     ;
10314
10315   list = PyList_New (argc);
10316   for (i = 0; i < argc; ++i)
10317     PyList_SetItem (list, i, PyString_FromString (argv[i]));
10318
10319   return list;
10320 }
10321
10322 static PyObject *
10323 put_table (char * const * const argv)
10324 {
10325   PyObject *list, *item;
10326   int argc, i;
10327
10328   for (argc = 0; argv[argc] != NULL; ++argc)
10329     ;
10330
10331   list = PyList_New (argc >> 1);
10332   for (i = 0; i < argc; i += 2) {
10333     item = PyTuple_New (2);
10334     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
10335     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
10336     PyList_SetItem (list, i >> 1, item);
10337   }
10338
10339   return list;
10340 }
10341
10342 static void
10343 free_strings (char **argv)
10344 {
10345   int argc;
10346
10347   for (argc = 0; argv[argc] != NULL; ++argc)
10348     free (argv[argc]);
10349   free (argv);
10350 }
10351
10352 static PyObject *
10353 py_guestfs_create (PyObject *self, PyObject *args)
10354 {
10355   guestfs_h *g;
10356
10357   g = guestfs_create ();
10358   if (g == NULL) {
10359     PyErr_SetString (PyExc_RuntimeError,
10360                      \"guestfs.create: failed to allocate handle\");
10361     return NULL;
10362   }
10363   guestfs_set_error_handler (g, NULL, NULL);
10364   /* This can return NULL, but in that case put_handle will have
10365    * set the Python error string.
10366    */
10367   return put_handle (g);
10368 }
10369
10370 static PyObject *
10371 py_guestfs_close (PyObject *self, PyObject *args)
10372 {
10373   PyObject *py_g;
10374   guestfs_h *g;
10375
10376   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
10377     return NULL;
10378   g = get_handle (py_g);
10379
10380   guestfs_close (g);
10381
10382   Py_INCREF (Py_None);
10383   return Py_None;
10384 }
10385
10386 ";
10387
10388   let emit_put_list_function typ =
10389     pr "static PyObject *\n";
10390     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
10391     pr "{\n";
10392     pr "  PyObject *list;\n";
10393     pr "  size_t i;\n";
10394     pr "\n";
10395     pr "  list = PyList_New (%ss->len);\n" typ;
10396     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
10397     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
10398     pr "  return list;\n";
10399     pr "};\n";
10400     pr "\n"
10401   in
10402
10403   (* Structures, turned into Python dictionaries. *)
10404   List.iter (
10405     fun (typ, cols) ->
10406       pr "static PyObject *\n";
10407       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
10408       pr "{\n";
10409       pr "  PyObject *dict;\n";
10410       pr "\n";
10411       pr "  dict = PyDict_New ();\n";
10412       List.iter (
10413         function
10414         | name, FString ->
10415             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10416             pr "                        PyString_FromString (%s->%s));\n"
10417               typ name
10418         | name, FBuffer ->
10419             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10420             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
10421               typ name typ name
10422         | name, FUUID ->
10423             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10424             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
10425               typ name
10426         | name, (FBytes|FUInt64) ->
10427             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10428             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
10429               typ name
10430         | name, FInt64 ->
10431             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10432             pr "                        PyLong_FromLongLong (%s->%s));\n"
10433               typ name
10434         | name, FUInt32 ->
10435             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10436             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
10437               typ name
10438         | name, FInt32 ->
10439             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10440             pr "                        PyLong_FromLong (%s->%s));\n"
10441               typ name
10442         | name, FOptPercent ->
10443             pr "  if (%s->%s >= 0)\n" typ name;
10444             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
10445             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
10446               typ name;
10447             pr "  else {\n";
10448             pr "    Py_INCREF (Py_None);\n";
10449             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
10450             pr "  }\n"
10451         | name, FChar ->
10452             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
10453             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
10454       ) cols;
10455       pr "  return dict;\n";
10456       pr "};\n";
10457       pr "\n";
10458
10459   ) structs;
10460
10461   (* Emit a put_TYPE_list function definition only if that function is used. *)
10462   List.iter (
10463     function
10464     | typ, (RStructListOnly | RStructAndList) ->
10465         (* generate the function for typ *)
10466         emit_put_list_function typ
10467     | typ, _ -> () (* empty *)
10468   ) (rstructs_used_by all_functions);
10469
10470   (* Python wrapper functions. *)
10471   List.iter (
10472     fun (name, style, _, _, _, _, _) ->
10473       pr "static PyObject *\n";
10474       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
10475       pr "{\n";
10476
10477       pr "  PyObject *py_g;\n";
10478       pr "  guestfs_h *g;\n";
10479       pr "  PyObject *py_r;\n";
10480
10481       let error_code =
10482         match fst style with
10483         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
10484         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
10485         | RConstString _ | RConstOptString _ ->
10486             pr "  const char *r;\n"; "NULL"
10487         | RString _ -> pr "  char *r;\n"; "NULL"
10488         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
10489         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
10490         | RStructList (_, typ) ->
10491             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
10492         | RBufferOut _ ->
10493             pr "  char *r;\n";
10494             pr "  size_t size;\n";
10495             "NULL" in
10496
10497       List.iter (
10498         function
10499         | Pathname n | Device n | Dev_or_Path n | String n | Key n
10500         | FileIn n | FileOut n ->
10501             pr "  const char *%s;\n" n
10502         | OptString n -> pr "  const char *%s;\n" n
10503         | BufferIn n ->
10504             pr "  const char *%s;\n" n;
10505             pr "  Py_ssize_t %s_size;\n" n
10506         | StringList n | DeviceList n ->
10507             pr "  PyObject *py_%s;\n" n;
10508             pr "  char **%s;\n" n
10509         | Bool n -> pr "  int %s;\n" n
10510         | Int n -> pr "  int %s;\n" n
10511         | Int64 n -> pr "  long long %s;\n" n
10512       ) (snd style);
10513
10514       pr "\n";
10515
10516       (* Convert the parameters. *)
10517       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
10518       List.iter (
10519         function
10520         | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
10521         | FileIn _ | FileOut _ -> pr "s"
10522         | OptString _ -> pr "z"
10523         | StringList _ | DeviceList _ -> pr "O"
10524         | Bool _ -> pr "i" (* XXX Python has booleans? *)
10525         | Int _ -> pr "i"
10526         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
10527                              * emulate C's int/long/long long in Python?
10528                              *)
10529         | BufferIn _ -> pr "s#"
10530       ) (snd style);
10531       pr ":guestfs_%s\",\n" name;
10532       pr "                         &py_g";
10533       List.iter (
10534         function
10535         | Pathname n | Device n | Dev_or_Path n | String n | Key n
10536         | FileIn n | FileOut n -> pr ", &%s" n
10537         | OptString n -> pr ", &%s" n
10538         | StringList n | DeviceList n -> pr ", &py_%s" n
10539         | Bool n -> pr ", &%s" n
10540         | Int n -> pr ", &%s" n
10541         | Int64 n -> pr ", &%s" n
10542         | BufferIn n -> pr ", &%s, &%s_size" n n
10543       ) (snd style);
10544
10545       pr "))\n";
10546       pr "    return NULL;\n";
10547
10548       pr "  g = get_handle (py_g);\n";
10549       List.iter (
10550         function
10551         | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
10552         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
10553         | BufferIn _ -> ()
10554         | StringList n | DeviceList n ->
10555             pr "  %s = get_string_list (py_%s);\n" n n;
10556             pr "  if (!%s) return NULL;\n" n
10557       ) (snd style);
10558
10559       pr "\n";
10560
10561       pr "  r = guestfs_%s " name;
10562       generate_c_call_args ~handle:"g" style;
10563       pr ";\n";
10564
10565       List.iter (
10566         function
10567         | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
10568         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
10569         | BufferIn _ -> ()
10570         | StringList n | DeviceList n ->
10571             pr "  free (%s);\n" n
10572       ) (snd style);
10573
10574       pr "  if (r == %s) {\n" error_code;
10575       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
10576       pr "    return NULL;\n";
10577       pr "  }\n";
10578       pr "\n";
10579
10580       (match fst style with
10581        | RErr ->
10582            pr "  Py_INCREF (Py_None);\n";
10583            pr "  py_r = Py_None;\n"
10584        | RInt _
10585        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
10586        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
10587        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
10588        | RConstOptString _ ->
10589            pr "  if (r)\n";
10590            pr "    py_r = PyString_FromString (r);\n";
10591            pr "  else {\n";
10592            pr "    Py_INCREF (Py_None);\n";
10593            pr "    py_r = Py_None;\n";
10594            pr "  }\n"
10595        | RString _ ->
10596            pr "  py_r = PyString_FromString (r);\n";
10597            pr "  free (r);\n"
10598        | RStringList _ ->
10599            pr "  py_r = put_string_list (r);\n";
10600            pr "  free_strings (r);\n"
10601        | RStruct (_, typ) ->
10602            pr "  py_r = put_%s (r);\n" typ;
10603            pr "  guestfs_free_%s (r);\n" typ
10604        | RStructList (_, typ) ->
10605            pr "  py_r = put_%s_list (r);\n" typ;
10606            pr "  guestfs_free_%s_list (r);\n" typ
10607        | RHashtable n ->
10608            pr "  py_r = put_table (r);\n";
10609            pr "  free_strings (r);\n"
10610        | RBufferOut _ ->
10611            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
10612            pr "  free (r);\n"
10613       );
10614
10615       pr "  return py_r;\n";
10616       pr "}\n";
10617       pr "\n"
10618   ) all_functions;
10619
10620   (* Table of functions. *)
10621   pr "static PyMethodDef methods[] = {\n";
10622   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
10623   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
10624   List.iter (
10625     fun (name, _, _, _, _, _, _) ->
10626       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
10627         name name
10628   ) all_functions;
10629   pr "  { NULL, NULL, 0, NULL }\n";
10630   pr "};\n";
10631   pr "\n";
10632
10633   (* Init function. *)
10634   pr "\
10635 void
10636 initlibguestfsmod (void)
10637 {
10638   static int initialized = 0;
10639
10640   if (initialized) return;
10641   Py_InitModule ((char *) \"libguestfsmod\", methods);
10642   initialized = 1;
10643 }
10644 "
10645
10646 (* Generate Python module. *)
10647 and generate_python_py () =
10648   generate_header HashStyle LGPLv2plus;
10649
10650   pr "\
10651 u\"\"\"Python bindings for libguestfs
10652
10653 import guestfs
10654 g = guestfs.GuestFS ()
10655 g.add_drive (\"guest.img\")
10656 g.launch ()
10657 parts = g.list_partitions ()
10658
10659 The guestfs module provides a Python binding to the libguestfs API
10660 for examining and modifying virtual machine disk images.
10661
10662 Amongst the things this is good for: making batch configuration
10663 changes to guests, getting disk used/free statistics (see also:
10664 virt-df), migrating between virtualization systems (see also:
10665 virt-p2v), performing partial backups, performing partial guest
10666 clones, cloning guests and changing registry/UUID/hostname info, and
10667 much else besides.
10668
10669 Libguestfs uses Linux kernel and qemu code, and can access any type of
10670 guest filesystem that Linux and qemu can, including but not limited
10671 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
10672 schemes, qcow, qcow2, vmdk.
10673
10674 Libguestfs provides ways to enumerate guest storage (eg. partitions,
10675 LVs, what filesystem is in each LV, etc.).  It can also run commands
10676 in the context of the guest.  Also you can access filesystems over
10677 FUSE.
10678
10679 Errors which happen while using the API are turned into Python
10680 RuntimeError exceptions.
10681
10682 To create a guestfs handle you usually have to perform the following
10683 sequence of calls:
10684
10685 # Create the handle, call add_drive at least once, and possibly
10686 # several times if the guest has multiple block devices:
10687 g = guestfs.GuestFS ()
10688 g.add_drive (\"guest.img\")
10689
10690 # Launch the qemu subprocess and wait for it to become ready:
10691 g.launch ()
10692
10693 # Now you can issue commands, for example:
10694 logvols = g.lvs ()
10695
10696 \"\"\"
10697
10698 import libguestfsmod
10699
10700 class GuestFS:
10701     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
10702
10703     def __init__ (self):
10704         \"\"\"Create a new libguestfs handle.\"\"\"
10705         self._o = libguestfsmod.create ()
10706
10707     def __del__ (self):
10708         libguestfsmod.close (self._o)
10709
10710 ";
10711
10712   List.iter (
10713     fun (name, style, _, flags, _, _, longdesc) ->
10714       pr "    def %s " name;
10715       generate_py_call_args ~handle:"self" (snd style);
10716       pr ":\n";
10717
10718       if not (List.mem NotInDocs flags) then (
10719         let doc = replace_str longdesc "C<guestfs_" "C<g." in
10720         let doc =
10721           match fst style with
10722           | RErr | RInt _ | RInt64 _ | RBool _
10723           | RConstOptString _ | RConstString _
10724           | RString _ | RBufferOut _ -> doc
10725           | RStringList _ ->
10726               doc ^ "\n\nThis function returns a list of strings."
10727           | RStruct (_, typ) ->
10728               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
10729           | RStructList (_, typ) ->
10730               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
10731           | RHashtable _ ->
10732               doc ^ "\n\nThis function returns a dictionary." in
10733         let doc =
10734           if List.mem ProtocolLimitWarning flags then
10735             doc ^ "\n\n" ^ protocol_limit_warning
10736           else doc in
10737         let doc =
10738           if List.mem DangerWillRobinson flags then
10739             doc ^ "\n\n" ^ danger_will_robinson
10740           else doc in
10741         let doc =
10742           match deprecation_notice flags with
10743           | None -> doc
10744           | Some txt -> doc ^ "\n\n" ^ txt in
10745         let doc = pod2text ~width:60 name doc in
10746         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
10747         let doc = String.concat "\n        " doc in
10748         pr "        u\"\"\"%s\"\"\"\n" doc;
10749       );
10750       pr "        return libguestfsmod.%s " name;
10751       generate_py_call_args ~handle:"self._o" (snd style);
10752       pr "\n";
10753       pr "\n";
10754   ) all_functions
10755
10756 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
10757 and generate_py_call_args ~handle args =
10758   pr "(%s" handle;
10759   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
10760   pr ")"
10761
10762 (* Useful if you need the longdesc POD text as plain text.  Returns a
10763  * list of lines.
10764  *
10765  * Because this is very slow (the slowest part of autogeneration),
10766  * we memoize the results.
10767  *)
10768 and pod2text ~width name longdesc =
10769   let key = width, name, longdesc in
10770   try Hashtbl.find pod2text_memo key
10771   with Not_found ->
10772     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
10773     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
10774     close_out chan;
10775     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
10776     let chan = open_process_in cmd in
10777     let lines = ref [] in
10778     let rec loop i =
10779       let line = input_line chan in
10780       if i = 1 then             (* discard the first line of output *)
10781         loop (i+1)
10782       else (
10783         let line = triml line in
10784         lines := line :: !lines;
10785         loop (i+1)
10786       ) in
10787     let lines = try loop 1 with End_of_file -> List.rev !lines in
10788     unlink filename;
10789     (match close_process_in chan with
10790      | WEXITED 0 -> ()
10791      | WEXITED i ->
10792          failwithf "pod2text: process exited with non-zero status (%d)" i
10793      | WSIGNALED i | WSTOPPED i ->
10794          failwithf "pod2text: process signalled or stopped by signal %d" i
10795     );
10796     Hashtbl.add pod2text_memo key lines;
10797     pod2text_memo_updated ();
10798     lines
10799
10800 (* Generate ruby bindings. *)
10801 and generate_ruby_c () =
10802   generate_header CStyle LGPLv2plus;
10803
10804   pr "\
10805 #include <stdio.h>
10806 #include <stdlib.h>
10807
10808 #include <ruby.h>
10809
10810 #include \"guestfs.h\"
10811
10812 #include \"extconf.h\"
10813
10814 /* For Ruby < 1.9 */
10815 #ifndef RARRAY_LEN
10816 #define RARRAY_LEN(r) (RARRAY((r))->len)
10817 #endif
10818
10819 static VALUE m_guestfs;                 /* guestfs module */
10820 static VALUE c_guestfs;                 /* guestfs_h handle */
10821 static VALUE e_Error;                   /* used for all errors */
10822
10823 static void ruby_guestfs_free (void *p)
10824 {
10825   if (!p) return;
10826   guestfs_close ((guestfs_h *) p);
10827 }
10828
10829 static VALUE ruby_guestfs_create (VALUE m)
10830 {
10831   guestfs_h *g;
10832
10833   g = guestfs_create ();
10834   if (!g)
10835     rb_raise (e_Error, \"failed to create guestfs handle\");
10836
10837   /* Don't print error messages to stderr by default. */
10838   guestfs_set_error_handler (g, NULL, NULL);
10839
10840   /* Wrap it, and make sure the close function is called when the
10841    * handle goes away.
10842    */
10843   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
10844 }
10845
10846 static VALUE ruby_guestfs_close (VALUE gv)
10847 {
10848   guestfs_h *g;
10849   Data_Get_Struct (gv, guestfs_h, g);
10850
10851   ruby_guestfs_free (g);
10852   DATA_PTR (gv) = NULL;
10853
10854   return Qnil;
10855 }
10856
10857 ";
10858
10859   List.iter (
10860     fun (name, style, _, _, _, _, _) ->
10861       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
10862       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
10863       pr ")\n";
10864       pr "{\n";
10865       pr "  guestfs_h *g;\n";
10866       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
10867       pr "  if (!g)\n";
10868       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
10869         name;
10870       pr "\n";
10871
10872       List.iter (
10873         function
10874         | Pathname n | Device n | Dev_or_Path n | String n | Key n
10875         | FileIn n | FileOut n ->
10876             pr "  Check_Type (%sv, T_STRING);\n" n;
10877             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
10878             pr "  if (!%s)\n" n;
10879             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
10880             pr "              \"%s\", \"%s\");\n" n name
10881         | BufferIn n ->
10882             pr "  Check_Type (%sv, T_STRING);\n" n;
10883             pr "  const char *%s = RSTRING (%sv)->ptr;\n" n n;
10884             pr "  if (!%s)\n" n;
10885             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
10886             pr "              \"%s\", \"%s\");\n" n name;
10887             pr "  size_t %s_size = RSTRING (%sv)->len;\n" n n
10888         | OptString n ->
10889             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
10890         | StringList n | DeviceList n ->
10891             pr "  char **%s;\n" n;
10892             pr "  Check_Type (%sv, T_ARRAY);\n" n;
10893             pr "  {\n";
10894             pr "    size_t i, len;\n";
10895             pr "    len = RARRAY_LEN (%sv);\n" n;
10896             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
10897               n;
10898             pr "    for (i = 0; i < len; ++i) {\n";
10899             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
10900             pr "      %s[i] = StringValueCStr (v);\n" n;
10901             pr "    }\n";
10902             pr "    %s[len] = NULL;\n" n;
10903             pr "  }\n";
10904         | Bool n ->
10905             pr "  int %s = RTEST (%sv);\n" n n
10906         | Int n ->
10907             pr "  int %s = NUM2INT (%sv);\n" n n
10908         | Int64 n ->
10909             pr "  long long %s = NUM2LL (%sv);\n" n n
10910       ) (snd style);
10911       pr "\n";
10912
10913       let error_code =
10914         match fst style with
10915         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
10916         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
10917         | RConstString _ | RConstOptString _ ->
10918             pr "  const char *r;\n"; "NULL"
10919         | RString _ -> pr "  char *r;\n"; "NULL"
10920         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
10921         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
10922         | RStructList (_, typ) ->
10923             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
10924         | RBufferOut _ ->
10925             pr "  char *r;\n";
10926             pr "  size_t size;\n";
10927             "NULL" in
10928       pr "\n";
10929
10930       pr "  r = guestfs_%s " name;
10931       generate_c_call_args ~handle:"g" style;
10932       pr ";\n";
10933
10934       List.iter (
10935         function
10936         | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
10937         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
10938         | BufferIn _ -> ()
10939         | StringList n | DeviceList n ->
10940             pr "  free (%s);\n" n
10941       ) (snd style);
10942
10943       pr "  if (r == %s)\n" error_code;
10944       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
10945       pr "\n";
10946
10947       (match fst style with
10948        | RErr ->
10949            pr "  return Qnil;\n"
10950        | RInt _ | RBool _ ->
10951            pr "  return INT2NUM (r);\n"
10952        | RInt64 _ ->
10953            pr "  return ULL2NUM (r);\n"
10954        | RConstString _ ->
10955            pr "  return rb_str_new2 (r);\n";
10956        | RConstOptString _ ->
10957            pr "  if (r)\n";
10958            pr "    return rb_str_new2 (r);\n";
10959            pr "  else\n";
10960            pr "    return Qnil;\n";
10961        | RString _ ->
10962            pr "  VALUE rv = rb_str_new2 (r);\n";
10963            pr "  free (r);\n";
10964            pr "  return rv;\n";
10965        | RStringList _ ->
10966            pr "  size_t i, len = 0;\n";
10967            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
10968            pr "  VALUE rv = rb_ary_new2 (len);\n";
10969            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
10970            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
10971            pr "    free (r[i]);\n";
10972            pr "  }\n";
10973            pr "  free (r);\n";
10974            pr "  return rv;\n"
10975        | RStruct (_, typ) ->
10976            let cols = cols_of_struct typ in
10977            generate_ruby_struct_code typ cols
10978        | RStructList (_, typ) ->
10979            let cols = cols_of_struct typ in
10980            generate_ruby_struct_list_code typ cols
10981        | RHashtable _ ->
10982            pr "  VALUE rv = rb_hash_new ();\n";
10983            pr "  size_t i;\n";
10984            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
10985            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
10986            pr "    free (r[i]);\n";
10987            pr "    free (r[i+1]);\n";
10988            pr "  }\n";
10989            pr "  free (r);\n";
10990            pr "  return rv;\n"
10991        | RBufferOut _ ->
10992            pr "  VALUE rv = rb_str_new (r, size);\n";
10993            pr "  free (r);\n";
10994            pr "  return rv;\n";
10995       );
10996
10997       pr "}\n";
10998       pr "\n"
10999   ) all_functions;
11000
11001   pr "\
11002 /* Initialize the module. */
11003 void Init__guestfs ()
11004 {
11005   m_guestfs = rb_define_module (\"Guestfs\");
11006   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
11007   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
11008
11009 #ifdef HAVE_RB_DEFINE_ALLOC_FUNC
11010   rb_define_alloc_func (c_guestfs, ruby_guestfs_create);
11011 #endif
11012
11013   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
11014   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
11015
11016 ";
11017   (* Define the rest of the methods. *)
11018   List.iter (
11019     fun (name, style, _, _, _, _, _) ->
11020       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
11021       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
11022   ) all_functions;
11023
11024   pr "}\n"
11025
11026 (* Ruby code to return a struct. *)
11027 and generate_ruby_struct_code typ cols =
11028   pr "  VALUE rv = rb_hash_new ();\n";
11029   List.iter (
11030     function
11031     | name, FString ->
11032         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
11033     | name, FBuffer ->
11034         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
11035     | name, FUUID ->
11036         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
11037     | name, (FBytes|FUInt64) ->
11038         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
11039     | name, FInt64 ->
11040         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
11041     | name, FUInt32 ->
11042         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
11043     | name, FInt32 ->
11044         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
11045     | name, FOptPercent ->
11046         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
11047     | name, FChar -> (* XXX wrong? *)
11048         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
11049   ) cols;
11050   pr "  guestfs_free_%s (r);\n" typ;
11051   pr "  return rv;\n"
11052
11053 (* Ruby code to return a struct list. *)
11054 and generate_ruby_struct_list_code typ cols =
11055   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
11056   pr "  size_t i;\n";
11057   pr "  for (i = 0; i < r->len; ++i) {\n";
11058   pr "    VALUE hv = rb_hash_new ();\n";
11059   List.iter (
11060     function
11061     | name, FString ->
11062         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
11063     | name, FBuffer ->
11064         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
11065     | name, FUUID ->
11066         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
11067     | name, (FBytes|FUInt64) ->
11068         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
11069     | name, FInt64 ->
11070         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
11071     | name, FUInt32 ->
11072         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
11073     | name, FInt32 ->
11074         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
11075     | name, FOptPercent ->
11076         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
11077     | name, FChar -> (* XXX wrong? *)
11078         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
11079   ) cols;
11080   pr "    rb_ary_push (rv, hv);\n";
11081   pr "  }\n";
11082   pr "  guestfs_free_%s_list (r);\n" typ;
11083   pr "  return rv;\n"
11084
11085 (* Generate Java bindings GuestFS.java file. *)
11086 and generate_java_java () =
11087   generate_header CStyle LGPLv2plus;
11088
11089   pr "\
11090 package com.redhat.et.libguestfs;
11091
11092 import java.util.HashMap;
11093 import com.redhat.et.libguestfs.LibGuestFSException;
11094 import com.redhat.et.libguestfs.PV;
11095 import com.redhat.et.libguestfs.VG;
11096 import com.redhat.et.libguestfs.LV;
11097 import com.redhat.et.libguestfs.Stat;
11098 import com.redhat.et.libguestfs.StatVFS;
11099 import com.redhat.et.libguestfs.IntBool;
11100 import com.redhat.et.libguestfs.Dirent;
11101
11102 /**
11103  * The GuestFS object is a libguestfs handle.
11104  *
11105  * @author rjones
11106  */
11107 public class GuestFS {
11108   // Load the native code.
11109   static {
11110     System.loadLibrary (\"guestfs_jni\");
11111   }
11112
11113   /**
11114    * The native guestfs_h pointer.
11115    */
11116   long g;
11117
11118   /**
11119    * Create a libguestfs handle.
11120    *
11121    * @throws LibGuestFSException
11122    */
11123   public GuestFS () throws LibGuestFSException
11124   {
11125     g = _create ();
11126   }
11127   private native long _create () throws LibGuestFSException;
11128
11129   /**
11130    * Close a libguestfs handle.
11131    *
11132    * You can also leave handles to be collected by the garbage
11133    * collector, but this method ensures that the resources used
11134    * by the handle are freed up immediately.  If you call any
11135    * other methods after closing the handle, you will get an
11136    * exception.
11137    *
11138    * @throws LibGuestFSException
11139    */
11140   public void close () throws LibGuestFSException
11141   {
11142     if (g != 0)
11143       _close (g);
11144     g = 0;
11145   }
11146   private native void _close (long g) throws LibGuestFSException;
11147
11148   public void finalize () throws LibGuestFSException
11149   {
11150     close ();
11151   }
11152
11153 ";
11154
11155   List.iter (
11156     fun (name, style, _, flags, _, shortdesc, longdesc) ->
11157       if not (List.mem NotInDocs flags); then (
11158         let doc = replace_str longdesc "C<guestfs_" "C<g." in
11159         let doc =
11160           if List.mem ProtocolLimitWarning flags then
11161             doc ^ "\n\n" ^ protocol_limit_warning
11162           else doc in
11163         let doc =
11164           if List.mem DangerWillRobinson flags then
11165             doc ^ "\n\n" ^ danger_will_robinson
11166           else doc in
11167         let doc =
11168           match deprecation_notice flags with
11169           | None -> doc
11170           | Some txt -> doc ^ "\n\n" ^ txt in
11171         let doc = pod2text ~width:60 name doc in
11172         let doc = List.map (            (* RHBZ#501883 *)
11173           function
11174           | "" -> "<p>"
11175           | nonempty -> nonempty
11176         ) doc in
11177         let doc = String.concat "\n   * " doc in
11178
11179         pr "  /**\n";
11180         pr "   * %s\n" shortdesc;
11181         pr "   * <p>\n";
11182         pr "   * %s\n" doc;
11183         pr "   * @throws LibGuestFSException\n";
11184         pr "   */\n";
11185         pr "  ";
11186       );
11187       generate_java_prototype ~public:true ~semicolon:false name style;
11188       pr "\n";
11189       pr "  {\n";
11190       pr "    if (g == 0)\n";
11191       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
11192         name;
11193       pr "    ";
11194       if fst style <> RErr then pr "return ";
11195       pr "_%s " name;
11196       generate_java_call_args ~handle:"g" (snd style);
11197       pr ";\n";
11198       pr "  }\n";
11199       pr "  ";
11200       generate_java_prototype ~privat:true ~native:true name style;
11201       pr "\n";
11202       pr "\n";
11203   ) all_functions;
11204
11205   pr "}\n"
11206
11207 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
11208 and generate_java_call_args ~handle args =
11209   pr "(%s" handle;
11210   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
11211   pr ")"
11212
11213 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
11214     ?(semicolon=true) name style =
11215   if privat then pr "private ";
11216   if public then pr "public ";
11217   if native then pr "native ";
11218
11219   (* return type *)
11220   (match fst style with
11221    | RErr -> pr "void ";
11222    | RInt _ -> pr "int ";
11223    | RInt64 _ -> pr "long ";
11224    | RBool _ -> pr "boolean ";
11225    | RConstString _ | RConstOptString _ | RString _
11226    | RBufferOut _ -> pr "String ";
11227    | RStringList _ -> pr "String[] ";
11228    | RStruct (_, typ) ->
11229        let name = java_name_of_struct typ in
11230        pr "%s " name;
11231    | RStructList (_, typ) ->
11232        let name = java_name_of_struct typ in
11233        pr "%s[] " name;
11234    | RHashtable _ -> pr "HashMap<String,String> ";
11235   );
11236
11237   if native then pr "_%s " name else pr "%s " name;
11238   pr "(";
11239   let needs_comma = ref false in
11240   if native then (
11241     pr "long g";
11242     needs_comma := true
11243   );
11244
11245   (* args *)
11246   List.iter (
11247     fun arg ->
11248       if !needs_comma then pr ", ";
11249       needs_comma := true;
11250
11251       match arg with
11252       | Pathname n
11253       | Device n | Dev_or_Path n
11254       | String n
11255       | OptString n
11256       | FileIn n
11257       | FileOut n
11258       | Key n ->
11259           pr "String %s" n
11260       | BufferIn n ->
11261           pr "byte[] %s" n
11262       | StringList n | DeviceList n ->
11263           pr "String[] %s" n
11264       | Bool n ->
11265           pr "boolean %s" n
11266       | Int n ->
11267           pr "int %s" n
11268       | Int64 n ->
11269           pr "long %s" n
11270   ) (snd style);
11271
11272   pr ")\n";
11273   pr "    throws LibGuestFSException";
11274   if semicolon then pr ";"
11275
11276 and generate_java_struct jtyp cols () =
11277   generate_header CStyle LGPLv2plus;
11278
11279   pr "\
11280 package com.redhat.et.libguestfs;
11281
11282 /**
11283  * Libguestfs %s structure.
11284  *
11285  * @author rjones
11286  * @see GuestFS
11287  */
11288 public class %s {
11289 " jtyp jtyp;
11290
11291   List.iter (
11292     function
11293     | name, FString
11294     | name, FUUID
11295     | name, FBuffer -> pr "  public String %s;\n" name
11296     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
11297     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
11298     | name, FChar -> pr "  public char %s;\n" name
11299     | name, FOptPercent ->
11300         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
11301         pr "  public float %s;\n" name
11302   ) cols;
11303
11304   pr "}\n"
11305
11306 and generate_java_c () =
11307   generate_header CStyle LGPLv2plus;
11308
11309   pr "\
11310 #include <stdio.h>
11311 #include <stdlib.h>
11312 #include <string.h>
11313
11314 #include \"com_redhat_et_libguestfs_GuestFS.h\"
11315 #include \"guestfs.h\"
11316
11317 /* Note that this function returns.  The exception is not thrown
11318  * until after the wrapper function returns.
11319  */
11320 static void
11321 throw_exception (JNIEnv *env, const char *msg)
11322 {
11323   jclass cl;
11324   cl = (*env)->FindClass (env,
11325                           \"com/redhat/et/libguestfs/LibGuestFSException\");
11326   (*env)->ThrowNew (env, cl, msg);
11327 }
11328
11329 JNIEXPORT jlong JNICALL
11330 Java_com_redhat_et_libguestfs_GuestFS__1create
11331   (JNIEnv *env, jobject obj)
11332 {
11333   guestfs_h *g;
11334
11335   g = guestfs_create ();
11336   if (g == NULL) {
11337     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
11338     return 0;
11339   }
11340   guestfs_set_error_handler (g, NULL, NULL);
11341   return (jlong) (long) g;
11342 }
11343
11344 JNIEXPORT void JNICALL
11345 Java_com_redhat_et_libguestfs_GuestFS__1close
11346   (JNIEnv *env, jobject obj, jlong jg)
11347 {
11348   guestfs_h *g = (guestfs_h *) (long) jg;
11349   guestfs_close (g);
11350 }
11351
11352 ";
11353
11354   List.iter (
11355     fun (name, style, _, _, _, _, _) ->
11356       pr "JNIEXPORT ";
11357       (match fst style with
11358        | RErr -> pr "void ";
11359        | RInt _ -> pr "jint ";
11360        | RInt64 _ -> pr "jlong ";
11361        | RBool _ -> pr "jboolean ";
11362        | RConstString _ | RConstOptString _ | RString _
11363        | RBufferOut _ -> pr "jstring ";
11364        | RStruct _ | RHashtable _ ->
11365            pr "jobject ";
11366        | RStringList _ | RStructList _ ->
11367            pr "jobjectArray ";
11368       );
11369       pr "JNICALL\n";
11370       pr "Java_com_redhat_et_libguestfs_GuestFS_";
11371       pr "%s" (replace_str ("_" ^ name) "_" "_1");
11372       pr "\n";
11373       pr "  (JNIEnv *env, jobject obj, jlong jg";
11374       List.iter (
11375         function
11376         | Pathname n
11377         | Device n | Dev_or_Path n
11378         | String n
11379         | OptString n
11380         | FileIn n
11381         | FileOut n
11382         | Key n ->
11383             pr ", jstring j%s" n
11384         | BufferIn n ->
11385             pr ", jbyteArray j%s" n
11386         | StringList n | DeviceList n ->
11387             pr ", jobjectArray j%s" n
11388         | Bool n ->
11389             pr ", jboolean j%s" n
11390         | Int n ->
11391             pr ", jint j%s" n
11392         | Int64 n ->
11393             pr ", jlong j%s" n
11394       ) (snd style);
11395       pr ")\n";
11396       pr "{\n";
11397       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
11398       let error_code, no_ret =
11399         match fst style with
11400         | RErr -> pr "  int r;\n"; "-1", ""
11401         | RBool _
11402         | RInt _ -> pr "  int r;\n"; "-1", "0"
11403         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
11404         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
11405         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
11406         | RString _ ->
11407             pr "  jstring jr;\n";
11408             pr "  char *r;\n"; "NULL", "NULL"
11409         | RStringList _ ->
11410             pr "  jobjectArray jr;\n";
11411             pr "  int r_len;\n";
11412             pr "  jclass cl;\n";
11413             pr "  jstring jstr;\n";
11414             pr "  char **r;\n"; "NULL", "NULL"
11415         | RStruct (_, typ) ->
11416             pr "  jobject jr;\n";
11417             pr "  jclass cl;\n";
11418             pr "  jfieldID fl;\n";
11419             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
11420         | RStructList (_, typ) ->
11421             pr "  jobjectArray jr;\n";
11422             pr "  jclass cl;\n";
11423             pr "  jfieldID fl;\n";
11424             pr "  jobject jfl;\n";
11425             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
11426         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
11427         | RBufferOut _ ->
11428             pr "  jstring jr;\n";
11429             pr "  char *r;\n";
11430             pr "  size_t size;\n";
11431             "NULL", "NULL" in
11432       List.iter (
11433         function
11434         | Pathname n
11435         | Device n | Dev_or_Path n
11436         | String n
11437         | OptString n
11438         | FileIn n
11439         | FileOut n
11440         | Key n ->
11441             pr "  const char *%s;\n" n
11442         | BufferIn n ->
11443             pr "  jbyte *%s;\n" n;
11444             pr "  size_t %s_size;\n" n
11445         | StringList n | DeviceList n ->
11446             pr "  int %s_len;\n" n;
11447             pr "  const char **%s;\n" n
11448         | Bool n
11449         | Int n ->
11450             pr "  int %s;\n" n
11451         | Int64 n ->
11452             pr "  int64_t %s;\n" n
11453       ) (snd style);
11454
11455       let needs_i =
11456         (match fst style with
11457          | RStringList _ | RStructList _ -> true
11458          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
11459          | RConstOptString _
11460          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
11461           List.exists (function
11462                        | StringList _ -> true
11463                        | DeviceList _ -> true
11464                        | _ -> false) (snd style) in
11465       if needs_i then
11466         pr "  size_t i;\n";
11467
11468       pr "\n";
11469
11470       (* Get the parameters. *)
11471       List.iter (
11472         function
11473         | Pathname n
11474         | Device n | Dev_or_Path n
11475         | String n
11476         | FileIn n
11477         | FileOut n
11478         | Key n ->
11479             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
11480         | OptString n ->
11481             (* This is completely undocumented, but Java null becomes
11482              * a NULL parameter.
11483              *)
11484             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
11485         | BufferIn n ->
11486             pr "  %s = (*env)->GetByteArrayElements (env, j%s, NULL);\n" n n;
11487             pr "  %s_size = (*env)->GetArrayLength (env, j%s);\n" n n
11488         | StringList n | DeviceList n ->
11489             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
11490             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
11491             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
11492             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
11493               n;
11494             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
11495             pr "  }\n";
11496             pr "  %s[%s_len] = NULL;\n" n n;
11497         | Bool n
11498         | Int n
11499         | Int64 n ->
11500             pr "  %s = j%s;\n" n n
11501       ) (snd style);
11502
11503       (* Make the call. *)
11504       pr "  r = guestfs_%s " name;
11505       generate_c_call_args ~handle:"g" style;
11506       pr ";\n";
11507
11508       (* Release the parameters. *)
11509       List.iter (
11510         function
11511         | Pathname n
11512         | Device n | Dev_or_Path n
11513         | String n
11514         | FileIn n
11515         | FileOut n
11516         | Key n ->
11517             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
11518         | OptString n ->
11519             pr "  if (j%s)\n" n;
11520             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
11521         | BufferIn n ->
11522             pr "  (*env)->ReleaseByteArrayElements (env, j%s, %s, 0);\n" n n
11523         | StringList n | DeviceList n ->
11524             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
11525             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
11526               n;
11527             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
11528             pr "  }\n";
11529             pr "  free (%s);\n" n
11530         | Bool n
11531         | Int n
11532         | Int64 n -> ()
11533       ) (snd style);
11534
11535       (* Check for errors. *)
11536       pr "  if (r == %s) {\n" error_code;
11537       pr "    throw_exception (env, guestfs_last_error (g));\n";
11538       pr "    return %s;\n" no_ret;
11539       pr "  }\n";
11540
11541       (* Return value. *)
11542       (match fst style with
11543        | RErr -> ()
11544        | RInt _ -> pr "  return (jint) r;\n"
11545        | RBool _ -> pr "  return (jboolean) r;\n"
11546        | RInt64 _ -> pr "  return (jlong) r;\n"
11547        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
11548        | RConstOptString _ ->
11549            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
11550        | RString _ ->
11551            pr "  jr = (*env)->NewStringUTF (env, r);\n";
11552            pr "  free (r);\n";
11553            pr "  return jr;\n"
11554        | RStringList _ ->
11555            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
11556            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
11557            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
11558            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
11559            pr "  for (i = 0; i < r_len; ++i) {\n";
11560            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
11561            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
11562            pr "    free (r[i]);\n";
11563            pr "  }\n";
11564            pr "  free (r);\n";
11565            pr "  return jr;\n"
11566        | RStruct (_, typ) ->
11567            let jtyp = java_name_of_struct typ in
11568            let cols = cols_of_struct typ in
11569            generate_java_struct_return typ jtyp cols
11570        | RStructList (_, typ) ->
11571            let jtyp = java_name_of_struct typ in
11572            let cols = cols_of_struct typ in
11573            generate_java_struct_list_return typ jtyp cols
11574        | RHashtable _ ->
11575            (* XXX *)
11576            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
11577            pr "  return NULL;\n"
11578        | RBufferOut _ ->
11579            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
11580            pr "  free (r);\n";
11581            pr "  return jr;\n"
11582       );
11583
11584       pr "}\n";
11585       pr "\n"
11586   ) all_functions
11587
11588 and generate_java_struct_return typ jtyp cols =
11589   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
11590   pr "  jr = (*env)->AllocObject (env, cl);\n";
11591   List.iter (
11592     function
11593     | name, FString ->
11594         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
11595         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
11596     | name, FUUID ->
11597         pr "  {\n";
11598         pr "    char s[33];\n";
11599         pr "    memcpy (s, r->%s, 32);\n" name;
11600         pr "    s[32] = 0;\n";
11601         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
11602         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
11603         pr "  }\n";
11604     | name, FBuffer ->
11605         pr "  {\n";
11606         pr "    int len = r->%s_len;\n" name;
11607         pr "    char s[len+1];\n";
11608         pr "    memcpy (s, r->%s, len);\n" name;
11609         pr "    s[len] = 0;\n";
11610         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
11611         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
11612         pr "  }\n";
11613     | name, (FBytes|FUInt64|FInt64) ->
11614         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
11615         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
11616     | name, (FUInt32|FInt32) ->
11617         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
11618         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
11619     | name, FOptPercent ->
11620         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
11621         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
11622     | name, FChar ->
11623         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
11624         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
11625   ) cols;
11626   pr "  free (r);\n";
11627   pr "  return jr;\n"
11628
11629 and generate_java_struct_list_return typ jtyp cols =
11630   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
11631   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
11632   pr "  for (i = 0; i < r->len; ++i) {\n";
11633   pr "    jfl = (*env)->AllocObject (env, cl);\n";
11634   List.iter (
11635     function
11636     | name, FString ->
11637         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
11638         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
11639     | name, FUUID ->
11640         pr "    {\n";
11641         pr "      char s[33];\n";
11642         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
11643         pr "      s[32] = 0;\n";
11644         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
11645         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
11646         pr "    }\n";
11647     | name, FBuffer ->
11648         pr "    {\n";
11649         pr "      int len = r->val[i].%s_len;\n" name;
11650         pr "      char s[len+1];\n";
11651         pr "      memcpy (s, r->val[i].%s, len);\n" name;
11652         pr "      s[len] = 0;\n";
11653         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
11654         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
11655         pr "    }\n";
11656     | name, (FBytes|FUInt64|FInt64) ->
11657         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
11658         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
11659     | name, (FUInt32|FInt32) ->
11660         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
11661         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
11662     | name, FOptPercent ->
11663         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
11664         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
11665     | name, FChar ->
11666         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
11667         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
11668   ) cols;
11669   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
11670   pr "  }\n";
11671   pr "  guestfs_free_%s_list (r);\n" typ;
11672   pr "  return jr;\n"
11673
11674 and generate_java_makefile_inc () =
11675   generate_header HashStyle GPLv2plus;
11676
11677   pr "java_built_sources = \\\n";
11678   List.iter (
11679     fun (typ, jtyp) ->
11680         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
11681   ) java_structs;
11682   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
11683
11684 and generate_haskell_hs () =
11685   generate_header HaskellStyle LGPLv2plus;
11686
11687   (* XXX We only know how to generate partial FFI for Haskell
11688    * at the moment.  Please help out!
11689    *)
11690   let can_generate style =
11691     match style with
11692     | RErr, _
11693     | RInt _, _
11694     | RInt64 _, _ -> true
11695     | RBool _, _
11696     | RConstString _, _
11697     | RConstOptString _, _
11698     | RString _, _
11699     | RStringList _, _
11700     | RStruct _, _
11701     | RStructList _, _
11702     | RHashtable _, _
11703     | RBufferOut _, _ -> false in
11704
11705   pr "\
11706 {-# INCLUDE <guestfs.h> #-}
11707 {-# LANGUAGE ForeignFunctionInterface #-}
11708
11709 module Guestfs (
11710   create";
11711
11712   (* List out the names of the actions we want to export. *)
11713   List.iter (
11714     fun (name, style, _, _, _, _, _) ->
11715       if can_generate style then pr ",\n  %s" name
11716   ) all_functions;
11717
11718   pr "
11719   ) where
11720
11721 -- Unfortunately some symbols duplicate ones already present
11722 -- in Prelude.  We don't know which, so we hard-code a list
11723 -- here.
11724 import Prelude hiding (truncate)
11725
11726 import Foreign
11727 import Foreign.C
11728 import Foreign.C.Types
11729 import IO
11730 import Control.Exception
11731 import Data.Typeable
11732
11733 data GuestfsS = GuestfsS            -- represents the opaque C struct
11734 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
11735 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
11736
11737 -- XXX define properly later XXX
11738 data PV = PV
11739 data VG = VG
11740 data LV = LV
11741 data IntBool = IntBool
11742 data Stat = Stat
11743 data StatVFS = StatVFS
11744 data Hashtable = Hashtable
11745
11746 foreign import ccall unsafe \"guestfs_create\" c_create
11747   :: IO GuestfsP
11748 foreign import ccall unsafe \"&guestfs_close\" c_close
11749   :: FunPtr (GuestfsP -> IO ())
11750 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
11751   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
11752
11753 create :: IO GuestfsH
11754 create = do
11755   p <- c_create
11756   c_set_error_handler p nullPtr nullPtr
11757   h <- newForeignPtr c_close p
11758   return h
11759
11760 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
11761   :: GuestfsP -> IO CString
11762
11763 -- last_error :: GuestfsH -> IO (Maybe String)
11764 -- last_error h = do
11765 --   str <- withForeignPtr h (\\p -> c_last_error p)
11766 --   maybePeek peekCString str
11767
11768 last_error :: GuestfsH -> IO (String)
11769 last_error h = do
11770   str <- withForeignPtr h (\\p -> c_last_error p)
11771   if (str == nullPtr)
11772     then return \"no error\"
11773     else peekCString str
11774
11775 ";
11776
11777   (* Generate wrappers for each foreign function. *)
11778   List.iter (
11779     fun (name, style, _, _, _, _, _) ->
11780       if can_generate style then (
11781         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
11782         pr "  :: ";
11783         generate_haskell_prototype ~handle:"GuestfsP" style;
11784         pr "\n";
11785         pr "\n";
11786         pr "%s :: " name;
11787         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
11788         pr "\n";
11789         pr "%s %s = do\n" name
11790           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
11791         pr "  r <- ";
11792         (* Convert pointer arguments using with* functions. *)
11793         List.iter (
11794           function
11795           | FileIn n
11796           | FileOut n
11797           | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
11798               pr "withCString %s $ \\%s -> " n n
11799           | BufferIn n ->
11800               pr "withCStringLen %s $ \\(%s, %s_size) -> " n n n
11801           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
11802           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
11803           | Bool _ | Int _ | Int64 _ -> ()
11804         ) (snd style);
11805         (* Convert integer arguments. *)
11806         let args =
11807           List.map (
11808             function
11809             | Bool n -> sprintf "(fromBool %s)" n
11810             | Int n -> sprintf "(fromIntegral %s)" n
11811             | Int64 n -> sprintf "(fromIntegral %s)" n
11812             | FileIn n | FileOut n
11813             | Pathname n | Device n | Dev_or_Path n
11814             | String n | OptString n
11815             | StringList n | DeviceList n
11816             | Key n -> n
11817             | BufferIn n -> sprintf "%s (fromIntegral %s_size)" n n
11818           ) (snd style) in
11819         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
11820           (String.concat " " ("p" :: args));
11821         (match fst style with
11822          | RErr | RInt _ | RInt64 _ | RBool _ ->
11823              pr "  if (r == -1)\n";
11824              pr "    then do\n";
11825              pr "      err <- last_error h\n";
11826              pr "      fail err\n";
11827          | RConstString _ | RConstOptString _ | RString _
11828          | RStringList _ | RStruct _
11829          | RStructList _ | RHashtable _ | RBufferOut _ ->
11830              pr "  if (r == nullPtr)\n";
11831              pr "    then do\n";
11832              pr "      err <- last_error h\n";
11833              pr "      fail err\n";
11834         );
11835         (match fst style with
11836          | RErr ->
11837              pr "    else return ()\n"
11838          | RInt _ ->
11839              pr "    else return (fromIntegral r)\n"
11840          | RInt64 _ ->
11841              pr "    else return (fromIntegral r)\n"
11842          | RBool _ ->
11843              pr "    else return (toBool r)\n"
11844          | RConstString _
11845          | RConstOptString _
11846          | RString _
11847          | RStringList _
11848          | RStruct _
11849          | RStructList _
11850          | RHashtable _
11851          | RBufferOut _ ->
11852              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
11853         );
11854         pr "\n";
11855       )
11856   ) all_functions
11857
11858 and generate_haskell_prototype ~handle ?(hs = false) style =
11859   pr "%s -> " handle;
11860   let string = if hs then "String" else "CString" in
11861   let int = if hs then "Int" else "CInt" in
11862   let bool = if hs then "Bool" else "CInt" in
11863   let int64 = if hs then "Integer" else "Int64" in
11864   List.iter (
11865     fun arg ->
11866       (match arg with
11867        | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _ ->
11868            pr "%s" string
11869        | BufferIn _ ->
11870            if hs then pr "String"
11871            else pr "CString -> CInt"
11872        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
11873        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
11874        | Bool _ -> pr "%s" bool
11875        | Int _ -> pr "%s" int
11876        | Int64 _ -> pr "%s" int
11877        | FileIn _ -> pr "%s" string
11878        | FileOut _ -> pr "%s" string
11879       );
11880       pr " -> ";
11881   ) (snd style);
11882   pr "IO (";
11883   (match fst style with
11884    | RErr -> if not hs then pr "CInt"
11885    | RInt _ -> pr "%s" int
11886    | RInt64 _ -> pr "%s" int64
11887    | RBool _ -> pr "%s" bool
11888    | RConstString _ -> pr "%s" string
11889    | RConstOptString _ -> pr "Maybe %s" string
11890    | RString _ -> pr "%s" string
11891    | RStringList _ -> pr "[%s]" string
11892    | RStruct (_, typ) ->
11893        let name = java_name_of_struct typ in
11894        pr "%s" name
11895    | RStructList (_, typ) ->
11896        let name = java_name_of_struct typ in
11897        pr "[%s]" name
11898    | RHashtable _ -> pr "Hashtable"
11899    | RBufferOut _ -> pr "%s" string
11900   );
11901   pr ")"
11902
11903 and generate_csharp () =
11904   generate_header CPlusPlusStyle LGPLv2plus;
11905
11906   (* XXX Make this configurable by the C# assembly users. *)
11907   let library = "libguestfs.so.0" in
11908
11909   pr "\
11910 // These C# bindings are highly experimental at present.
11911 //
11912 // Firstly they only work on Linux (ie. Mono).  In order to get them
11913 // to work on Windows (ie. .Net) you would need to port the library
11914 // itself to Windows first.
11915 //
11916 // The second issue is that some calls are known to be incorrect and
11917 // can cause Mono to segfault.  Particularly: calls which pass or
11918 // return string[], or return any structure value.  This is because
11919 // we haven't worked out the correct way to do this from C#.
11920 //
11921 // The third issue is that when compiling you get a lot of warnings.
11922 // We are not sure whether the warnings are important or not.
11923 //
11924 // Fourthly we do not routinely build or test these bindings as part
11925 // of the make && make check cycle, which means that regressions might
11926 // go unnoticed.
11927 //
11928 // Suggestions and patches are welcome.
11929
11930 // To compile:
11931 //
11932 // gmcs Libguestfs.cs
11933 // mono Libguestfs.exe
11934 //
11935 // (You'll probably want to add a Test class / static main function
11936 // otherwise this won't do anything useful).
11937
11938 using System;
11939 using System.IO;
11940 using System.Runtime.InteropServices;
11941 using System.Runtime.Serialization;
11942 using System.Collections;
11943
11944 namespace Guestfs
11945 {
11946   class Error : System.ApplicationException
11947   {
11948     public Error (string message) : base (message) {}
11949     protected Error (SerializationInfo info, StreamingContext context) {}
11950   }
11951
11952   class Guestfs
11953   {
11954     IntPtr _handle;
11955
11956     [DllImport (\"%s\")]
11957     static extern IntPtr guestfs_create ();
11958
11959     public Guestfs ()
11960     {
11961       _handle = guestfs_create ();
11962       if (_handle == IntPtr.Zero)
11963         throw new Error (\"could not create guestfs handle\");
11964     }
11965
11966     [DllImport (\"%s\")]
11967     static extern void guestfs_close (IntPtr h);
11968
11969     ~Guestfs ()
11970     {
11971       guestfs_close (_handle);
11972     }
11973
11974     [DllImport (\"%s\")]
11975     static extern string guestfs_last_error (IntPtr h);
11976
11977 " library library library;
11978
11979   (* Generate C# structure bindings.  We prefix struct names with
11980    * underscore because C# cannot have conflicting struct names and
11981    * method names (eg. "class stat" and "stat").
11982    *)
11983   List.iter (
11984     fun (typ, cols) ->
11985       pr "    [StructLayout (LayoutKind.Sequential)]\n";
11986       pr "    public class _%s {\n" typ;
11987       List.iter (
11988         function
11989         | name, FChar -> pr "      char %s;\n" name
11990         | name, FString -> pr "      string %s;\n" name
11991         | name, FBuffer ->
11992             pr "      uint %s_len;\n" name;
11993             pr "      string %s;\n" name
11994         | name, FUUID ->
11995             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
11996             pr "      string %s;\n" name
11997         | name, FUInt32 -> pr "      uint %s;\n" name
11998         | name, FInt32 -> pr "      int %s;\n" name
11999         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
12000         | name, FInt64 -> pr "      long %s;\n" name
12001         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
12002       ) cols;
12003       pr "    }\n";
12004       pr "\n"
12005   ) structs;
12006
12007   (* Generate C# function bindings. *)
12008   List.iter (
12009     fun (name, style, _, _, _, shortdesc, _) ->
12010       let rec csharp_return_type () =
12011         match fst style with
12012         | RErr -> "void"
12013         | RBool n -> "bool"
12014         | RInt n -> "int"
12015         | RInt64 n -> "long"
12016         | RConstString n
12017         | RConstOptString n
12018         | RString n
12019         | RBufferOut n -> "string"
12020         | RStruct (_,n) -> "_" ^ n
12021         | RHashtable n -> "Hashtable"
12022         | RStringList n -> "string[]"
12023         | RStructList (_,n) -> sprintf "_%s[]" n
12024
12025       and c_return_type () =
12026         match fst style with
12027         | RErr
12028         | RBool _
12029         | RInt _ -> "int"
12030         | RInt64 _ -> "long"
12031         | RConstString _
12032         | RConstOptString _
12033         | RString _
12034         | RBufferOut _ -> "string"
12035         | RStruct (_,n) -> "_" ^ n
12036         | RHashtable _
12037         | RStringList _ -> "string[]"
12038         | RStructList (_,n) -> sprintf "_%s[]" n
12039
12040       and c_error_comparison () =
12041         match fst style with
12042         | RErr
12043         | RBool _
12044         | RInt _
12045         | RInt64 _ -> "== -1"
12046         | RConstString _
12047         | RConstOptString _
12048         | RString _
12049         | RBufferOut _
12050         | RStruct (_,_)
12051         | RHashtable _
12052         | RStringList _
12053         | RStructList (_,_) -> "== null"
12054
12055       and generate_extern_prototype () =
12056         pr "    static extern %s guestfs_%s (IntPtr h"
12057           (c_return_type ()) name;
12058         List.iter (
12059           function
12060           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
12061           | FileIn n | FileOut n
12062           | Key n
12063           | BufferIn n ->
12064               pr ", [In] string %s" n
12065           | StringList n | DeviceList n ->
12066               pr ", [In] string[] %s" n
12067           | Bool n ->
12068               pr ", bool %s" n
12069           | Int n ->
12070               pr ", int %s" n
12071           | Int64 n ->
12072               pr ", long %s" n
12073         ) (snd style);
12074         pr ");\n"
12075
12076       and generate_public_prototype () =
12077         pr "    public %s %s (" (csharp_return_type ()) name;
12078         let comma = ref false in
12079         let next () =
12080           if !comma then pr ", ";
12081           comma := true
12082         in
12083         List.iter (
12084           function
12085           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
12086           | FileIn n | FileOut n
12087           | Key n
12088           | BufferIn n ->
12089               next (); pr "string %s" n
12090           | StringList n | DeviceList n ->
12091               next (); pr "string[] %s" n
12092           | Bool n ->
12093               next (); pr "bool %s" n
12094           | Int n ->
12095               next (); pr "int %s" n
12096           | Int64 n ->
12097               next (); pr "long %s" n
12098         ) (snd style);
12099         pr ")\n"
12100
12101       and generate_call () =
12102         pr "guestfs_%s (_handle" name;
12103         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
12104         pr ");\n";
12105       in
12106
12107       pr "    [DllImport (\"%s\")]\n" library;
12108       generate_extern_prototype ();
12109       pr "\n";
12110       pr "    /// <summary>\n";
12111       pr "    /// %s\n" shortdesc;
12112       pr "    /// </summary>\n";
12113       generate_public_prototype ();
12114       pr "    {\n";
12115       pr "      %s r;\n" (c_return_type ());
12116       pr "      r = ";
12117       generate_call ();
12118       pr "      if (r %s)\n" (c_error_comparison ());
12119       pr "        throw new Error (guestfs_last_error (_handle));\n";
12120       (match fst style with
12121        | RErr -> ()
12122        | RBool _ ->
12123            pr "      return r != 0 ? true : false;\n"
12124        | RHashtable _ ->
12125            pr "      Hashtable rr = new Hashtable ();\n";
12126            pr "      for (size_t i = 0; i < r.Length; i += 2)\n";
12127            pr "        rr.Add (r[i], r[i+1]);\n";
12128            pr "      return rr;\n"
12129        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
12130        | RString _ | RBufferOut _ | RStruct _ | RStringList _
12131        | RStructList _ ->
12132            pr "      return r;\n"
12133       );
12134       pr "    }\n";
12135       pr "\n";
12136   ) all_functions_sorted;
12137
12138   pr "  }
12139 }
12140 "
12141
12142 and generate_php_h () =
12143   generate_header CStyle LGPLv2plus;
12144
12145   pr "\
12146 #ifndef PHP_GUESTFS_PHP_H
12147 #define PHP_GUESTFS_PHP_H 1
12148
12149 #ifdef ZTS
12150 #include \"TSRM.h\"
12151 #endif
12152
12153 #define PHP_GUESTFS_PHP_EXTNAME \"guestfs_php\"
12154 #define PHP_GUESTFS_PHP_VERSION \"1.0\"
12155
12156 PHP_MINIT_FUNCTION (guestfs_php);
12157
12158 #define PHP_GUESTFS_HANDLE_RES_NAME \"guestfs_h\"
12159
12160 PHP_FUNCTION (guestfs_create);
12161 PHP_FUNCTION (guestfs_last_error);
12162 ";
12163
12164   List.iter (
12165     fun (shortname, style, _, _, _, _, _) ->
12166       pr "PHP_FUNCTION (guestfs_%s);\n" shortname
12167   ) all_functions_sorted;
12168
12169   pr "\
12170
12171 extern zend_module_entry guestfs_php_module_entry;
12172 #define phpext_guestfs_php_ptr &guestfs_php_module_entry
12173
12174 #endif /* PHP_GUESTFS_PHP_H */
12175 "
12176
12177 and generate_php_c () =
12178   generate_header CStyle LGPLv2plus;
12179
12180   pr "\
12181 /* NOTE: Be very careful with all macros in PHP header files.  The
12182  * morons who wrote them aren't good at making them safe for inclusion
12183  * in arbitrary places in C code, eg. not using 'do ... while(0)'
12184  * or parenthesizing any of the arguments.
12185  */
12186
12187 /* NOTE (2): Some parts of the API can't be used on 32 bit platforms.
12188  * Any 64 bit numbers will be truncated.  There's no easy way around
12189  * this in PHP.
12190  */
12191
12192 #include <config.h>
12193
12194 #include <stdio.h>
12195 #include <stdlib.h>
12196
12197 #include <php.h>
12198 #include <php_guestfs_php.h>
12199
12200 #include \"guestfs.h\"
12201
12202 static int res_guestfs_h;
12203
12204 static void
12205 guestfs_php_handle_dtor (zend_rsrc_list_entry *rsrc TSRMLS_DC)
12206 {
12207   guestfs_h *g = (guestfs_h *) rsrc->ptr;
12208   if (g != NULL)
12209     guestfs_close (g);
12210 }
12211
12212 PHP_MINIT_FUNCTION (guestfs_php)
12213 {
12214   res_guestfs_h =
12215     zend_register_list_destructors_ex (guestfs_php_handle_dtor,
12216     NULL, PHP_GUESTFS_HANDLE_RES_NAME, module_number);
12217 }
12218
12219 static function_entry guestfs_php_functions[] = {
12220   PHP_FE (guestfs_create, NULL)
12221   PHP_FE (guestfs_last_error, NULL)
12222 ";
12223
12224   List.iter (
12225     fun (shortname, style, _, _, _, _, _) ->
12226       pr "  PHP_FE (guestfs_%s, NULL)\n" shortname
12227   ) all_functions_sorted;
12228
12229   pr "  { NULL, NULL, NULL }
12230 };
12231
12232 zend_module_entry guestfs_php_module_entry = {
12233 #if ZEND_MODULE_API_NO >= 20010901
12234   STANDARD_MODULE_HEADER,
12235 #endif
12236   PHP_GUESTFS_PHP_EXTNAME,
12237   guestfs_php_functions,
12238   PHP_MINIT (guestfs_php),
12239   NULL,
12240   NULL,
12241   NULL,
12242   NULL,
12243 #if ZEND_MODULE_API_NO >= 20010901
12244   PHP_GUESTFS_PHP_VERSION,
12245 #endif
12246   STANDARD_MODULE_PROPERTIES
12247 };
12248
12249 #ifdef COMPILE_DL_GUESTFS_PHP
12250 ZEND_GET_MODULE (guestfs_php)
12251 #endif
12252
12253 PHP_FUNCTION (guestfs_create)
12254 {
12255   guestfs_h *g = guestfs_create ();
12256   if (g == NULL) {
12257     RETURN_FALSE;
12258   }
12259
12260   guestfs_set_error_handler (g, NULL, NULL);
12261
12262   ZEND_REGISTER_RESOURCE (return_value, g, res_guestfs_h);
12263 }
12264
12265 PHP_FUNCTION (guestfs_last_error)
12266 {
12267   zval *z_g;
12268   guestfs_h *g;
12269
12270   if (zend_parse_parameters (ZEND_NUM_ARGS() TSRMLS_CC, \"r\",
12271                              &z_g) == FAILURE) {
12272     RETURN_FALSE;
12273   }
12274
12275   ZEND_FETCH_RESOURCE (g, guestfs_h *, &z_g, -1, PHP_GUESTFS_HANDLE_RES_NAME,
12276                        res_guestfs_h);
12277   if (g == NULL) {
12278     RETURN_FALSE;
12279   }
12280
12281   const char *err = guestfs_last_error (g);
12282   if (err) {
12283     RETURN_STRING (err, 1);
12284   } else {
12285     RETURN_NULL ();
12286   }
12287 }
12288
12289 ";
12290
12291   (* Now generate the PHP bindings for each action. *)
12292   List.iter (
12293     fun (shortname, style, _, _, _, _, _) ->
12294       pr "PHP_FUNCTION (guestfs_%s)\n" shortname;
12295       pr "{\n";
12296       pr "  zval *z_g;\n";
12297       pr "  guestfs_h *g;\n";
12298
12299       List.iter (
12300         function
12301         | String n | Device n | Pathname n | Dev_or_Path n
12302         | FileIn n | FileOut n | Key n
12303         | OptString n
12304         | BufferIn n ->
12305             pr "  char *%s;\n" n;
12306             pr "  int %s_size;\n" n
12307         | StringList n
12308         | DeviceList n ->
12309             pr "  zval *z_%s;\n" n;
12310             pr "  char **%s;\n" n;
12311         | Bool n ->
12312             pr "  zend_bool %s;\n" n
12313         | Int n | Int64 n ->
12314             pr "  long %s;\n" n
12315         ) (snd style);
12316
12317       pr "\n";
12318
12319       (* Parse the parameters. *)
12320       let param_string = String.concat "" (
12321         List.map (
12322           function
12323           | String n | Device n | Pathname n | Dev_or_Path n
12324           | FileIn n | FileOut n | BufferIn n | Key n -> "s"
12325           | OptString n -> "s!"
12326           | StringList n | DeviceList n -> "a"
12327           | Bool n -> "b"
12328           | Int n | Int64 n -> "l"
12329         ) (snd style)
12330       ) in
12331
12332       pr "  if (zend_parse_parameters (ZEND_NUM_ARGS() TSRMLS_CC, \"r%s\",\n"
12333         param_string;
12334       pr "        &z_g";
12335       List.iter (
12336         function
12337         | String n | Device n | Pathname n | Dev_or_Path n
12338         | FileIn n | FileOut n | BufferIn n | Key n
12339         | OptString n ->
12340             pr ", &%s, &%s_size" n n
12341         | StringList n | DeviceList n ->
12342             pr ", &z_%s" n
12343         | Bool n ->
12344             pr ", &%s" n
12345         | Int n | Int64 n ->
12346             pr ", &%s" n
12347       ) (snd style);
12348       pr ") == FAILURE) {\n";
12349       pr "    RETURN_FALSE;\n";
12350       pr "  }\n";
12351       pr "\n";
12352       pr "  ZEND_FETCH_RESOURCE (g, guestfs_h *, &z_g, -1, PHP_GUESTFS_HANDLE_RES_NAME,\n";
12353       pr "                       res_guestfs_h);\n";
12354       pr "  if (g == NULL) {\n";
12355       pr "    RETURN_FALSE;\n";
12356       pr "  }\n";
12357       pr "\n";
12358
12359       List.iter (
12360         function
12361         | String n | Device n | Pathname n | Dev_or_Path n
12362         | FileIn n | FileOut n | Key n
12363         | OptString n ->
12364             (* Just need to check the string doesn't contain any ASCII
12365              * NUL characters, which won't be supported by the C API.
12366              *)
12367             pr "  if (strlen (%s) != %s_size) {\n" n n;
12368             pr "    fprintf (stderr, \"libguestfs: %s: parameter '%s' contains embedded ASCII NUL.\\n\");\n" shortname n;
12369             pr "    RETURN_FALSE;\n";
12370             pr "  }\n";
12371             pr "\n"
12372         | BufferIn n -> ()
12373         | StringList n
12374         | DeviceList n ->
12375             (* Convert array to list of strings.
12376              * http://marc.info/?l=pecl-dev&m=112205192100631&w=2
12377              *)
12378             pr "  {\n";
12379             pr "    HashTable *a;\n";
12380             pr "    int n;\n";
12381             pr "    HashPosition p;\n";
12382             pr "    zval **d;\n";
12383             pr "    size_t c = 0;\n";
12384             pr "\n";
12385             pr "    a = Z_ARRVAL_P (z_%s);\n" n;
12386             pr "    n = zend_hash_num_elements (a);\n";
12387             pr "    %s = safe_emalloc (n + 1, sizeof (char *), 0);\n" n;
12388             pr "    for (zend_hash_internal_pointer_reset_ex (a, &p);\n";
12389             pr "         zend_hash_get_current_data_ex (a, (void **) &d, &p) == SUCCESS;\n";
12390             pr "         zend_hash_move_forward_ex (a, &p)) {\n";
12391             pr "      zval t = **d;\n";
12392             pr "      zval_copy_ctor (&t);\n";
12393             pr "      convert_to_string (&t);\n";
12394             pr "      %s[c] = Z_STRVAL (t);\n" n;
12395             pr "      c++;\n";
12396             pr "    }\n";
12397             pr "    %s[c] = NULL;\n" n;
12398             pr "  }\n";
12399             pr "\n"
12400         | Bool n | Int n | Int64 n -> ()
12401         ) (snd style);
12402
12403       (* Return value. *)
12404       let error_code =
12405         match fst style with
12406         | RErr -> pr "  int r;\n"; "-1"
12407         | RBool _
12408         | RInt _ -> pr "  int r;\n"; "-1"
12409         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
12410         | RConstString _ -> pr "  const char *r;\n"; "NULL"
12411         | RConstOptString _ -> pr "  const char *r;\n"; "NULL"
12412         | RString _ ->
12413             pr "  char *r;\n"; "NULL"
12414         | RStringList _ ->
12415             pr "  char **r;\n"; "NULL"
12416         | RStruct (_, typ) ->
12417             pr "  struct guestfs_%s *r;\n" typ; "NULL"
12418         | RStructList (_, typ) ->
12419             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
12420         | RHashtable _ ->
12421             pr "  char **r;\n"; "NULL"
12422         | RBufferOut _ ->
12423             pr "  char *r;\n";
12424             pr "  size_t size;\n";
12425             "NULL" in
12426
12427       (* Call the function. *)
12428       pr "  r = guestfs_%s " shortname;
12429       generate_c_call_args ~handle:"g" style;
12430       pr ";\n";
12431       pr "\n";
12432
12433       (* Free up parameters. *)
12434       List.iter (
12435         function
12436         | String n | Device n | Pathname n | Dev_or_Path n
12437         | FileIn n | FileOut n | Key n
12438         | OptString n -> ()
12439         | BufferIn n -> ()
12440         | StringList n
12441         | DeviceList n ->
12442             pr "  {\n";
12443             pr "    size_t c = 0;\n";
12444             pr "\n";
12445             pr "    for (c = 0; %s[c] != NULL; ++c)\n" n;
12446             pr "      efree (%s[c]);\n" n;
12447             pr "    efree (%s);\n" n;
12448             pr "  }\n";
12449             pr "\n"
12450         | Bool n | Int n | Int64 n -> ()
12451         ) (snd style);
12452
12453       (* Check for errors. *)
12454       pr "  if (r == %s) {\n" error_code;
12455       pr "    RETURN_FALSE;\n";
12456       pr "  }\n";
12457       pr "\n";
12458
12459       (* Convert the return value. *)
12460       (match fst style with
12461        | RErr ->
12462            pr "  RETURN_TRUE;\n"
12463        | RBool _ ->
12464            pr "  RETURN_BOOL (r);\n"
12465        | RInt _ ->
12466            pr "  RETURN_LONG (r);\n"
12467        | RInt64 _ ->
12468            pr "  RETURN_LONG (r);\n"
12469        | RConstString _ ->
12470            pr "  RETURN_STRING (r, 1);\n"
12471        | RConstOptString _ ->
12472            pr "  if (r) { RETURN_STRING (r, 1); }\n";
12473            pr "  else { RETURN_NULL (); }\n"
12474        | RString _ ->
12475            pr "  char *r_copy = estrdup (r);\n";
12476            pr "  free (r);\n";
12477            pr "  RETURN_STRING (r_copy, 0);\n"
12478        | RBufferOut _ ->
12479            pr "  char *r_copy = estrndup (r, size);\n";
12480            pr "  free (r);\n";
12481            pr "  RETURN_STRING (r_copy, 0);\n"
12482        | RStringList _ ->
12483            pr "  size_t c = 0;\n";
12484            pr "  array_init (return_value);\n";
12485            pr "  for (c = 0; r[c] != NULL; ++c) {\n";
12486            pr "    add_next_index_string (return_value, r[c], 1);\n";
12487            pr "    free (r[c]);\n";
12488            pr "  }\n";
12489            pr "  free (r);\n";
12490        | RHashtable _ ->
12491            pr "  size_t c = 0;\n";
12492            pr "  array_init (return_value);\n";
12493            pr "  for (c = 0; r[c] != NULL; c += 2) {\n";
12494            pr "    add_assoc_string (return_value, r[c], r[c+1], 1);\n";
12495            pr "    free (r[c]);\n";
12496            pr "    free (r[c+1]);\n";
12497            pr "  }\n";
12498            pr "  free (r);\n";
12499        | RStruct (_, typ) ->
12500            let cols = cols_of_struct typ in
12501            generate_php_struct_code typ cols
12502        | RStructList (_, typ) ->
12503            let cols = cols_of_struct typ in
12504            generate_php_struct_list_code typ cols
12505       );
12506
12507       pr "}\n";
12508       pr "\n"
12509   ) all_functions_sorted
12510
12511 and generate_php_struct_code typ cols =
12512   pr "  array_init (return_value);\n";
12513   List.iter (
12514     function
12515     | name, FString ->
12516         pr "  add_assoc_string (return_value, \"%s\", r->%s, 1);\n" name name
12517     | name, FBuffer ->
12518         pr "  add_assoc_stringl (return_value, \"%s\", r->%s, r->%s_len, 1);\n"
12519           name name name
12520     | name, FUUID ->
12521         pr "  add_assoc_stringl (return_value, \"%s\", r->%s, 32, 1);\n"
12522           name name
12523     | name, (FBytes|FUInt64|FInt64|FInt32|FUInt32) ->
12524         pr "  add_assoc_long (return_value, \"%s\", r->%s);\n"
12525           name name
12526     | name, FChar ->
12527         pr "  add_assoc_stringl (return_value, \"%s\", &r->%s, 1, 1);\n"
12528           name name
12529     | name, FOptPercent ->
12530         pr "  add_assoc_double (return_value, \"%s\", r->%s);\n"
12531           name name
12532   ) cols;
12533   pr "  guestfs_free_%s (r);\n" typ
12534
12535 and generate_php_struct_list_code typ cols =
12536   pr "  array_init (return_value);\n";
12537   pr "  size_t c = 0;\n";
12538   pr "  for (c = 0; c < r->len; ++c) {\n";
12539   pr "    zval *z_elem;\n";
12540   pr "    ALLOC_INIT_ZVAL (z_elem);\n";
12541   pr "    array_init (z_elem);\n";
12542   List.iter (
12543     function
12544     | name, FString ->
12545         pr "    add_assoc_string (z_elem, \"%s\", r->val[c].%s, 1);\n"
12546           name name
12547     | name, FBuffer ->
12548         pr "    add_assoc_stringl (z_elem, \"%s\", r->val[c].%s, r->val[c].%s_len, 1);\n"
12549           name name name
12550     | name, FUUID ->
12551         pr "    add_assoc_stringl (z_elem, \"%s\", r->val[c].%s, 32, 1);\n"
12552           name name
12553     | name, (FBytes|FUInt64|FInt64|FInt32|FUInt32) ->
12554         pr "    add_assoc_long (z_elem, \"%s\", r->val[c].%s);\n"
12555           name name
12556     | name, FChar ->
12557         pr "    add_assoc_stringl (z_elem, \"%s\", &r->val[c].%s, 1, 1);\n"
12558           name name
12559     | name, FOptPercent ->
12560         pr "    add_assoc_double (z_elem, \"%s\", r->val[c].%s);\n"
12561           name name
12562   ) cols;
12563   pr "    add_next_index_zval (return_value, z_elem);\n";
12564   pr "  }\n";
12565   pr "  guestfs_free_%s_list (r);\n" typ
12566
12567 and generate_bindtests () =
12568   generate_header CStyle LGPLv2plus;
12569
12570   pr "\
12571 #include <stdio.h>
12572 #include <stdlib.h>
12573 #include <inttypes.h>
12574 #include <string.h>
12575
12576 #include \"guestfs.h\"
12577 #include \"guestfs-internal.h\"
12578 #include \"guestfs-internal-actions.h\"
12579 #include \"guestfs_protocol.h\"
12580
12581 #define error guestfs_error
12582 #define safe_calloc guestfs_safe_calloc
12583 #define safe_malloc guestfs_safe_malloc
12584
12585 static void
12586 print_strings (char *const *argv)
12587 {
12588   size_t argc;
12589
12590   printf (\"[\");
12591   for (argc = 0; argv[argc] != NULL; ++argc) {
12592     if (argc > 0) printf (\", \");
12593     printf (\"\\\"%%s\\\"\", argv[argc]);
12594   }
12595   printf (\"]\\n\");
12596 }
12597
12598 /* The test0 function prints its parameters to stdout. */
12599 ";
12600
12601   let test0, tests =
12602     match test_functions with
12603     | [] -> assert false
12604     | test0 :: tests -> test0, tests in
12605
12606   let () =
12607     let (name, style, _, _, _, _, _) = test0 in
12608     generate_prototype ~extern:false ~semicolon:false ~newline:true
12609       ~handle:"g" ~prefix:"guestfs__" name style;
12610     pr "{\n";
12611     List.iter (
12612       function
12613       | Pathname n
12614       | Device n | Dev_or_Path n
12615       | String n
12616       | FileIn n
12617       | FileOut n
12618       | Key n -> pr "  printf (\"%%s\\n\", %s);\n" n
12619       | BufferIn n ->
12620           pr "  {\n";
12621           pr "    size_t i;\n";
12622           pr "    for (i = 0; i < %s_size; ++i)\n" n;
12623           pr "      printf (\"<%%02x>\", %s[i]);\n" n;
12624           pr "    printf (\"\\n\");\n";
12625           pr "  }\n";
12626       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
12627       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
12628       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
12629       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
12630       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
12631     ) (snd style);
12632     pr "  /* Java changes stdout line buffering so we need this: */\n";
12633     pr "  fflush (stdout);\n";
12634     pr "  return 0;\n";
12635     pr "}\n";
12636     pr "\n" in
12637
12638   List.iter (
12639     fun (name, style, _, _, _, _, _) ->
12640       if String.sub name (String.length name - 3) 3 <> "err" then (
12641         pr "/* Test normal return. */\n";
12642         generate_prototype ~extern:false ~semicolon:false ~newline:true
12643           ~handle:"g" ~prefix:"guestfs__" name style;
12644         pr "{\n";
12645         (match fst style with
12646          | RErr ->
12647              pr "  return 0;\n"
12648          | RInt _ ->
12649              pr "  int r;\n";
12650              pr "  sscanf (val, \"%%d\", &r);\n";
12651              pr "  return r;\n"
12652          | RInt64 _ ->
12653              pr "  int64_t r;\n";
12654              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
12655              pr "  return r;\n"
12656          | RBool _ ->
12657              pr "  return STREQ (val, \"true\");\n"
12658          | RConstString _
12659          | RConstOptString _ ->
12660              (* Can't return the input string here.  Return a static
12661               * string so we ensure we get a segfault if the caller
12662               * tries to free it.
12663               *)
12664              pr "  return \"static string\";\n"
12665          | RString _ ->
12666              pr "  return strdup (val);\n"
12667          | RStringList _ ->
12668              pr "  char **strs;\n";
12669              pr "  int n, i;\n";
12670              pr "  sscanf (val, \"%%d\", &n);\n";
12671              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
12672              pr "  for (i = 0; i < n; ++i) {\n";
12673              pr "    strs[i] = safe_malloc (g, 16);\n";
12674              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
12675              pr "  }\n";
12676              pr "  strs[n] = NULL;\n";
12677              pr "  return strs;\n"
12678          | RStruct (_, typ) ->
12679              pr "  struct guestfs_%s *r;\n" typ;
12680              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
12681              pr "  return r;\n"
12682          | RStructList (_, typ) ->
12683              pr "  struct guestfs_%s_list *r;\n" typ;
12684              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
12685              pr "  sscanf (val, \"%%d\", &r->len);\n";
12686              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
12687              pr "  return r;\n"
12688          | RHashtable _ ->
12689              pr "  char **strs;\n";
12690              pr "  int n, i;\n";
12691              pr "  sscanf (val, \"%%d\", &n);\n";
12692              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
12693              pr "  for (i = 0; i < n; ++i) {\n";
12694              pr "    strs[i*2] = safe_malloc (g, 16);\n";
12695              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
12696              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
12697              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
12698              pr "  }\n";
12699              pr "  strs[n*2] = NULL;\n";
12700              pr "  return strs;\n"
12701          | RBufferOut _ ->
12702              pr "  return strdup (val);\n"
12703         );
12704         pr "}\n";
12705         pr "\n"
12706       ) else (
12707         pr "/* Test error return. */\n";
12708         generate_prototype ~extern:false ~semicolon:false ~newline:true
12709           ~handle:"g" ~prefix:"guestfs__" name style;
12710         pr "{\n";
12711         pr "  error (g, \"error\");\n";
12712         (match fst style with
12713          | RErr | RInt _ | RInt64 _ | RBool _ ->
12714              pr "  return -1;\n"
12715          | RConstString _ | RConstOptString _
12716          | RString _ | RStringList _ | RStruct _
12717          | RStructList _
12718          | RHashtable _
12719          | RBufferOut _ ->
12720              pr "  return NULL;\n"
12721         );
12722         pr "}\n";
12723         pr "\n"
12724       )
12725   ) tests
12726
12727 and generate_ocaml_bindtests () =
12728   generate_header OCamlStyle GPLv2plus;
12729
12730   pr "\
12731 let () =
12732   let g = Guestfs.create () in
12733 ";
12734
12735   let mkargs args =
12736     String.concat " " (
12737       List.map (
12738         function
12739         | CallString s -> "\"" ^ s ^ "\""
12740         | CallOptString None -> "None"
12741         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
12742         | CallStringList xs ->
12743             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
12744         | CallInt i when i >= 0 -> string_of_int i
12745         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
12746         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
12747         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
12748         | CallBool b -> string_of_bool b
12749         | CallBuffer s -> sprintf "%S" s
12750       ) args
12751     )
12752   in
12753
12754   generate_lang_bindtests (
12755     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
12756   );
12757
12758   pr "print_endline \"EOF\"\n"
12759
12760 and generate_perl_bindtests () =
12761   pr "#!/usr/bin/perl -w\n";
12762   generate_header HashStyle GPLv2plus;
12763
12764   pr "\
12765 use strict;
12766
12767 use Sys::Guestfs;
12768
12769 my $g = Sys::Guestfs->new ();
12770 ";
12771
12772   let mkargs args =
12773     String.concat ", " (
12774       List.map (
12775         function
12776         | CallString s -> "\"" ^ s ^ "\""
12777         | CallOptString None -> "undef"
12778         | CallOptString (Some s) -> sprintf "\"%s\"" s
12779         | CallStringList xs ->
12780             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
12781         | CallInt i -> string_of_int i
12782         | CallInt64 i -> Int64.to_string i
12783         | CallBool b -> if b then "1" else "0"
12784         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
12785       ) args
12786     )
12787   in
12788
12789   generate_lang_bindtests (
12790     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
12791   );
12792
12793   pr "print \"EOF\\n\"\n"
12794
12795 and generate_python_bindtests () =
12796   generate_header HashStyle GPLv2plus;
12797
12798   pr "\
12799 import guestfs
12800
12801 g = guestfs.GuestFS ()
12802 ";
12803
12804   let mkargs args =
12805     String.concat ", " (
12806       List.map (
12807         function
12808         | CallString s -> "\"" ^ s ^ "\""
12809         | CallOptString None -> "None"
12810         | CallOptString (Some s) -> sprintf "\"%s\"" s
12811         | CallStringList xs ->
12812             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
12813         | CallInt i -> string_of_int i
12814         | CallInt64 i -> Int64.to_string i
12815         | CallBool b -> if b then "1" else "0"
12816         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
12817       ) args
12818     )
12819   in
12820
12821   generate_lang_bindtests (
12822     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
12823   );
12824
12825   pr "print \"EOF\"\n"
12826
12827 and generate_ruby_bindtests () =
12828   generate_header HashStyle GPLv2plus;
12829
12830   pr "\
12831 require 'guestfs'
12832
12833 g = Guestfs::create()
12834 ";
12835
12836   let mkargs args =
12837     String.concat ", " (
12838       List.map (
12839         function
12840         | CallString s -> "\"" ^ s ^ "\""
12841         | CallOptString None -> "nil"
12842         | CallOptString (Some s) -> sprintf "\"%s\"" s
12843         | CallStringList xs ->
12844             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
12845         | CallInt i -> string_of_int i
12846         | CallInt64 i -> Int64.to_string i
12847         | CallBool b -> string_of_bool b
12848         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
12849       ) args
12850     )
12851   in
12852
12853   generate_lang_bindtests (
12854     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
12855   );
12856
12857   pr "print \"EOF\\n\"\n"
12858
12859 and generate_java_bindtests () =
12860   generate_header CStyle GPLv2plus;
12861
12862   pr "\
12863 import com.redhat.et.libguestfs.*;
12864
12865 public class Bindtests {
12866     public static void main (String[] argv)
12867     {
12868         try {
12869             GuestFS g = new GuestFS ();
12870 ";
12871
12872   let mkargs args =
12873     String.concat ", " (
12874       List.map (
12875         function
12876         | CallString s -> "\"" ^ s ^ "\""
12877         | CallOptString None -> "null"
12878         | CallOptString (Some s) -> sprintf "\"%s\"" s
12879         | CallStringList xs ->
12880             "new String[]{" ^
12881               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
12882         | CallInt i -> string_of_int i
12883         | CallInt64 i -> Int64.to_string i
12884         | CallBool b -> string_of_bool b
12885         | CallBuffer s ->
12886             "new byte[] { " ^ String.concat "," (
12887               map_chars (fun c -> string_of_int (Char.code c)) s
12888             ) ^ " }"
12889       ) args
12890     )
12891   in
12892
12893   generate_lang_bindtests (
12894     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
12895   );
12896
12897   pr "
12898             System.out.println (\"EOF\");
12899         }
12900         catch (Exception exn) {
12901             System.err.println (exn);
12902             System.exit (1);
12903         }
12904     }
12905 }
12906 "
12907
12908 and generate_haskell_bindtests () =
12909   generate_header HaskellStyle GPLv2plus;
12910
12911   pr "\
12912 module Bindtests where
12913 import qualified Guestfs
12914
12915 main = do
12916   g <- Guestfs.create
12917 ";
12918
12919   let mkargs args =
12920     String.concat " " (
12921       List.map (
12922         function
12923         | CallString s -> "\"" ^ s ^ "\""
12924         | CallOptString None -> "Nothing"
12925         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
12926         | CallStringList xs ->
12927             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
12928         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
12929         | CallInt i -> string_of_int i
12930         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
12931         | CallInt64 i -> Int64.to_string i
12932         | CallBool true -> "True"
12933         | CallBool false -> "False"
12934         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
12935       ) args
12936     )
12937   in
12938
12939   generate_lang_bindtests (
12940     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
12941   );
12942
12943   pr "  putStrLn \"EOF\"\n"
12944
12945 (* Language-independent bindings tests - we do it this way to
12946  * ensure there is parity in testing bindings across all languages.
12947  *)
12948 and generate_lang_bindtests call =
12949   call "test0" [CallString "abc"; CallOptString (Some "def");
12950                 CallStringList []; CallBool false;
12951                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12952                 CallBuffer "abc\000abc"];
12953   call "test0" [CallString "abc"; CallOptString None;
12954                 CallStringList []; CallBool false;
12955                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12956                 CallBuffer "abc\000abc"];
12957   call "test0" [CallString ""; CallOptString (Some "def");
12958                 CallStringList []; CallBool false;
12959                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12960                 CallBuffer "abc\000abc"];
12961   call "test0" [CallString ""; CallOptString (Some "");
12962                 CallStringList []; CallBool false;
12963                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12964                 CallBuffer "abc\000abc"];
12965   call "test0" [CallString "abc"; CallOptString (Some "def");
12966                 CallStringList ["1"]; CallBool false;
12967                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12968                 CallBuffer "abc\000abc"];
12969   call "test0" [CallString "abc"; CallOptString (Some "def");
12970                 CallStringList ["1"; "2"]; CallBool false;
12971                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12972                 CallBuffer "abc\000abc"];
12973   call "test0" [CallString "abc"; CallOptString (Some "def");
12974                 CallStringList ["1"]; CallBool true;
12975                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
12976                 CallBuffer "abc\000abc"];
12977   call "test0" [CallString "abc"; CallOptString (Some "def");
12978                 CallStringList ["1"]; CallBool false;
12979                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
12980                 CallBuffer "abc\000abc"];
12981   call "test0" [CallString "abc"; CallOptString (Some "def");
12982                 CallStringList ["1"]; CallBool false;
12983                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
12984                 CallBuffer "abc\000abc"];
12985   call "test0" [CallString "abc"; CallOptString (Some "def");
12986                 CallStringList ["1"]; CallBool false;
12987                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
12988                 CallBuffer "abc\000abc"];
12989   call "test0" [CallString "abc"; CallOptString (Some "def");
12990                 CallStringList ["1"]; CallBool false;
12991                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
12992                 CallBuffer "abc\000abc"];
12993   call "test0" [CallString "abc"; CallOptString (Some "def");
12994                 CallStringList ["1"]; CallBool false;
12995                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
12996                 CallBuffer "abc\000abc"];
12997   call "test0" [CallString "abc"; CallOptString (Some "def");
12998                 CallStringList ["1"]; CallBool false;
12999                 CallInt 0; CallInt64 0L; CallString ""; CallString "";
13000                 CallBuffer "abc\000abc"]
13001
13002 (* XXX Add here tests of the return and error functions. *)
13003
13004 and generate_max_proc_nr () =
13005   pr "%d\n" max_proc_nr
13006
13007 let output_to filename k =
13008   let filename_new = filename ^ ".new" in
13009   chan := open_out filename_new;
13010   k ();
13011   close_out !chan;
13012   chan := Pervasives.stdout;
13013
13014   (* Is the new file different from the current file? *)
13015   if Sys.file_exists filename && files_equal filename filename_new then
13016     unlink filename_new                 (* same, so skip it *)
13017   else (
13018     (* different, overwrite old one *)
13019     (try chmod filename 0o644 with Unix_error _ -> ());
13020     rename filename_new filename;
13021     chmod filename 0o444;
13022     printf "written %s\n%!" filename;
13023   )
13024
13025 let perror msg = function
13026   | Unix_error (err, _, _) ->
13027       eprintf "%s: %s\n" msg (error_message err)
13028   | exn ->
13029       eprintf "%s: %s\n" msg (Printexc.to_string exn)
13030
13031 (* Main program. *)
13032 let () =
13033   let lock_fd =
13034     try openfile "HACKING" [O_RDWR] 0
13035     with
13036     | Unix_error (ENOENT, _, _) ->
13037         eprintf "\
13038 You are probably running this from the wrong directory.
13039 Run it from the top source directory using the command
13040   src/generator.ml
13041 ";
13042         exit 1
13043     | exn ->
13044         perror "open: HACKING" exn;
13045         exit 1 in
13046
13047   (* Acquire a lock so parallel builds won't try to run the generator
13048    * twice at the same time.  Subsequent builds will wait for the first
13049    * one to finish.  Note the lock is released implicitly when the
13050    * program exits.
13051    *)
13052   (try lockf lock_fd F_LOCK 1
13053    with exn ->
13054      perror "lock: HACKING" exn;
13055      exit 1);
13056
13057   check_functions ();
13058
13059   output_to "src/guestfs_protocol.x" generate_xdr;
13060   output_to "src/guestfs-structs.h" generate_structs_h;
13061   output_to "src/guestfs-actions.h" generate_actions_h;
13062   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
13063   output_to "src/actions.c" generate_client_actions;
13064   output_to "src/bindtests.c" generate_bindtests;
13065   output_to "src/guestfs-structs.pod" generate_structs_pod;
13066   output_to "src/guestfs-actions.pod" generate_actions_pod;
13067   output_to "src/guestfs-availability.pod" generate_availability_pod;
13068   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
13069   output_to "src/libguestfs.syms" generate_linker_script;
13070   output_to "daemon/actions.h" generate_daemon_actions_h;
13071   output_to "daemon/stubs.c" generate_daemon_actions;
13072   output_to "daemon/names.c" generate_daemon_names;
13073   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
13074   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
13075   output_to "capitests/tests.c" generate_tests;
13076   output_to "fish/cmds.c" generate_fish_cmds;
13077   output_to "fish/completion.c" generate_fish_completion;
13078   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
13079   output_to "fish/prepopts.c" generate_fish_prep_options_c;
13080   output_to "fish/prepopts.h" generate_fish_prep_options_h;
13081   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
13082   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
13083   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
13084   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
13085   output_to "perl/Guestfs.xs" generate_perl_xs;
13086   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
13087   output_to "perl/bindtests.pl" generate_perl_bindtests;
13088   output_to "python/guestfs-py.c" generate_python_c;
13089   output_to "python/guestfs.py" generate_python_py;
13090   output_to "python/bindtests.py" generate_python_bindtests;
13091   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
13092   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
13093   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
13094
13095   List.iter (
13096     fun (typ, jtyp) ->
13097       let cols = cols_of_struct typ in
13098       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
13099       output_to filename (generate_java_struct jtyp cols);
13100   ) java_structs;
13101
13102   output_to "java/Makefile.inc" generate_java_makefile_inc;
13103   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
13104   output_to "java/Bindtests.java" generate_java_bindtests;
13105   output_to "haskell/Guestfs.hs" generate_haskell_hs;
13106   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
13107   output_to "csharp/Libguestfs.cs" generate_csharp;
13108   output_to "php/extension/php_guestfs_php.h" generate_php_h;
13109   output_to "php/extension/guestfs_php.c" generate_php_c;
13110
13111   (* Always generate this file last, and unconditionally.  It's used
13112    * by the Makefile to know when we must re-run the generator.
13113    *)
13114   let chan = open_out "src/stamp-generator" in
13115   fprintf chan "1\n";
13116   close_out chan;
13117
13118   printf "generated %d lines of code\n" !lines