2ffe19dad26a78caf28c02a88c654efbfff66466
[libguestfs.git] / src / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009 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 below), and
25  * daemon/<somefile>.c to write the implementation.
26  *
27  * After editing this file, run it (./src/generator.ml) to regenerate
28  * all the output files.
29  *
30  * IMPORTANT: This script should NOT print any warnings.  If it prints
31  * warnings, you should treat them as errors.
32  * [Need to add -warn-error to ocaml command line]
33  *)
34
35 #load "unix.cma";;
36 #load "str.cma";;
37
38 open Printf
39
40 type style = ret * args
41 and ret =
42     (* "RErr" as a return value means an int used as a simple error
43      * indication, ie. 0 or -1.
44      *)
45   | RErr
46     (* "RInt" as a return value means an int which is -1 for error
47      * or any value >= 0 on success.  Only use this for smallish
48      * positive ints (0 <= i < 2^30).
49      *)
50   | RInt of string
51     (* "RInt64" is the same as RInt, but is guaranteed to be able
52      * to return a full 64 bit value, _except_ that -1 means error
53      * (so -1 cannot be a valid, non-error return value).
54      *)
55   | RInt64 of string
56     (* "RBool" is a bool return value which can be true/false or
57      * -1 for error.
58      *)
59   | RBool of string
60     (* "RConstString" is a string that refers to a constant value.
61      * Try to avoid using this.  In particular you cannot use this
62      * for values returned from the daemon, because there is no
63      * thread-safe way to return them in the C API.
64      *)
65   | RConstString of string
66     (* "RString" and "RStringList" are caller-frees. *)
67   | RString of string
68   | RStringList of string
69     (* Some limited tuples are possible: *)
70   | RIntBool of string * string
71     (* LVM PVs, VGs and LVs. *)
72   | RPVList of string
73   | RVGList of string
74   | RLVList of string
75     (* Stat buffers. *)
76   | RStat of string
77   | RStatVFS of string
78     (* Key-value pairs of untyped strings.  Turns into a hashtable or
79      * dictionary in languages which support it.  DON'T use this as a
80      * general "bucket" for results.  Prefer a stronger typed return
81      * value if one is available, or write a custom struct.  Don't use
82      * this if the list could potentially be very long, since it is
83      * inefficient.  Keys should be unique.  NULLs are not permitted.
84      *)
85   | RHashtable of string
86
87 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
88
89     (* Note in future we should allow a "variable args" parameter as
90      * the final parameter, to allow commands like
91      *   chmod mode file [file(s)...]
92      * This is not implemented yet, but many commands (such as chmod)
93      * are currently defined with the argument order keeping this future
94      * possibility in mind.
95      *)
96 and argt =
97   | String of string    (* const char *name, cannot be NULL *)
98   | OptString of string (* const char *name, may be NULL *)
99   | StringList of string(* list of strings (each string cannot be NULL) *)
100   | Bool of string      (* boolean *)
101   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
102     (* These are treated as filenames (simple string parameters) in
103      * the C API and bindings.  But in the RPC protocol, we transfer
104      * the actual file content up to or down from the daemon.
105      * FileIn: local machine -> daemon (in request)
106      * FileOut: daemon -> local machine (in reply)
107      * In guestfish (only), the special name "-" means read from
108      * stdin or write to stdout.
109      *)
110   | FileIn of string
111   | FileOut of string
112
113 type flags =
114   | ProtocolLimitWarning  (* display warning about protocol size limits *)
115   | DangerWillRobinson    (* flags particularly dangerous commands *)
116   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
117   | FishAction of string  (* call this function in guestfish *)
118   | NotInFish             (* do not export via guestfish *)
119
120 let protocol_limit_warning =
121   "Because of the message protocol, there is a transfer limit 
122 of somewhere between 2MB and 4MB.  To transfer large files you should use
123 FTP."
124
125 let danger_will_robinson =
126   "B<This command is dangerous.  Without careful use you
127 can easily destroy all your data>."
128
129 (* You can supply zero or as many tests as you want per API call.
130  *
131  * Note that the test environment has 3 block devices, of size 500MB,
132  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
133  * Note for partitioning purposes, the 500MB device has 63 cylinders.
134  *
135  * To be able to run the tests in a reasonable amount of time,
136  * the virtual machine and block devices are reused between tests.
137  * So don't try testing kill_subprocess :-x
138  *
139  * Between each test we umount-all and lvm-remove-all (except InitNone).
140  *
141  * Don't assume anything about the previous contents of the block
142  * devices.  Use 'Init*' to create some initial scenarios.
143  *)
144 type tests = (test_init * test) list
145 and test =
146     (* Run the command sequence and just expect nothing to fail. *)
147   | TestRun of seq
148     (* Run the command sequence and expect the output of the final
149      * command to be the string.
150      *)
151   | TestOutput of seq * string
152     (* Run the command sequence and expect the output of the final
153      * command to be the list of strings.
154      *)
155   | TestOutputList of seq * string list
156     (* Run the command sequence and expect the output of the final
157      * command to be the integer.
158      *)
159   | TestOutputInt of seq * int
160     (* Run the command sequence and expect the output of the final
161      * command to be a true value (!= 0 or != NULL).
162      *)
163   | TestOutputTrue of seq
164     (* Run the command sequence and expect the output of the final
165      * command to be a false value (== 0 or == NULL, but not an error).
166      *)
167   | TestOutputFalse of seq
168     (* Run the command sequence and expect the output of the final
169      * command to be a list of the given length (but don't care about
170      * content).
171      *)
172   | TestOutputLength of seq * int
173     (* Run the command sequence and expect the output of the final
174      * command to be a structure.
175      *)
176   | TestOutputStruct of seq * test_field_compare list
177     (* Run the command sequence and expect the final command (only)
178      * to fail.
179      *)
180   | TestLastFail of seq
181
182 and test_field_compare =
183   | CompareWithInt of string * int
184   | CompareWithString of string * string
185   | CompareFieldsIntEq of string * string
186   | CompareFieldsStrEq of string * string
187
188 (* Some initial scenarios for testing. *)
189 and test_init =
190     (* Do nothing, block devices could contain random stuff including
191      * LVM PVs, and some filesystems might be mounted.  This is usually
192      * a bad idea.
193      *)
194   | InitNone
195     (* Block devices are empty and no filesystems are mounted. *)
196   | InitEmpty
197     (* /dev/sda contains a single partition /dev/sda1, which is formatted
198      * as ext2, empty [except for lost+found] and mounted on /.
199      * /dev/sdb and /dev/sdc may have random content.
200      * No LVM.
201      *)
202   | InitBasicFS
203     (* /dev/sda:
204      *   /dev/sda1 (is a PV):
205      *     /dev/VG/LV (size 8MB):
206      *       formatted as ext2, empty [except for lost+found], mounted on /
207      * /dev/sdb and /dev/sdc may have random content.
208      *)
209   | InitBasicFSonLVM
210
211 (* Sequence of commands for testing. *)
212 and seq = cmd list
213 and cmd = string list
214
215 (* Note about long descriptions: When referring to another
216  * action, use the format C<guestfs_other> (ie. the full name of
217  * the C function).  This will be replaced as appropriate in other
218  * language bindings.
219  *
220  * Apart from that, long descriptions are just perldoc paragraphs.
221  *)
222
223 let non_daemon_functions = [
224   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
225    [],
226    "launch the qemu subprocess",
227    "\
228 Internally libguestfs is implemented by running a virtual machine
229 using L<qemu(1)>.
230
231 You should call this after configuring the handle
232 (eg. adding drives) but before performing any actions.");
233
234   ("wait_ready", (RErr, []), -1, [NotInFish],
235    [],
236    "wait until the qemu subprocess launches",
237    "\
238 Internally libguestfs is implemented by running a virtual machine
239 using L<qemu(1)>.
240
241 You should call this after C<guestfs_launch> to wait for the launch
242 to complete.");
243
244   ("kill_subprocess", (RErr, []), -1, [],
245    [],
246    "kill the qemu subprocess",
247    "\
248 This kills the qemu subprocess.  You should never need to call this.");
249
250   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
251    [],
252    "add an image to examine or modify",
253    "\
254 This function adds a virtual machine disk image C<filename> to the
255 guest.  The first time you call this function, the disk appears as IDE
256 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
257 so on.
258
259 You don't necessarily need to be root when using libguestfs.  However
260 you obviously do need sufficient permissions to access the filename
261 for whatever operations you want to perform (ie. read access if you
262 just want to read the image or write access if you want to modify the
263 image).
264
265 This is equivalent to the qemu parameter C<-drive file=filename>.");
266
267   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
268    [],
269    "add a CD-ROM disk image to examine",
270    "\
271 This function adds a virtual CD-ROM disk image to the guest.
272
273 This is equivalent to the qemu parameter C<-cdrom filename>.");
274
275   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
276    [],
277    "add qemu parameters",
278    "\
279 This can be used to add arbitrary qemu command line parameters
280 of the form C<-param value>.  Actually it's not quite arbitrary - we
281 prevent you from setting some parameters which would interfere with
282 parameters that we use.
283
284 The first character of C<param> string must be a C<-> (dash).
285
286 C<value> can be NULL.");
287
288   ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
289    [],
290    "set the qemu binary",
291    "\
292 Set the qemu binary that we will use.
293
294 The default is chosen when the library was compiled by the
295 configure script.
296
297 You can also override this by setting the C<LIBGUESTFS_QEMU>
298 environment variable.
299
300 The string C<qemu> is stashed in the libguestfs handle, so the caller
301 must make sure it remains valid for the lifetime of the handle.
302
303 Setting C<qemu> to C<NULL> restores the default qemu binary.");
304
305   ("get_qemu", (RConstString "qemu", []), -1, [],
306    [],
307    "get the qemu binary",
308    "\
309 Return the current qemu binary.
310
311 This is always non-NULL.  If it wasn't set already, then this will
312 return the default qemu binary name.");
313
314   ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
315    [],
316    "set the search path",
317    "\
318 Set the path that libguestfs searches for kernel and initrd.img.
319
320 The default is C<$libdir/guestfs> unless overridden by setting
321 C<LIBGUESTFS_PATH> environment variable.
322
323 The string C<path> is stashed in the libguestfs handle, so the caller
324 must make sure it remains valid for the lifetime of the handle.
325
326 Setting C<path> to C<NULL> restores the default path.");
327
328   ("get_path", (RConstString "path", []), -1, [],
329    [],
330    "get the search path",
331    "\
332 Return the current search path.
333
334 This is always non-NULL.  If it wasn't set already, then this will
335 return the default path.");
336
337   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
338    [],
339    "set autosync mode",
340    "\
341 If C<autosync> is true, this enables autosync.  Libguestfs will make a
342 best effort attempt to run C<guestfs_umount_all> followed by
343 C<guestfs_sync> when the handle is closed
344 (also if the program exits without closing handles).
345
346 This is disabled by default (except in guestfish where it is
347 enabled by default).");
348
349   ("get_autosync", (RBool "autosync", []), -1, [],
350    [],
351    "get autosync mode",
352    "\
353 Get the autosync flag.");
354
355   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
356    [],
357    "set verbose mode",
358    "\
359 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
360
361 Verbose messages are disabled unless the environment variable
362 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
363
364   ("get_verbose", (RBool "verbose", []), -1, [],
365    [],
366    "get verbose mode",
367    "\
368 This returns the verbose messages flag.");
369
370   ("is_ready", (RBool "ready", []), -1, [],
371    [],
372    "is ready to accept commands",
373    "\
374 This returns true iff this handle is ready to accept commands
375 (in the C<READY> state).
376
377 For more information on states, see L<guestfs(3)>.");
378
379   ("is_config", (RBool "config", []), -1, [],
380    [],
381    "is in configuration state",
382    "\
383 This returns true iff this handle is being configured
384 (in the C<CONFIG> state).
385
386 For more information on states, see L<guestfs(3)>.");
387
388   ("is_launching", (RBool "launching", []), -1, [],
389    [],
390    "is launching subprocess",
391    "\
392 This returns true iff this handle is launching the subprocess
393 (in the C<LAUNCHING> state).
394
395 For more information on states, see L<guestfs(3)>.");
396
397   ("is_busy", (RBool "busy", []), -1, [],
398    [],
399    "is busy processing a command",
400    "\
401 This returns true iff this handle is busy processing a command
402 (in the C<BUSY> state).
403
404 For more information on states, see L<guestfs(3)>.");
405
406   ("get_state", (RInt "state", []), -1, [],
407    [],
408    "get the current state",
409    "\
410 This returns the current state as an opaque integer.  This is
411 only useful for printing debug and internal error messages.
412
413 For more information on states, see L<guestfs(3)>.");
414
415   ("set_busy", (RErr, []), -1, [NotInFish],
416    [],
417    "set state to busy",
418    "\
419 This sets the state to C<BUSY>.  This is only used when implementing
420 actions using the low-level API.
421
422 For more information on states, see L<guestfs(3)>.");
423
424   ("set_ready", (RErr, []), -1, [NotInFish],
425    [],
426    "set state to ready",
427    "\
428 This sets the state to C<READY>.  This is only used when implementing
429 actions using the low-level API.
430
431 For more information on states, see L<guestfs(3)>.");
432
433 ]
434
435 let daemon_functions = [
436   ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
437    [InitEmpty, TestOutput (
438       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
439        ["mkfs"; "ext2"; "/dev/sda1"];
440        ["mount"; "/dev/sda1"; "/"];
441        ["write_file"; "/new"; "new file contents"; "0"];
442        ["cat"; "/new"]], "new file contents")],
443    "mount a guest disk at a position in the filesystem",
444    "\
445 Mount a guest disk at a position in the filesystem.  Block devices
446 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
447 the guest.  If those block devices contain partitions, they will have
448 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
449 names can be used.
450
451 The rules are the same as for L<mount(2)>:  A filesystem must
452 first be mounted on C</> before others can be mounted.  Other
453 filesystems can only be mounted on directories which already
454 exist.
455
456 The mounted filesystem is writable, if we have sufficient permissions
457 on the underlying device.
458
459 The filesystem options C<sync> and C<noatime> are set with this
460 call, in order to improve reliability.");
461
462   ("sync", (RErr, []), 2, [],
463    [ InitEmpty, TestRun [["sync"]]],
464    "sync disks, writes are flushed through to the disk image",
465    "\
466 This syncs the disk, so that any writes are flushed through to the
467 underlying disk image.
468
469 You should always call this if you have modified a disk image, before
470 closing the handle.");
471
472   ("touch", (RErr, [String "path"]), 3, [],
473    [InitBasicFS, TestOutputTrue (
474       [["touch"; "/new"];
475        ["exists"; "/new"]])],
476    "update file timestamps or create a new file",
477    "\
478 Touch acts like the L<touch(1)> command.  It can be used to
479 update the timestamps on a file, or, if the file does not exist,
480 to create a new zero-length file.");
481
482   ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
483    [InitBasicFS, TestOutput (
484       [["write_file"; "/new"; "new file contents"; "0"];
485        ["cat"; "/new"]], "new file contents")],
486    "list the contents of a file",
487    "\
488 Return the contents of the file named C<path>.
489
490 Note that this function cannot correctly handle binary files
491 (specifically, files containing C<\\0> character which is treated
492 as end of string).  For those you need to use the C<guestfs_download>
493 function which has a more complex interface.");
494
495   ("ll", (RString "listing", [String "directory"]), 5, [],
496    [], (* XXX Tricky to test because it depends on the exact format
497         * of the 'ls -l' command, which changes between F10 and F11.
498         *)
499    "list the files in a directory (long format)",
500    "\
501 List the files in C<directory> (relative to the root directory,
502 there is no cwd) in the format of 'ls -la'.
503
504 This command is mostly useful for interactive sessions.  It
505 is I<not> intended that you try to parse the output string.");
506
507   ("ls", (RStringList "listing", [String "directory"]), 6, [],
508    [InitBasicFS, TestOutputList (
509       [["touch"; "/new"];
510        ["touch"; "/newer"];
511        ["touch"; "/newest"];
512        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
513    "list the files in a directory",
514    "\
515 List the files in C<directory> (relative to the root directory,
516 there is no cwd).  The '.' and '..' entries are not returned, but
517 hidden files are shown.
518
519 This command is mostly useful for interactive sessions.  Programs
520 should probably use C<guestfs_readdir> instead.");
521
522   ("list_devices", (RStringList "devices", []), 7, [],
523    [InitEmpty, TestOutputList (
524       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
525    "list the block devices",
526    "\
527 List all the block devices.
528
529 The full block device names are returned, eg. C</dev/sda>");
530
531   ("list_partitions", (RStringList "partitions", []), 8, [],
532    [InitBasicFS, TestOutputList (
533       [["list_partitions"]], ["/dev/sda1"]);
534     InitEmpty, TestOutputList (
535       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
536        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
537    "list the partitions",
538    "\
539 List all the partitions detected on all block devices.
540
541 The full partition device names are returned, eg. C</dev/sda1>
542
543 This does not return logical volumes.  For that you will need to
544 call C<guestfs_lvs>.");
545
546   ("pvs", (RStringList "physvols", []), 9, [],
547    [InitBasicFSonLVM, TestOutputList (
548       [["pvs"]], ["/dev/sda1"]);
549     InitEmpty, TestOutputList (
550       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
551        ["pvcreate"; "/dev/sda1"];
552        ["pvcreate"; "/dev/sda2"];
553        ["pvcreate"; "/dev/sda3"];
554        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
555    "list the LVM physical volumes (PVs)",
556    "\
557 List all the physical volumes detected.  This is the equivalent
558 of the L<pvs(8)> command.
559
560 This returns a list of just the device names that contain
561 PVs (eg. C</dev/sda2>).
562
563 See also C<guestfs_pvs_full>.");
564
565   ("vgs", (RStringList "volgroups", []), 10, [],
566    [InitBasicFSonLVM, TestOutputList (
567       [["vgs"]], ["VG"]);
568     InitEmpty, TestOutputList (
569       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
570        ["pvcreate"; "/dev/sda1"];
571        ["pvcreate"; "/dev/sda2"];
572        ["pvcreate"; "/dev/sda3"];
573        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
574        ["vgcreate"; "VG2"; "/dev/sda3"];
575        ["vgs"]], ["VG1"; "VG2"])],
576    "list the LVM volume groups (VGs)",
577    "\
578 List all the volumes groups detected.  This is the equivalent
579 of the L<vgs(8)> command.
580
581 This returns a list of just the volume group names that were
582 detected (eg. C<VolGroup00>).
583
584 See also C<guestfs_vgs_full>.");
585
586   ("lvs", (RStringList "logvols", []), 11, [],
587    [InitBasicFSonLVM, TestOutputList (
588       [["lvs"]], ["/dev/VG/LV"]);
589     InitEmpty, TestOutputList (
590       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
591        ["pvcreate"; "/dev/sda1"];
592        ["pvcreate"; "/dev/sda2"];
593        ["pvcreate"; "/dev/sda3"];
594        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
595        ["vgcreate"; "VG2"; "/dev/sda3"];
596        ["lvcreate"; "LV1"; "VG1"; "50"];
597        ["lvcreate"; "LV2"; "VG1"; "50"];
598        ["lvcreate"; "LV3"; "VG2"; "50"];
599        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
600    "list the LVM logical volumes (LVs)",
601    "\
602 List all the logical volumes detected.  This is the equivalent
603 of the L<lvs(8)> command.
604
605 This returns a list of the logical volume device names
606 (eg. C</dev/VolGroup00/LogVol00>).
607
608 See also C<guestfs_lvs_full>.");
609
610   ("pvs_full", (RPVList "physvols", []), 12, [],
611    [], (* XXX how to test? *)
612    "list the LVM physical volumes (PVs)",
613    "\
614 List all the physical volumes detected.  This is the equivalent
615 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
616
617   ("vgs_full", (RVGList "volgroups", []), 13, [],
618    [], (* XXX how to test? *)
619    "list the LVM volume groups (VGs)",
620    "\
621 List all the volumes groups detected.  This is the equivalent
622 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
623
624   ("lvs_full", (RLVList "logvols", []), 14, [],
625    [], (* XXX how to test? *)
626    "list the LVM logical volumes (LVs)",
627    "\
628 List all the logical volumes detected.  This is the equivalent
629 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
630
631   ("read_lines", (RStringList "lines", [String "path"]), 15, [],
632    [InitBasicFS, TestOutputList (
633       [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
634        ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
635     InitBasicFS, TestOutputList (
636       [["write_file"; "/new"; ""; "0"];
637        ["read_lines"; "/new"]], [])],
638    "read file as lines",
639    "\
640 Return the contents of the file named C<path>.
641
642 The file contents are returned as a list of lines.  Trailing
643 C<LF> and C<CRLF> character sequences are I<not> returned.
644
645 Note that this function cannot correctly handle binary files
646 (specifically, files containing C<\\0> character which is treated
647 as end of line).  For those you need to use the C<guestfs_read_file>
648 function which has a more complex interface.");
649
650   ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
651    [], (* XXX Augeas code needs tests. *)
652    "create a new Augeas handle",
653    "\
654 Create a new Augeas handle for editing configuration files.
655 If there was any previous Augeas handle associated with this
656 guestfs session, then it is closed.
657
658 You must call this before using any other C<guestfs_aug_*>
659 commands.
660
661 C<root> is the filesystem root.  C<root> must not be NULL,
662 use C</> instead.
663
664 The flags are the same as the flags defined in
665 E<lt>augeas.hE<gt>, the logical I<or> of the following
666 integers:
667
668 =over 4
669
670 =item C<AUG_SAVE_BACKUP> = 1
671
672 Keep the original file with a C<.augsave> extension.
673
674 =item C<AUG_SAVE_NEWFILE> = 2
675
676 Save changes into a file with extension C<.augnew>, and
677 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
678
679 =item C<AUG_TYPE_CHECK> = 4
680
681 Typecheck lenses (can be expensive).
682
683 =item C<AUG_NO_STDINC> = 8
684
685 Do not use standard load path for modules.
686
687 =item C<AUG_SAVE_NOOP> = 16
688
689 Make save a no-op, just record what would have been changed.
690
691 =item C<AUG_NO_LOAD> = 32
692
693 Do not load the tree in C<guestfs_aug_init>.
694
695 =back
696
697 To close the handle, you can call C<guestfs_aug_close>.
698
699 To find out more about Augeas, see L<http://augeas.net/>.");
700
701   ("aug_close", (RErr, []), 26, [],
702    [], (* XXX Augeas code needs tests. *)
703    "close the current Augeas handle",
704    "\
705 Close the current Augeas handle and free up any resources
706 used by it.  After calling this, you have to call
707 C<guestfs_aug_init> again before you can use any other
708 Augeas functions.");
709
710   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
711    [], (* XXX Augeas code needs tests. *)
712    "define an Augeas variable",
713    "\
714 Defines an Augeas variable C<name> whose value is the result
715 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
716 undefined.
717
718 On success this returns the number of nodes in C<expr>, or
719 C<0> if C<expr> evaluates to something which is not a nodeset.");
720
721   ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
722    [], (* XXX Augeas code needs tests. *)
723    "define an Augeas node",
724    "\
725 Defines a variable C<name> whose value is the result of
726 evaluating C<expr>.
727
728 If C<expr> evaluates to an empty nodeset, a node is created,
729 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
730 C<name> will be the nodeset containing that single node.
731
732 On success this returns a pair containing the
733 number of nodes in the nodeset, and a boolean flag
734 if a node was created.");
735
736   ("aug_get", (RString "val", [String "path"]), 19, [],
737    [], (* XXX Augeas code needs tests. *)
738    "look up the value of an Augeas path",
739    "\
740 Look up the value associated with C<path>.  If C<path>
741 matches exactly one node, the C<value> is returned.");
742
743   ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
744    [], (* XXX Augeas code needs tests. *)
745    "set Augeas path to value",
746    "\
747 Set the value associated with C<path> to C<value>.");
748
749   ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
750    [], (* XXX Augeas code needs tests. *)
751    "insert a sibling Augeas node",
752    "\
753 Create a new sibling C<label> for C<path>, inserting it into
754 the tree before or after C<path> (depending on the boolean
755 flag C<before>).
756
757 C<path> must match exactly one existing node in the tree, and
758 C<label> must be a label, ie. not contain C</>, C<*> or end
759 with a bracketed index C<[N]>.");
760
761   ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
762    [], (* XXX Augeas code needs tests. *)
763    "remove an Augeas path",
764    "\
765 Remove C<path> and all of its children.
766
767 On success this returns the number of entries which were removed.");
768
769   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
770    [], (* XXX Augeas code needs tests. *)
771    "move Augeas node",
772    "\
773 Move the node C<src> to C<dest>.  C<src> must match exactly
774 one node.  C<dest> is overwritten if it exists.");
775
776   ("aug_match", (RStringList "matches", [String "path"]), 24, [],
777    [], (* XXX Augeas code needs tests. *)
778    "return Augeas nodes which match path",
779    "\
780 Returns a list of paths which match the path expression C<path>.
781 The returned paths are sufficiently qualified so that they match
782 exactly one node in the current tree.");
783
784   ("aug_save", (RErr, []), 25, [],
785    [], (* XXX Augeas code needs tests. *)
786    "write all pending Augeas changes to disk",
787    "\
788 This writes all pending changes to disk.
789
790 The flags which were passed to C<guestfs_aug_init> affect exactly
791 how files are saved.");
792
793   ("aug_load", (RErr, []), 27, [],
794    [], (* XXX Augeas code needs tests. *)
795    "load files into the tree",
796    "\
797 Load files into the tree.
798
799 See C<aug_load> in the Augeas documentation for the full gory
800 details.");
801
802   ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
803    [], (* XXX Augeas code needs tests. *)
804    "list Augeas nodes under a path",
805    "\
806 This is just a shortcut for listing C<guestfs_aug_match>
807 C<path/*> and sorting the resulting nodes into alphabetical order.");
808
809   ("rm", (RErr, [String "path"]), 29, [],
810    [InitBasicFS, TestRun
811       [["touch"; "/new"];
812        ["rm"; "/new"]];
813     InitBasicFS, TestLastFail
814       [["rm"; "/new"]];
815     InitBasicFS, TestLastFail
816       [["mkdir"; "/new"];
817        ["rm"; "/new"]]],
818    "remove a file",
819    "\
820 Remove the single file C<path>.");
821
822   ("rmdir", (RErr, [String "path"]), 30, [],
823    [InitBasicFS, TestRun
824       [["mkdir"; "/new"];
825        ["rmdir"; "/new"]];
826     InitBasicFS, TestLastFail
827       [["rmdir"; "/new"]];
828     InitBasicFS, TestLastFail
829       [["touch"; "/new"];
830        ["rmdir"; "/new"]]],
831    "remove a directory",
832    "\
833 Remove the single directory C<path>.");
834
835   ("rm_rf", (RErr, [String "path"]), 31, [],
836    [InitBasicFS, TestOutputFalse
837       [["mkdir"; "/new"];
838        ["mkdir"; "/new/foo"];
839        ["touch"; "/new/foo/bar"];
840        ["rm_rf"; "/new"];
841        ["exists"; "/new"]]],
842    "remove a file or directory recursively",
843    "\
844 Remove the file or directory C<path>, recursively removing the
845 contents if its a directory.  This is like the C<rm -rf> shell
846 command.");
847
848   ("mkdir", (RErr, [String "path"]), 32, [],
849    [InitBasicFS, TestOutputTrue
850       [["mkdir"; "/new"];
851        ["is_dir"; "/new"]];
852     InitBasicFS, TestLastFail
853       [["mkdir"; "/new/foo/bar"]]],
854    "create a directory",
855    "\
856 Create a directory named C<path>.");
857
858   ("mkdir_p", (RErr, [String "path"]), 33, [],
859    [InitBasicFS, TestOutputTrue
860       [["mkdir_p"; "/new/foo/bar"];
861        ["is_dir"; "/new/foo/bar"]];
862     InitBasicFS, TestOutputTrue
863       [["mkdir_p"; "/new/foo/bar"];
864        ["is_dir"; "/new/foo"]];
865     InitBasicFS, TestOutputTrue
866       [["mkdir_p"; "/new/foo/bar"];
867        ["is_dir"; "/new"]]],
868    "create a directory and parents",
869    "\
870 Create a directory named C<path>, creating any parent directories
871 as necessary.  This is like the C<mkdir -p> shell command.");
872
873   ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
874    [], (* XXX Need stat command to test *)
875    "change file mode",
876    "\
877 Change the mode (permissions) of C<path> to C<mode>.  Only
878 numeric modes are supported.");
879
880   ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
881    [], (* XXX Need stat command to test *)
882    "change file owner and group",
883    "\
884 Change the file owner to C<owner> and group to C<group>.
885
886 Only numeric uid and gid are supported.  If you want to use
887 names, you will need to locate and parse the password file
888 yourself (Augeas support makes this relatively easy).");
889
890   ("exists", (RBool "existsflag", [String "path"]), 36, [],
891    [InitBasicFS, TestOutputTrue (
892       [["touch"; "/new"];
893        ["exists"; "/new"]]);
894     InitBasicFS, TestOutputTrue (
895       [["mkdir"; "/new"];
896        ["exists"; "/new"]])],
897    "test if file or directory exists",
898    "\
899 This returns C<true> if and only if there is a file, directory
900 (or anything) with the given C<path> name.
901
902 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
903
904   ("is_file", (RBool "fileflag", [String "path"]), 37, [],
905    [InitBasicFS, TestOutputTrue (
906       [["touch"; "/new"];
907        ["is_file"; "/new"]]);
908     InitBasicFS, TestOutputFalse (
909       [["mkdir"; "/new"];
910        ["is_file"; "/new"]])],
911    "test if file exists",
912    "\
913 This returns C<true> if and only if there is a file
914 with the given C<path> name.  Note that it returns false for
915 other objects like directories.
916
917 See also C<guestfs_stat>.");
918
919   ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
920    [InitBasicFS, TestOutputFalse (
921       [["touch"; "/new"];
922        ["is_dir"; "/new"]]);
923     InitBasicFS, TestOutputTrue (
924       [["mkdir"; "/new"];
925        ["is_dir"; "/new"]])],
926    "test if file exists",
927    "\
928 This returns C<true> if and only if there is a directory
929 with the given C<path> name.  Note that it returns false for
930 other objects like files.
931
932 See also C<guestfs_stat>.");
933
934   ("pvcreate", (RErr, [String "device"]), 39, [],
935    [InitEmpty, TestOutputList (
936       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
937        ["pvcreate"; "/dev/sda1"];
938        ["pvcreate"; "/dev/sda2"];
939        ["pvcreate"; "/dev/sda3"];
940        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
941    "create an LVM physical volume",
942    "\
943 This creates an LVM physical volume on the named C<device>,
944 where C<device> should usually be a partition name such
945 as C</dev/sda1>.");
946
947   ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
948    [InitEmpty, TestOutputList (
949       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
950        ["pvcreate"; "/dev/sda1"];
951        ["pvcreate"; "/dev/sda2"];
952        ["pvcreate"; "/dev/sda3"];
953        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
954        ["vgcreate"; "VG2"; "/dev/sda3"];
955        ["vgs"]], ["VG1"; "VG2"])],
956    "create an LVM volume group",
957    "\
958 This creates an LVM volume group called C<volgroup>
959 from the non-empty list of physical volumes C<physvols>.");
960
961   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
962    [InitEmpty, TestOutputList (
963       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
964        ["pvcreate"; "/dev/sda1"];
965        ["pvcreate"; "/dev/sda2"];
966        ["pvcreate"; "/dev/sda3"];
967        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
968        ["vgcreate"; "VG2"; "/dev/sda3"];
969        ["lvcreate"; "LV1"; "VG1"; "50"];
970        ["lvcreate"; "LV2"; "VG1"; "50"];
971        ["lvcreate"; "LV3"; "VG2"; "50"];
972        ["lvcreate"; "LV4"; "VG2"; "50"];
973        ["lvcreate"; "LV5"; "VG2"; "50"];
974        ["lvs"]],
975       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
976        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
977    "create an LVM volume group",
978    "\
979 This creates an LVM volume group called C<logvol>
980 on the volume group C<volgroup>, with C<size> megabytes.");
981
982   ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
983    [InitEmpty, TestOutput (
984       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
985        ["mkfs"; "ext2"; "/dev/sda1"];
986        ["mount"; "/dev/sda1"; "/"];
987        ["write_file"; "/new"; "new file contents"; "0"];
988        ["cat"; "/new"]], "new file contents")],
989    "make a filesystem",
990    "\
991 This creates a filesystem on C<device> (usually a partition
992 of LVM logical volume).  The filesystem type is C<fstype>, for
993 example C<ext3>.");
994
995   ("sfdisk", (RErr, [String "device";
996                      Int "cyls"; Int "heads"; Int "sectors";
997                      StringList "lines"]), 43, [DangerWillRobinson],
998    [],
999    "create partitions on a block device",
1000    "\
1001 This is a direct interface to the L<sfdisk(8)> program for creating
1002 partitions on block devices.
1003
1004 C<device> should be a block device, for example C</dev/sda>.
1005
1006 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1007 and sectors on the device, which are passed directly to sfdisk as
1008 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1009 of these, then the corresponding parameter is omitted.  Usually for
1010 'large' disks, you can just pass C<0> for these, but for small
1011 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1012 out the right geometry and you will need to tell it.
1013
1014 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1015 information refer to the L<sfdisk(8)> manpage.
1016
1017 To create a single partition occupying the whole disk, you would
1018 pass C<lines> as a single element list, when the single element being
1019 the string C<,> (comma).");
1020
1021   ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1022    [InitBasicFS, TestOutput (
1023       [["write_file"; "/new"; "new file contents"; "0"];
1024        ["cat"; "/new"]], "new file contents");
1025     InitBasicFS, TestOutput (
1026       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1027        ["cat"; "/new"]], "\nnew file contents\n");
1028     InitBasicFS, TestOutput (
1029       [["write_file"; "/new"; "\n\n"; "0"];
1030        ["cat"; "/new"]], "\n\n");
1031     InitBasicFS, TestOutput (
1032       [["write_file"; "/new"; ""; "0"];
1033        ["cat"; "/new"]], "");
1034     InitBasicFS, TestOutput (
1035       [["write_file"; "/new"; "\n\n\n"; "0"];
1036        ["cat"; "/new"]], "\n\n\n");
1037     InitBasicFS, TestOutput (
1038       [["write_file"; "/new"; "\n"; "0"];
1039        ["cat"; "/new"]], "\n")],
1040    "create a file",
1041    "\
1042 This call creates a file called C<path>.  The contents of the
1043 file is the string C<content> (which can contain any 8 bit data),
1044 with length C<size>.
1045
1046 As a special case, if C<size> is C<0>
1047 then the length is calculated using C<strlen> (so in this case
1048 the content cannot contain embedded ASCII NULs).");
1049
1050   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1051    [InitEmpty, TestOutputList (
1052       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1053        ["mkfs"; "ext2"; "/dev/sda1"];
1054        ["mount"; "/dev/sda1"; "/"];
1055        ["mounts"]], ["/dev/sda1"]);
1056     InitEmpty, TestOutputList (
1057       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1058        ["mkfs"; "ext2"; "/dev/sda1"];
1059        ["mount"; "/dev/sda1"; "/"];
1060        ["umount"; "/"];
1061        ["mounts"]], [])],
1062    "unmount a filesystem",
1063    "\
1064 This unmounts the given filesystem.  The filesystem may be
1065 specified either by its mountpoint (path) or the device which
1066 contains the filesystem.");
1067
1068   ("mounts", (RStringList "devices", []), 46, [],
1069    [InitBasicFS, TestOutputList (
1070       [["mounts"]], ["/dev/sda1"])],
1071    "show mounted filesystems",
1072    "\
1073 This returns the list of currently mounted filesystems.  It returns
1074 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1075
1076 Some internal mounts are not shown.");
1077
1078   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1079    [InitBasicFS, TestOutputList (
1080       [["umount_all"];
1081        ["mounts"]], []);
1082     (* check that umount_all can unmount nested mounts correctly: *)
1083     InitEmpty, TestOutputList (
1084       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1085        ["mkfs"; "ext2"; "/dev/sda1"];
1086        ["mkfs"; "ext2"; "/dev/sda2"];
1087        ["mkfs"; "ext2"; "/dev/sda3"];
1088        ["mount"; "/dev/sda1"; "/"];
1089        ["mkdir"; "/mp1"];
1090        ["mount"; "/dev/sda2"; "/mp1"];
1091        ["mkdir"; "/mp1/mp2"];
1092        ["mount"; "/dev/sda3"; "/mp1/mp2"];
1093        ["mkdir"; "/mp1/mp2/mp3"];
1094        ["umount_all"];
1095        ["mounts"]], [])],
1096    "unmount all filesystems",
1097    "\
1098 This unmounts all mounted filesystems.
1099
1100 Some internal mounts are not unmounted by this call.");
1101
1102   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1103    [],
1104    "remove all LVM LVs, VGs and PVs",
1105    "\
1106 This command removes all LVM logical volumes, volume groups
1107 and physical volumes.");
1108
1109   ("file", (RString "description", [String "path"]), 49, [],
1110    [InitBasicFS, TestOutput (
1111       [["touch"; "/new"];
1112        ["file"; "/new"]], "empty");
1113     InitBasicFS, TestOutput (
1114       [["write_file"; "/new"; "some content\n"; "0"];
1115        ["file"; "/new"]], "ASCII text");
1116     InitBasicFS, TestLastFail (
1117       [["file"; "/nofile"]])],
1118    "determine file type",
1119    "\
1120 This call uses the standard L<file(1)> command to determine
1121 the type or contents of the file.  This also works on devices,
1122 for example to find out whether a partition contains a filesystem.
1123
1124 The exact command which runs is C<file -bsL path>.  Note in
1125 particular that the filename is not prepended to the output
1126 (the C<-b> option).");
1127
1128   ("command", (RString "output", [StringList "arguments"]), 50, [],
1129    [], (* XXX how to test? *)
1130    "run a command from the guest filesystem",
1131    "\
1132 This call runs a command from the guest filesystem.  The
1133 filesystem must be mounted, and must contain a compatible
1134 operating system (ie. something Linux, with the same
1135 or compatible processor architecture).
1136
1137 The single parameter is an argv-style list of arguments.
1138 The first element is the name of the program to run.
1139 Subsequent elements are parameters.  The list must be
1140 non-empty (ie. must contain a program name).
1141
1142 The C<$PATH> environment variable will contain at least
1143 C</usr/bin> and C</bin>.  If you require a program from
1144 another location, you should provide the full path in the
1145 first parameter.
1146
1147 Shared libraries and data files required by the program
1148 must be available on filesystems which are mounted in the
1149 correct places.  It is the caller's responsibility to ensure
1150 all filesystems that are needed are mounted at the right
1151 locations.");
1152
1153   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1154    [], (* XXX how to test? *)
1155    "run a command, returning lines",
1156    "\
1157 This is the same as C<guestfs_command>, but splits the
1158 result into a list of lines.");
1159
1160   ("stat", (RStat "statbuf", [String "path"]), 52, [],
1161    [InitBasicFS, TestOutputStruct (
1162       [["touch"; "/new"];
1163        ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1164    "get file information",
1165    "\
1166 Returns file information for the given C<path>.
1167
1168 This is the same as the C<stat(2)> system call.");
1169
1170   ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1171    [InitBasicFS, TestOutputStruct (
1172       [["touch"; "/new"];
1173        ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1174    "get file information for a symbolic link",
1175    "\
1176 Returns file information for the given C<path>.
1177
1178 This is the same as C<guestfs_stat> except that if C<path>
1179 is a symbolic link, then the link is stat-ed, not the file it
1180 refers to.
1181
1182 This is the same as the C<lstat(2)> system call.");
1183
1184   ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1185    [InitBasicFS, TestOutputStruct (
1186       [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1187                            CompareWithInt ("blocks", 490020);
1188                            CompareWithInt ("bsize", 1024)])],
1189    "get file system statistics",
1190    "\
1191 Returns file system statistics for any mounted file system.
1192 C<path> should be a file or directory in the mounted file system
1193 (typically it is the mount point itself, but it doesn't need to be).
1194
1195 This is the same as the C<statvfs(2)> system call.");
1196
1197   ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1198    [], (* XXX test *)
1199    "get ext2/ext3/ext4 superblock details",
1200    "\
1201 This returns the contents of the ext2, ext3 or ext4 filesystem
1202 superblock on C<device>.
1203
1204 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1205 manpage for more details.  The list of fields returned isn't
1206 clearly defined, and depends on both the version of C<tune2fs>
1207 that libguestfs was built against, and the filesystem itself.");
1208
1209   ("blockdev_setro", (RErr, [String "device"]), 56, [],
1210    [InitEmpty, TestOutputTrue (
1211       [["blockdev_setro"; "/dev/sda"];
1212        ["blockdev_getro"; "/dev/sda"]])],
1213    "set block device to read-only",
1214    "\
1215 Sets the block device named C<device> to read-only.
1216
1217 This uses the L<blockdev(8)> command.");
1218
1219   ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1220    [InitEmpty, TestOutputFalse (
1221       [["blockdev_setrw"; "/dev/sda"];
1222        ["blockdev_getro"; "/dev/sda"]])],
1223    "set block device to read-write",
1224    "\
1225 Sets the block device named C<device> to read-write.
1226
1227 This uses the L<blockdev(8)> command.");
1228
1229   ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1230    [InitEmpty, TestOutputTrue (
1231       [["blockdev_setro"; "/dev/sda"];
1232        ["blockdev_getro"; "/dev/sda"]])],
1233    "is block device set to read-only",
1234    "\
1235 Returns a boolean indicating if the block device is read-only
1236 (true if read-only, false if not).
1237
1238 This uses the L<blockdev(8)> command.");
1239
1240   ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1241    [InitEmpty, TestOutputInt (
1242       [["blockdev_getss"; "/dev/sda"]], 512)],
1243    "get sectorsize of block device",
1244    "\
1245 This returns the size of sectors on a block device.
1246 Usually 512, but can be larger for modern devices.
1247
1248 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1249 for that).
1250
1251 This uses the L<blockdev(8)> command.");
1252
1253   ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1254    [InitEmpty, TestOutputInt (
1255       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1256    "get blocksize of block device",
1257    "\
1258 This returns the block size of a device.
1259
1260 (Note this is different from both I<size in blocks> and
1261 I<filesystem block size>).
1262
1263 This uses the L<blockdev(8)> command.");
1264
1265   ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1266    [], (* XXX test *)
1267    "set blocksize of block device",
1268    "\
1269 This sets the block size of a device.
1270
1271 (Note this is different from both I<size in blocks> and
1272 I<filesystem block size>).
1273
1274 This uses the L<blockdev(8)> command.");
1275
1276   ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1277    [InitEmpty, TestOutputInt (
1278       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1279    "get total size of device in 512-byte sectors",
1280    "\
1281 This returns the size of the device in units of 512-byte sectors
1282 (even if the sectorsize isn't 512 bytes ... weird).
1283
1284 See also C<guestfs_blockdev_getss> for the real sector size of
1285 the device, and C<guestfs_blockdev_getsize64> for the more
1286 useful I<size in bytes>.
1287
1288 This uses the L<blockdev(8)> command.");
1289
1290   ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1291    [InitEmpty, TestOutputInt (
1292       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1293    "get total size of device in bytes",
1294    "\
1295 This returns the size of the device in bytes.
1296
1297 See also C<guestfs_blockdev_getsz>.
1298
1299 This uses the L<blockdev(8)> command.");
1300
1301   ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1302    [InitEmpty, TestRun
1303       [["blockdev_flushbufs"; "/dev/sda"]]],
1304    "flush device buffers",
1305    "\
1306 This tells the kernel to flush internal buffers associated
1307 with C<device>.
1308
1309 This uses the L<blockdev(8)> command.");
1310
1311   ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1312    [InitEmpty, TestRun
1313       [["blockdev_rereadpt"; "/dev/sda"]]],
1314    "reread partition table",
1315    "\
1316 Reread the partition table on C<device>.
1317
1318 This uses the L<blockdev(8)> command.");
1319
1320   ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1321    [InitBasicFS, TestOutput (
1322       (* Pick a file from cwd which isn't likely to change. *)
1323     [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1324      ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1325    "upload a file from the local machine",
1326    "\
1327 Upload local file C<filename> to C<remotefilename> on the
1328 filesystem.
1329
1330 C<filename> can also be a named pipe.
1331
1332 See also C<guestfs_download>.");
1333
1334   ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1335    [InitBasicFS, TestOutput (
1336       (* Pick a file from cwd which isn't likely to change. *)
1337     [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1338      ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1339      ["upload"; "testdownload.tmp"; "/upload"];
1340      ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1341    "download a file to the local machine",
1342    "\
1343 Download file C<remotefilename> and save it as C<filename>
1344 on the local machine.
1345
1346 C<filename> can also be a named pipe.
1347
1348 See also C<guestfs_upload>, C<guestfs_cat>.");
1349
1350   ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1351    [InitBasicFS, TestOutput (
1352       [["write_file"; "/new"; "test\n"; "0"];
1353        ["checksum"; "crc"; "/new"]], "935282863");
1354     InitBasicFS, TestLastFail (
1355       [["checksum"; "crc"; "/new"]]);
1356     InitBasicFS, TestOutput (
1357       [["write_file"; "/new"; "test\n"; "0"];
1358        ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1359     InitBasicFS, TestOutput (
1360       [["write_file"; "/new"; "test\n"; "0"];
1361        ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1362     InitBasicFS, TestOutput (
1363       [["write_file"; "/new"; "test\n"; "0"];
1364        ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1365     InitBasicFS, TestOutput (
1366       [["write_file"; "/new"; "test\n"; "0"];
1367        ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1368     InitBasicFS, TestOutput (
1369       [["write_file"; "/new"; "test\n"; "0"];
1370        ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1371     InitBasicFS, TestOutput (
1372       [["write_file"; "/new"; "test\n"; "0"];
1373        ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1374    "compute MD5, SHAx or CRC checksum of file",
1375    "\
1376 This call computes the MD5, SHAx or CRC checksum of the
1377 file named C<path>.
1378
1379 The type of checksum to compute is given by the C<csumtype>
1380 parameter which must have one of the following values:
1381
1382 =over 4
1383
1384 =item C<crc>
1385
1386 Compute the cyclic redundancy check (CRC) specified by POSIX
1387 for the C<cksum> command.
1388
1389 =item C<md5>
1390
1391 Compute the MD5 hash (using the C<md5sum> program).
1392
1393 =item C<sha1>
1394
1395 Compute the SHA1 hash (using the C<sha1sum> program).
1396
1397 =item C<sha224>
1398
1399 Compute the SHA224 hash (using the C<sha224sum> program).
1400
1401 =item C<sha256>
1402
1403 Compute the SHA256 hash (using the C<sha256sum> program).
1404
1405 =item C<sha384>
1406
1407 Compute the SHA384 hash (using the C<sha384sum> program).
1408
1409 =item C<sha512>
1410
1411 Compute the SHA512 hash (using the C<sha512sum> program).
1412
1413 =back
1414
1415 The checksum is returned as a printable string.");
1416
1417   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
1418    [InitBasicFS, TestOutput (
1419       [["tar_in"; "images/helloworld.tar"; "/"];
1420        ["cat"; "/hello"]], "hello\n")],
1421    "unpack tarfile to directory",
1422    "\
1423 This command uploads and unpacks local file C<tarfile> (an
1424 I<uncompressed> tar file) into C<directory>.
1425
1426 To upload a compressed tarball, use C<guestfs_tgz_in>.");
1427
1428   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
1429    [],
1430    "pack directory into tarfile",
1431    "\
1432 This command packs the contents of C<directory> and downloads
1433 it to local file C<tarfile>.
1434
1435 To download a compressed tarball, use C<guestfs_tgz_out>.");
1436
1437   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
1438    [InitBasicFS, TestOutput (
1439       [["tgz_in"; "images/helloworld.tar.gz"; "/"];
1440        ["cat"; "/hello"]], "hello\n")],
1441    "unpack compressed tarball to directory",
1442    "\
1443 This command uploads and unpacks local file C<tarball> (a
1444 I<gzip compressed> tar file) into C<directory>.
1445
1446 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
1447
1448   ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
1449    [],
1450    "pack directory into compressed tarball",
1451    "\
1452 This command packs the contents of C<directory> and downloads
1453 it to local file C<tarball>.
1454
1455 To download an uncompressed tarball, use C<guestfs_tar_out>.");
1456
1457   ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
1458    [InitBasicFS, TestLastFail (
1459       [["umount"; "/"];
1460        ["mount_ro"; "/dev/sda1"; "/"];
1461        ["touch"; "/new"]]);
1462     InitBasicFS, TestOutput (
1463       [["write_file"; "/new"; "data"; "0"];
1464        ["umount"; "/"];
1465        ["mount_ro"; "/dev/sda1"; "/"];
1466        ["cat"; "/new"]], "data")],
1467    "mount a guest disk, read-only",
1468    "\
1469 This is the same as the C<guestfs_mount> command, but it
1470 mounts the filesystem with the read-only (I<-o ro>) flag.");
1471
1472   ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
1473    [],
1474    "mount a guest disk with mount options",
1475    "\
1476 This is the same as the C<guestfs_mount> command, but it
1477 allows you to set the mount options as for the
1478 L<mount(8)> I<-o> flag.");
1479
1480   ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
1481    [],
1482    "mount a guest disk with mount options and vfstype",
1483    "\
1484 This is the same as the C<guestfs_mount> command, but it
1485 allows you to set both the mount options and the vfstype
1486 as for the L<mount(8)> I<-o> and I<-t> flags.");
1487
1488   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
1489    [],
1490    "debugging and internals",
1491    "\
1492 The C<guestfs_debug> command exposes some internals of
1493 C<guestfsd> (the guestfs daemon) that runs inside the
1494 qemu subprocess.
1495
1496 There is no comprehensive help for this command.  You have
1497 to look at the file C<daemon/debug.c> in the libguestfs source
1498 to find out what you can do.");
1499
1500   ("lvremove", (RErr, [String "device"]), 77, [],
1501    [InitEmpty, TestOutputList (
1502       [["pvcreate"; "/dev/sda"];
1503        ["vgcreate"; "VG"; "/dev/sda"];
1504        ["lvcreate"; "LV1"; "VG"; "50"];
1505        ["lvcreate"; "LV2"; "VG"; "50"];
1506        ["lvremove"; "/dev/VG/LV1"];
1507        ["lvs"]], ["/dev/VG/LV2"]);
1508     InitEmpty, TestOutputList (
1509       [["pvcreate"; "/dev/sda"];
1510        ["vgcreate"; "VG"; "/dev/sda"];
1511        ["lvcreate"; "LV1"; "VG"; "50"];
1512        ["lvcreate"; "LV2"; "VG"; "50"];
1513        ["lvremove"; "/dev/VG"];
1514        ["lvs"]], []);
1515     InitEmpty, TestOutputList (
1516       [["pvcreate"; "/dev/sda"];
1517        ["vgcreate"; "VG"; "/dev/sda"];
1518        ["lvcreate"; "LV1"; "VG"; "50"];
1519        ["lvcreate"; "LV2"; "VG"; "50"];
1520        ["lvremove"; "/dev/VG"];
1521        ["vgs"]], ["VG"])],
1522    "remove an LVM logical volume",
1523    "\
1524 Remove an LVM logical volume C<device>, where C<device> is
1525 the path to the LV, such as C</dev/VG/LV>.
1526
1527 You can also remove all LVs in a volume group by specifying
1528 the VG name, C</dev/VG>.");
1529
1530   ("vgremove", (RErr, [String "vgname"]), 78, [],
1531    [InitEmpty, TestOutputList (
1532       [["pvcreate"; "/dev/sda"];
1533        ["vgcreate"; "VG"; "/dev/sda"];
1534        ["lvcreate"; "LV1"; "VG"; "50"];
1535        ["lvcreate"; "LV2"; "VG"; "50"];
1536        ["vgremove"; "VG"];
1537        ["lvs"]], []);
1538     InitEmpty, TestOutputList (
1539       [["pvcreate"; "/dev/sda"];
1540        ["vgcreate"; "VG"; "/dev/sda"];
1541        ["lvcreate"; "LV1"; "VG"; "50"];
1542        ["lvcreate"; "LV2"; "VG"; "50"];
1543        ["vgremove"; "VG"];
1544        ["vgs"]], [])],
1545    "remove an LVM volume group",
1546    "\
1547 Remove an LVM volume group C<vgname>, (for example C<VG>).
1548
1549 This also forcibly removes all logical volumes in the volume
1550 group (if any).");
1551
1552   ("pvremove", (RErr, [String "device"]), 79, [],
1553    [InitEmpty, TestOutputList (
1554       [["pvcreate"; "/dev/sda"];
1555        ["vgcreate"; "VG"; "/dev/sda"];
1556        ["lvcreate"; "LV1"; "VG"; "50"];
1557        ["lvcreate"; "LV2"; "VG"; "50"];
1558        ["vgremove"; "VG"];
1559        ["pvremove"; "/dev/sda"];
1560        ["lvs"]], []);
1561     InitEmpty, TestOutputList (
1562       [["pvcreate"; "/dev/sda"];
1563        ["vgcreate"; "VG"; "/dev/sda"];
1564        ["lvcreate"; "LV1"; "VG"; "50"];
1565        ["lvcreate"; "LV2"; "VG"; "50"];
1566        ["vgremove"; "VG"];
1567        ["pvremove"; "/dev/sda"];
1568        ["vgs"]], []);
1569     InitEmpty, TestOutputList (
1570       [["pvcreate"; "/dev/sda"];
1571        ["vgcreate"; "VG"; "/dev/sda"];
1572        ["lvcreate"; "LV1"; "VG"; "50"];
1573        ["lvcreate"; "LV2"; "VG"; "50"];
1574        ["vgremove"; "VG"];
1575        ["pvremove"; "/dev/sda"];
1576        ["pvs"]], [])],
1577    "remove an LVM physical volume",
1578    "\
1579 This wipes a physical volume C<device> so that LVM will no longer
1580 recognise it.
1581
1582 The implementation uses the C<pvremove> command which refuses to
1583 wipe physical volumes that contain any volume groups, so you have
1584 to remove those first.");
1585
1586   ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
1587    [InitBasicFS, TestOutput (
1588       [["set_e2label"; "/dev/sda1"; "testlabel"];
1589        ["get_e2label"; "/dev/sda1"]], "testlabel")],
1590    "set the ext2/3/4 filesystem label",
1591    "\
1592 This sets the ext2/3/4 filesystem label of the filesystem on
1593 C<device> to C<label>.  Filesystem labels are limited to
1594 16 characters.
1595
1596 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
1597 to return the existing label on a filesystem.");
1598
1599   ("get_e2label", (RString "label", [String "device"]), 81, [],
1600    [],
1601    "get the ext2/3/4 filesystem label",
1602    "\
1603 This returns the ext2/3/4 filesystem label of the filesystem on
1604 C<device>.");
1605
1606   ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
1607    [InitBasicFS, TestOutput (
1608       [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
1609        ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
1610     InitBasicFS, TestOutput (
1611       [["set_e2uuid"; "/dev/sda1"; "clear"];
1612        ["get_e2uuid"; "/dev/sda1"]], "");
1613     (* We can't predict what UUIDs will be, so just check the commands run. *)
1614     InitBasicFS, TestRun (
1615       [["set_e2uuid"; "/dev/sda1"; "random"]]);
1616     InitBasicFS, TestRun (
1617       [["set_e2uuid"; "/dev/sda1"; "time"]])],
1618    "set the ext2/3/4 filesystem UUID",
1619    "\
1620 This sets the ext2/3/4 filesystem UUID of the filesystem on
1621 C<device> to C<uuid>.  The format of the UUID and alternatives
1622 such as C<clear>, C<random> and C<time> are described in the
1623 L<tune2fs(8)> manpage.
1624
1625 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
1626 to return the existing UUID of a filesystem.");
1627
1628   ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
1629    [],
1630    "get the ext2/3/4 filesystem UUID",
1631    "\
1632 This returns the ext2/3/4 filesystem UUID of the filesystem on
1633 C<device>.");
1634
1635   ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
1636    [InitBasicFS, TestOutputInt (
1637       [["umount"; "/dev/sda1"];
1638        ["fsck"; "ext2"; "/dev/sda1"]], 0);
1639     InitBasicFS, TestOutputInt (
1640       [["umount"; "/dev/sda1"];
1641        ["zero"; "/dev/sda1"];
1642        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
1643    "run the filesystem checker",
1644    "\
1645 This runs the filesystem checker (fsck) on C<device> which
1646 should have filesystem type C<fstype>.
1647
1648 The returned integer is the status.  See L<fsck(8)> for the
1649 list of status codes from C<fsck>.
1650
1651 Notes:
1652
1653 =over 4
1654
1655 =item *
1656
1657 Multiple status codes can be summed together.
1658
1659 =item *
1660
1661 A non-zero return code can mean \"success\", for example if
1662 errors have been corrected on the filesystem.
1663
1664 =item *
1665
1666 Checking or repairing NTFS volumes is not supported
1667 (by linux-ntfs).
1668
1669 =back
1670
1671 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
1672
1673   ("zero", (RErr, [String "device"]), 85, [],
1674    [InitBasicFS, TestOutput (
1675       [["umount"; "/dev/sda1"];
1676        ["zero"; "/dev/sda1"];
1677        ["file"; "/dev/sda1"]], "data")],
1678    "write zeroes to the device",
1679    "\
1680 This command writes zeroes over the first few blocks of C<device>.
1681
1682 How many blocks are zeroed isn't specified (but it's I<not> enough
1683 to securely wipe the device).  It should be sufficient to remove
1684 any partition tables, filesystem superblocks and so on.");
1685
1686   ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
1687    [InitBasicFS, TestOutputTrue (
1688       [["grub_install"; "/"; "/dev/sda1"];
1689        ["is_dir"; "/boot"]])],
1690    "install GRUB",
1691    "\
1692 This command installs GRUB (the Grand Unified Bootloader) on
1693 C<device>, with the root directory being C<root>.");
1694
1695   ("cp", (RErr, [String "src"; String "dest"]), 87, [],
1696    [InitBasicFS, TestOutput (
1697       [["write_file"; "/old"; "file content"; "0"];
1698        ["cp"; "/old"; "/new"];
1699        ["cat"; "/new"]], "file content");
1700     InitBasicFS, TestOutputTrue (
1701       [["write_file"; "/old"; "file content"; "0"];
1702        ["cp"; "/old"; "/new"];
1703        ["is_file"; "/old"]]);
1704     InitBasicFS, TestOutput (
1705       [["write_file"; "/old"; "file content"; "0"];
1706        ["mkdir"; "/dir"];
1707        ["cp"; "/old"; "/dir/new"];
1708        ["cat"; "/dir/new"]], "file content")],
1709    "copy a file",
1710    "\
1711 This copies a file from C<src> to C<dest> where C<dest> is
1712 either a destination filename or destination directory.");
1713
1714   ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
1715    [InitBasicFS, TestOutput (
1716       [["mkdir"; "/olddir"];
1717        ["mkdir"; "/newdir"];
1718        ["write_file"; "/olddir/file"; "file content"; "0"];
1719        ["cp_a"; "/olddir"; "/newdir"];
1720        ["cat"; "/newdir/olddir/file"]], "file content")],
1721    "copy a file or directory recursively",
1722    "\
1723 This copies a file or directory from C<src> to C<dest>
1724 recursively using the C<cp -a> command.");
1725
1726   ("mv", (RErr, [String "src"; String "dest"]), 89, [],
1727    [InitBasicFS, TestOutput (
1728       [["write_file"; "/old"; "file content"; "0"];
1729        ["mv"; "/old"; "/new"];
1730        ["cat"; "/new"]], "file content");
1731     InitBasicFS, TestOutputFalse (
1732       [["write_file"; "/old"; "file content"; "0"];
1733        ["mv"; "/old"; "/new"];
1734        ["is_file"; "/old"]])],
1735    "move a file",
1736    "\
1737 This moves a file from C<src> to C<dest> where C<dest> is
1738 either a destination filename or destination directory.");
1739
1740   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
1741    [InitEmpty, TestRun (
1742       [["drop_caches"; "3"]])],
1743    "drop kernel page cache, dentries and inodes",
1744    "\
1745 This instructs the guest kernel to drop its page cache,
1746 and/or dentries and inode caches.  The parameter C<whattodrop>
1747 tells the kernel what precisely to drop, see
1748 L<http://linux-mm.org/Drop_Caches>
1749
1750 Setting C<whattodrop> to 3 should drop everything.
1751
1752 This automatically calls L<sync(2)> before the operation,
1753 so that the maximum guest memory is freed.");
1754
1755 ]
1756
1757 let all_functions = non_daemon_functions @ daemon_functions
1758
1759 (* In some places we want the functions to be displayed sorted
1760  * alphabetically, so this is useful:
1761  *)
1762 let all_functions_sorted =
1763   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1764                compare n1 n2) all_functions
1765
1766 (* Column names and types from LVM PVs/VGs/LVs. *)
1767 let pv_cols = [
1768   "pv_name", `String;
1769   "pv_uuid", `UUID;
1770   "pv_fmt", `String;
1771   "pv_size", `Bytes;
1772   "dev_size", `Bytes;
1773   "pv_free", `Bytes;
1774   "pv_used", `Bytes;
1775   "pv_attr", `String (* XXX *);
1776   "pv_pe_count", `Int;
1777   "pv_pe_alloc_count", `Int;
1778   "pv_tags", `String;
1779   "pe_start", `Bytes;
1780   "pv_mda_count", `Int;
1781   "pv_mda_free", `Bytes;
1782 (* Not in Fedora 10:
1783   "pv_mda_size", `Bytes;
1784 *)
1785 ]
1786 let vg_cols = [
1787   "vg_name", `String;
1788   "vg_uuid", `UUID;
1789   "vg_fmt", `String;
1790   "vg_attr", `String (* XXX *);
1791   "vg_size", `Bytes;
1792   "vg_free", `Bytes;
1793   "vg_sysid", `String;
1794   "vg_extent_size", `Bytes;
1795   "vg_extent_count", `Int;
1796   "vg_free_count", `Int;
1797   "max_lv", `Int;
1798   "max_pv", `Int;
1799   "pv_count", `Int;
1800   "lv_count", `Int;
1801   "snap_count", `Int;
1802   "vg_seqno", `Int;
1803   "vg_tags", `String;
1804   "vg_mda_count", `Int;
1805   "vg_mda_free", `Bytes;
1806 (* Not in Fedora 10:
1807   "vg_mda_size", `Bytes;
1808 *)
1809 ]
1810 let lv_cols = [
1811   "lv_name", `String;
1812   "lv_uuid", `UUID;
1813   "lv_attr", `String (* XXX *);
1814   "lv_major", `Int;
1815   "lv_minor", `Int;
1816   "lv_kernel_major", `Int;
1817   "lv_kernel_minor", `Int;
1818   "lv_size", `Bytes;
1819   "seg_count", `Int;
1820   "origin", `String;
1821   "snap_percent", `OptPercent;
1822   "copy_percent", `OptPercent;
1823   "move_pv", `String;
1824   "lv_tags", `String;
1825   "mirror_log", `String;
1826   "modules", `String;
1827 ]
1828
1829 (* Column names and types from stat structures.
1830  * NB. Can't use things like 'st_atime' because glibc header files
1831  * define some of these as macros.  Ugh.
1832  *)
1833 let stat_cols = [
1834   "dev", `Int;
1835   "ino", `Int;
1836   "mode", `Int;
1837   "nlink", `Int;
1838   "uid", `Int;
1839   "gid", `Int;
1840   "rdev", `Int;
1841   "size", `Int;
1842   "blksize", `Int;
1843   "blocks", `Int;
1844   "atime", `Int;
1845   "mtime", `Int;
1846   "ctime", `Int;
1847 ]
1848 let statvfs_cols = [
1849   "bsize", `Int;
1850   "frsize", `Int;
1851   "blocks", `Int;
1852   "bfree", `Int;
1853   "bavail", `Int;
1854   "files", `Int;
1855   "ffree", `Int;
1856   "favail", `Int;
1857   "fsid", `Int;
1858   "flag", `Int;
1859   "namemax", `Int;
1860 ]
1861
1862 (* Useful functions.
1863  * Note we don't want to use any external OCaml libraries which
1864  * makes this a bit harder than it should be.
1865  *)
1866 let failwithf fs = ksprintf failwith fs
1867
1868 let replace_char s c1 c2 =
1869   let s2 = String.copy s in
1870   let r = ref false in
1871   for i = 0 to String.length s2 - 1 do
1872     if String.unsafe_get s2 i = c1 then (
1873       String.unsafe_set s2 i c2;
1874       r := true
1875     )
1876   done;
1877   if not !r then s else s2
1878
1879 let isspace c =
1880   c = ' '
1881   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1882
1883 let triml ?(test = isspace) str =
1884   let i = ref 0 in
1885   let n = ref (String.length str) in
1886   while !n > 0 && test str.[!i]; do
1887     decr n;
1888     incr i
1889   done;
1890   if !i = 0 then str
1891   else String.sub str !i !n
1892
1893 let trimr ?(test = isspace) str =
1894   let n = ref (String.length str) in
1895   while !n > 0 && test str.[!n-1]; do
1896     decr n
1897   done;
1898   if !n = String.length str then str
1899   else String.sub str 0 !n
1900
1901 let trim ?(test = isspace) str =
1902   trimr ~test (triml ~test str)
1903
1904 let rec find s sub =
1905   let len = String.length s in
1906   let sublen = String.length sub in
1907   let rec loop i =
1908     if i <= len-sublen then (
1909       let rec loop2 j =
1910         if j < sublen then (
1911           if s.[i+j] = sub.[j] then loop2 (j+1)
1912           else -1
1913         ) else
1914           i (* found *)
1915       in
1916       let r = loop2 0 in
1917       if r = -1 then loop (i+1) else r
1918     ) else
1919       -1 (* not found *)
1920   in
1921   loop 0
1922
1923 let rec replace_str s s1 s2 =
1924   let len = String.length s in
1925   let sublen = String.length s1 in
1926   let i = find s s1 in
1927   if i = -1 then s
1928   else (
1929     let s' = String.sub s 0 i in
1930     let s'' = String.sub s (i+sublen) (len-i-sublen) in
1931     s' ^ s2 ^ replace_str s'' s1 s2
1932   )
1933
1934 let rec string_split sep str =
1935   let len = String.length str in
1936   let seplen = String.length sep in
1937   let i = find str sep in
1938   if i = -1 then [str]
1939   else (
1940     let s' = String.sub str 0 i in
1941     let s'' = String.sub str (i+seplen) (len-i-seplen) in
1942     s' :: string_split sep s''
1943   )
1944
1945 let files_equal n1 n2 =
1946   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
1947   match Sys.command cmd with
1948   | 0 -> true
1949   | 1 -> false
1950   | i -> failwithf "%s: failed with error code %d" cmd i
1951
1952 let rec find_map f = function
1953   | [] -> raise Not_found
1954   | x :: xs ->
1955       match f x with
1956       | Some y -> y
1957       | None -> find_map f xs
1958
1959 let iteri f xs =
1960   let rec loop i = function
1961     | [] -> ()
1962     | x :: xs -> f i x; loop (i+1) xs
1963   in
1964   loop 0 xs
1965
1966 let mapi f xs =
1967   let rec loop i = function
1968     | [] -> []
1969     | x :: xs -> let r = f i x in r :: loop (i+1) xs
1970   in
1971   loop 0 xs
1972
1973 let name_of_argt = function
1974   | String n | OptString n | StringList n | Bool n | Int n
1975   | FileIn n | FileOut n -> n
1976
1977 let seq_of_test = function
1978   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1979   | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1980   | TestOutputLength (s, _) | TestOutputStruct (s, _)
1981   | TestLastFail s -> s
1982
1983 (* Check function names etc. for consistency. *)
1984 let check_functions () =
1985   let contains_uppercase str =
1986     let len = String.length str in
1987     let rec loop i =
1988       if i >= len then false
1989       else (
1990         let c = str.[i] in
1991         if c >= 'A' && c <= 'Z' then true
1992         else loop (i+1)
1993       )
1994     in
1995     loop 0
1996   in
1997
1998   (* Check function names. *)
1999   List.iter (
2000     fun (name, _, _, _, _, _, _) ->
2001       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2002         failwithf "function name %s does not need 'guestfs' prefix" name;
2003       if contains_uppercase name then
2004         failwithf "function name %s should not contain uppercase chars" name;
2005       if String.contains name '-' then
2006         failwithf "function name %s should not contain '-', use '_' instead."
2007           name
2008   ) all_functions;
2009
2010   (* Check function parameter/return names. *)
2011   List.iter (
2012     fun (name, style, _, _, _, _, _) ->
2013       let check_arg_ret_name n =
2014         if contains_uppercase n then
2015           failwithf "%s param/ret %s should not contain uppercase chars"
2016             name n;
2017         if String.contains n '-' || String.contains n '_' then
2018           failwithf "%s param/ret %s should not contain '-' or '_'"
2019             name n;
2020         if n = "value" then
2021           failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n;
2022         if n = "argv" || n = "args" then
2023           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
2024       in
2025
2026       (match fst style with
2027        | RErr -> ()
2028        | RInt n | RInt64 n | RBool n | RConstString n | RString n
2029        | RStringList n | RPVList n | RVGList n | RLVList n
2030        | RStat n | RStatVFS n
2031        | RHashtable n ->
2032            check_arg_ret_name n
2033        | RIntBool (n,m) ->
2034            check_arg_ret_name n;
2035            check_arg_ret_name m
2036       );
2037       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2038   ) all_functions;
2039
2040   (* Check short descriptions. *)
2041   List.iter (
2042     fun (name, _, _, _, _, shortdesc, _) ->
2043       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2044         failwithf "short description of %s should begin with lowercase." name;
2045       let c = shortdesc.[String.length shortdesc-1] in
2046       if c = '\n' || c = '.' then
2047         failwithf "short description of %s should not end with . or \\n." name
2048   ) all_functions;
2049
2050   (* Check long dscriptions. *)
2051   List.iter (
2052     fun (name, _, _, _, _, _, longdesc) ->
2053       if longdesc.[String.length longdesc-1] = '\n' then
2054         failwithf "long description of %s should not end with \\n." name
2055   ) all_functions;
2056
2057   (* Check proc_nrs. *)
2058   List.iter (
2059     fun (name, _, proc_nr, _, _, _, _) ->
2060       if proc_nr <= 0 then
2061         failwithf "daemon function %s should have proc_nr > 0" name
2062   ) daemon_functions;
2063
2064   List.iter (
2065     fun (name, _, proc_nr, _, _, _, _) ->
2066       if proc_nr <> -1 then
2067         failwithf "non-daemon function %s should have proc_nr -1" name
2068   ) non_daemon_functions;
2069
2070   let proc_nrs =
2071     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2072       daemon_functions in
2073   let proc_nrs =
2074     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2075   let rec loop = function
2076     | [] -> ()
2077     | [_] -> ()
2078     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2079         loop rest
2080     | (name1,nr1) :: (name2,nr2) :: _ ->
2081         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2082           name1 name2 nr1 nr2
2083   in
2084   loop proc_nrs;
2085
2086   (* Check tests. *)
2087   List.iter (
2088     function
2089       (* Ignore functions that have no tests.  We generate a
2090        * warning when the user does 'make check' instead.
2091        *)
2092     | name, _, _, _, [], _, _ -> ()
2093     | name, _, _, _, tests, _, _ ->
2094         let funcs =
2095           List.map (
2096             fun (_, test) ->
2097               match seq_of_test test with
2098               | [] ->
2099                   failwithf "%s has a test containing an empty sequence" name
2100               | cmds -> List.map List.hd cmds
2101           ) tests in
2102         let funcs = List.flatten funcs in
2103
2104         let tested = List.mem name funcs in
2105
2106         if not tested then
2107           failwithf "function %s has tests but does not test itself" name
2108   ) all_functions
2109
2110 (* 'pr' prints to the current output file. *)
2111 let chan = ref stdout
2112 let pr fs = ksprintf (output_string !chan) fs
2113
2114 (* Generate a header block in a number of standard styles. *)
2115 type comment_style = CStyle | HashStyle | OCamlStyle
2116 type license = GPLv2 | LGPLv2
2117
2118 let generate_header comment license =
2119   let c = match comment with
2120     | CStyle ->     pr "/* "; " *"
2121     | HashStyle ->  pr "# ";  "#"
2122     | OCamlStyle -> pr "(* "; " *" in
2123   pr "libguestfs generated file\n";
2124   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2125   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2126   pr "%s\n" c;
2127   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2128   pr "%s\n" c;
2129   (match license with
2130    | GPLv2 ->
2131        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2132        pr "%s it under the terms of the GNU General Public License as published by\n" c;
2133        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2134        pr "%s (at your option) any later version.\n" c;
2135        pr "%s\n" c;
2136        pr "%s This program is distributed in the hope that it will be useful,\n" c;
2137        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2138        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
2139        pr "%s GNU General Public License for more details.\n" c;
2140        pr "%s\n" c;
2141        pr "%s You should have received a copy of the GNU General Public License along\n" c;
2142        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2143        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2144
2145    | LGPLv2 ->
2146        pr "%s This library is free software; you can redistribute it and/or\n" c;
2147        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2148        pr "%s License as published by the Free Software Foundation; either\n" c;
2149        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2150        pr "%s\n" c;
2151        pr "%s This library is distributed in the hope that it will be useful,\n" c;
2152        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2153        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
2154        pr "%s Lesser General Public License for more details.\n" c;
2155        pr "%s\n" c;
2156        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2157        pr "%s License along with this library; if not, write to the Free Software\n" c;
2158        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2159   );
2160   (match comment with
2161    | CStyle -> pr " */\n"
2162    | HashStyle -> ()
2163    | OCamlStyle -> pr " *)\n"
2164   );
2165   pr "\n"
2166
2167 (* Start of main code generation functions below this line. *)
2168
2169 (* Generate the pod documentation for the C API. *)
2170 let rec generate_actions_pod () =
2171   List.iter (
2172     fun (shortname, style, _, flags, _, _, longdesc) ->
2173       let name = "guestfs_" ^ shortname in
2174       pr "=head2 %s\n\n" name;
2175       pr " ";
2176       generate_prototype ~extern:false ~handle:"handle" name style;
2177       pr "\n\n";
2178       pr "%s\n\n" longdesc;
2179       (match fst style with
2180        | RErr ->
2181            pr "This function returns 0 on success or -1 on error.\n\n"
2182        | RInt _ ->
2183            pr "On error this function returns -1.\n\n"
2184        | RInt64 _ ->
2185            pr "On error this function returns -1.\n\n"
2186        | RBool _ ->
2187            pr "This function returns a C truth value on success or -1 on error.\n\n"
2188        | RConstString _ ->
2189            pr "This function returns a string, or NULL on error.
2190 The string is owned by the guest handle and must I<not> be freed.\n\n"
2191        | RString _ ->
2192            pr "This function returns a string, or NULL on error.
2193 I<The caller must free the returned string after use>.\n\n"
2194        | RStringList _ ->
2195            pr "This function returns a NULL-terminated array of strings
2196 (like L<environ(3)>), or NULL if there was an error.
2197 I<The caller must free the strings and the array after use>.\n\n"
2198        | RIntBool _ ->
2199            pr "This function returns a C<struct guestfs_int_bool *>,
2200 or NULL if there was an error.
2201 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2202        | RPVList _ ->
2203            pr "This function returns a C<struct guestfs_lvm_pv_list *>
2204 (see E<lt>guestfs-structs.hE<gt>),
2205 or NULL if there was an error.
2206 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2207        | RVGList _ ->
2208            pr "This function returns a C<struct guestfs_lvm_vg_list *>
2209 (see E<lt>guestfs-structs.hE<gt>),
2210 or NULL if there was an error.
2211 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2212        | RLVList _ ->
2213            pr "This function returns a C<struct guestfs_lvm_lv_list *>
2214 (see E<lt>guestfs-structs.hE<gt>),
2215 or NULL if there was an error.
2216 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2217        | RStat _ ->
2218            pr "This function returns a C<struct guestfs_stat *>
2219 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2220 or NULL if there was an error.
2221 I<The caller must call C<free> after use>.\n\n"
2222        | RStatVFS _ ->
2223            pr "This function returns a C<struct guestfs_statvfs *>
2224 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2225 or NULL if there was an error.
2226 I<The caller must call C<free> after use>.\n\n"
2227        | RHashtable _ ->
2228            pr "This function returns a NULL-terminated array of
2229 strings, or NULL if there was an error.
2230 The array of strings will always have length C<2n+1>, where
2231 C<n> keys and values alternate, followed by the trailing NULL entry.
2232 I<The caller must free the strings and the array after use>.\n\n"
2233       );
2234       if List.mem ProtocolLimitWarning flags then
2235         pr "%s\n\n" protocol_limit_warning;
2236       if List.mem DangerWillRobinson flags then
2237         pr "%s\n\n" danger_will_robinson;
2238   ) all_functions_sorted
2239
2240 and generate_structs_pod () =
2241   (* LVM structs documentation. *)
2242   List.iter (
2243     fun (typ, cols) ->
2244       pr "=head2 guestfs_lvm_%s\n" typ;
2245       pr "\n";
2246       pr " struct guestfs_lvm_%s {\n" typ;
2247       List.iter (
2248         function
2249         | name, `String -> pr "  char *%s;\n" name
2250         | name, `UUID ->
2251             pr "  /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2252             pr "  char %s[32];\n" name
2253         | name, `Bytes -> pr "  uint64_t %s;\n" name
2254         | name, `Int -> pr "  int64_t %s;\n" name
2255         | name, `OptPercent ->
2256             pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
2257             pr "  float %s;\n" name
2258       ) cols;
2259       pr " \n";
2260       pr " struct guestfs_lvm_%s_list {\n" typ;
2261       pr "   uint32_t len; /* Number of elements in list. */\n";
2262       pr "   struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2263       pr " };\n";
2264       pr " \n";
2265       pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2266         typ typ;
2267       pr "\n"
2268   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2269
2270 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
2271  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
2272  *
2273  * We have to use an underscore instead of a dash because otherwise
2274  * rpcgen generates incorrect code.
2275  *
2276  * This header is NOT exported to clients, but see also generate_structs_h.
2277  *)
2278 and generate_xdr () =
2279   generate_header CStyle LGPLv2;
2280
2281   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
2282   pr "typedef string str<>;\n";
2283   pr "\n";
2284
2285   (* LVM internal structures. *)
2286   List.iter (
2287     function
2288     | typ, cols ->
2289         pr "struct guestfs_lvm_int_%s {\n" typ;
2290         List.iter (function
2291                    | name, `String -> pr "  string %s<>;\n" name
2292                    | name, `UUID -> pr "  opaque %s[32];\n" name
2293                    | name, `Bytes -> pr "  hyper %s;\n" name
2294                    | name, `Int -> pr "  hyper %s;\n" name
2295                    | name, `OptPercent -> pr "  float %s;\n" name
2296                   ) cols;
2297         pr "};\n";
2298         pr "\n";
2299         pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
2300         pr "\n";
2301   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2302
2303   (* Stat internal structures. *)
2304   List.iter (
2305     function
2306     | typ, cols ->
2307         pr "struct guestfs_int_%s {\n" typ;
2308         List.iter (function
2309                    | name, `Int -> pr "  hyper %s;\n" name
2310                   ) cols;
2311         pr "};\n";
2312         pr "\n";
2313   ) ["stat", stat_cols; "statvfs", statvfs_cols];
2314
2315   List.iter (
2316     fun (shortname, style, _, _, _, _, _) ->
2317       let name = "guestfs_" ^ shortname in
2318
2319       (match snd style with
2320        | [] -> ()
2321        | args ->
2322            pr "struct %s_args {\n" name;
2323            List.iter (
2324              function
2325              | String n -> pr "  string %s<>;\n" n
2326              | OptString n -> pr "  str *%s;\n" n
2327              | StringList n -> pr "  str %s<>;\n" n
2328              | Bool n -> pr "  bool %s;\n" n
2329              | Int n -> pr "  int %s;\n" n
2330              | FileIn _ | FileOut _ -> ()
2331            ) args;
2332            pr "};\n\n"
2333       );
2334       (match fst style with
2335        | RErr -> ()
2336        | RInt n ->
2337            pr "struct %s_ret {\n" name;
2338            pr "  int %s;\n" n;
2339            pr "};\n\n"
2340        | RInt64 n ->
2341            pr "struct %s_ret {\n" name;
2342            pr "  hyper %s;\n" n;
2343            pr "};\n\n"
2344        | RBool n ->
2345            pr "struct %s_ret {\n" name;
2346            pr "  bool %s;\n" n;
2347            pr "};\n\n"
2348        | RConstString _ ->
2349            failwithf "RConstString cannot be returned from a daemon function"
2350        | RString n ->
2351            pr "struct %s_ret {\n" name;
2352            pr "  string %s<>;\n" n;
2353            pr "};\n\n"
2354        | RStringList n ->
2355            pr "struct %s_ret {\n" name;
2356            pr "  str %s<>;\n" n;
2357            pr "};\n\n"
2358        | RIntBool (n,m) ->
2359            pr "struct %s_ret {\n" name;
2360            pr "  int %s;\n" n;
2361            pr "  bool %s;\n" m;
2362            pr "};\n\n"
2363        | RPVList n ->
2364            pr "struct %s_ret {\n" name;
2365            pr "  guestfs_lvm_int_pv_list %s;\n" n;
2366            pr "};\n\n"
2367        | RVGList n ->
2368            pr "struct %s_ret {\n" name;
2369            pr "  guestfs_lvm_int_vg_list %s;\n" n;
2370            pr "};\n\n"
2371        | RLVList n ->
2372            pr "struct %s_ret {\n" name;
2373            pr "  guestfs_lvm_int_lv_list %s;\n" n;
2374            pr "};\n\n"
2375        | RStat n ->
2376            pr "struct %s_ret {\n" name;
2377            pr "  guestfs_int_stat %s;\n" n;
2378            pr "};\n\n"
2379        | RStatVFS n ->
2380            pr "struct %s_ret {\n" name;
2381            pr "  guestfs_int_statvfs %s;\n" n;
2382            pr "};\n\n"
2383        | RHashtable n ->
2384            pr "struct %s_ret {\n" name;
2385            pr "  str %s<>;\n" n;
2386            pr "};\n\n"
2387       );
2388   ) daemon_functions;
2389
2390   (* Table of procedure numbers. *)
2391   pr "enum guestfs_procedure {\n";
2392   List.iter (
2393     fun (shortname, _, proc_nr, _, _, _, _) ->
2394       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2395   ) daemon_functions;
2396   pr "  GUESTFS_PROC_NR_PROCS\n";
2397   pr "};\n";
2398   pr "\n";
2399
2400   (* Having to choose a maximum message size is annoying for several
2401    * reasons (it limits what we can do in the API), but it (a) makes
2402    * the protocol a lot simpler, and (b) provides a bound on the size
2403    * of the daemon which operates in limited memory space.  For large
2404    * file transfers you should use FTP.
2405    *)
2406   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2407   pr "\n";
2408
2409   (* Message header, etc. *)
2410   pr "\
2411 /* The communication protocol is now documented in the guestfs(3)
2412  * manpage.
2413  */
2414
2415 const GUESTFS_PROGRAM = 0x2000F5F5;
2416 const GUESTFS_PROTOCOL_VERSION = 1;
2417
2418 /* These constants must be larger than any possible message length. */
2419 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2420 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2421
2422 enum guestfs_message_direction {
2423   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
2424   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
2425 };
2426
2427 enum guestfs_message_status {
2428   GUESTFS_STATUS_OK = 0,
2429   GUESTFS_STATUS_ERROR = 1
2430 };
2431
2432 const GUESTFS_ERROR_LEN = 256;
2433
2434 struct guestfs_message_error {
2435   string error_message<GUESTFS_ERROR_LEN>;
2436 };
2437
2438 struct guestfs_message_header {
2439   unsigned prog;                     /* GUESTFS_PROGRAM */
2440   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
2441   guestfs_procedure proc;            /* GUESTFS_PROC_x */
2442   guestfs_message_direction direction;
2443   unsigned serial;                   /* message serial number */
2444   guestfs_message_status status;
2445 };
2446
2447 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2448
2449 struct guestfs_chunk {
2450   int cancel;                        /* if non-zero, transfer is cancelled */
2451   /* data size is 0 bytes if the transfer has finished successfully */
2452   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2453 };
2454 "
2455
2456 (* Generate the guestfs-structs.h file. *)
2457 and generate_structs_h () =
2458   generate_header CStyle LGPLv2;
2459
2460   (* This is a public exported header file containing various
2461    * structures.  The structures are carefully written to have
2462    * exactly the same in-memory format as the XDR structures that
2463    * we use on the wire to the daemon.  The reason for creating
2464    * copies of these structures here is just so we don't have to
2465    * export the whole of guestfs_protocol.h (which includes much
2466    * unrelated and XDR-dependent stuff that we don't want to be
2467    * public, or required by clients).
2468    *
2469    * To reiterate, we will pass these structures to and from the
2470    * client with a simple assignment or memcpy, so the format
2471    * must be identical to what rpcgen / the RFC defines.
2472    *)
2473
2474   (* guestfs_int_bool structure. *)
2475   pr "struct guestfs_int_bool {\n";
2476   pr "  int32_t i;\n";
2477   pr "  int32_t b;\n";
2478   pr "};\n";
2479   pr "\n";
2480
2481   (* LVM public structures. *)
2482   List.iter (
2483     function
2484     | typ, cols ->
2485         pr "struct guestfs_lvm_%s {\n" typ;
2486         List.iter (
2487           function
2488           | name, `String -> pr "  char *%s;\n" name
2489           | name, `UUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2490           | name, `Bytes -> pr "  uint64_t %s;\n" name
2491           | name, `Int -> pr "  int64_t %s;\n" name
2492           | name, `OptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
2493         ) cols;
2494         pr "};\n";
2495         pr "\n";
2496         pr "struct guestfs_lvm_%s_list {\n" typ;
2497         pr "  uint32_t len;\n";
2498         pr "  struct guestfs_lvm_%s *val;\n" typ;
2499         pr "};\n";
2500         pr "\n"
2501   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2502
2503   (* Stat structures. *)
2504   List.iter (
2505     function
2506     | typ, cols ->
2507         pr "struct guestfs_%s {\n" typ;
2508         List.iter (
2509           function
2510           | name, `Int -> pr "  int64_t %s;\n" name
2511         ) cols;
2512         pr "};\n";
2513         pr "\n"
2514   ) ["stat", stat_cols; "statvfs", statvfs_cols]
2515
2516 (* Generate the guestfs-actions.h file. *)
2517 and generate_actions_h () =
2518   generate_header CStyle LGPLv2;
2519   List.iter (
2520     fun (shortname, style, _, _, _, _, _) ->
2521       let name = "guestfs_" ^ shortname in
2522       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2523         name style
2524   ) all_functions
2525
2526 (* Generate the client-side dispatch stubs. *)
2527 and generate_client_actions () =
2528   generate_header CStyle LGPLv2;
2529
2530   pr "\
2531 #include <stdio.h>
2532 #include <stdlib.h>
2533
2534 #include \"guestfs.h\"
2535 #include \"guestfs_protocol.h\"
2536
2537 #define error guestfs_error
2538 #define perrorf guestfs_perrorf
2539 #define safe_malloc guestfs_safe_malloc
2540 #define safe_realloc guestfs_safe_realloc
2541 #define safe_strdup guestfs_safe_strdup
2542 #define safe_memdup guestfs_safe_memdup
2543
2544 /* Check the return message from a call for validity. */
2545 static int
2546 check_reply_header (guestfs_h *g,
2547                     const struct guestfs_message_header *hdr,
2548                     int proc_nr, int serial)
2549 {
2550   if (hdr->prog != GUESTFS_PROGRAM) {
2551     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2552     return -1;
2553   }
2554   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2555     error (g, \"wrong protocol version (%%d/%%d)\",
2556            hdr->vers, GUESTFS_PROTOCOL_VERSION);
2557     return -1;
2558   }
2559   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2560     error (g, \"unexpected message direction (%%d/%%d)\",
2561            hdr->direction, GUESTFS_DIRECTION_REPLY);
2562     return -1;
2563   }
2564   if (hdr->proc != proc_nr) {
2565     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2566     return -1;
2567   }
2568   if (hdr->serial != serial) {
2569     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2570     return -1;
2571   }
2572
2573   return 0;
2574 }
2575
2576 /* Check we are in the right state to run a high-level action. */
2577 static int
2578 check_state (guestfs_h *g, const char *caller)
2579 {
2580   if (!guestfs_is_ready (g)) {
2581     if (guestfs_is_config (g))
2582       error (g, \"%%s: call launch() before using this function\",
2583         caller);
2584     else if (guestfs_is_launching (g))
2585       error (g, \"%%s: call wait_ready() before using this function\",
2586         caller);
2587     else
2588       error (g, \"%%s called from the wrong state, %%d != READY\",
2589         caller, guestfs_get_state (g));
2590     return -1;
2591   }
2592   return 0;
2593 }
2594
2595 ";
2596
2597   (* Client-side stubs for each function. *)
2598   List.iter (
2599     fun (shortname, style, _, _, _, _, _) ->
2600       let name = "guestfs_" ^ shortname in
2601
2602       (* Generate the context struct which stores the high-level
2603        * state between callback functions.
2604        *)
2605       pr "struct %s_ctx {\n" shortname;
2606       pr "  /* This flag is set by the callbacks, so we know we've done\n";
2607       pr "   * the callbacks as expected, and in the right sequence.\n";
2608       pr "   * 0 = not called, 1 = reply_cb called.\n";
2609       pr "   */\n";
2610       pr "  int cb_sequence;\n";
2611       pr "  struct guestfs_message_header hdr;\n";
2612       pr "  struct guestfs_message_error err;\n";
2613       (match fst style with
2614        | RErr -> ()
2615        | RConstString _ ->
2616            failwithf "RConstString cannot be returned from a daemon function"
2617        | RInt _ | RInt64 _
2618        | RBool _ | RString _ | RStringList _
2619        | RIntBool _
2620        | RPVList _ | RVGList _ | RLVList _
2621        | RStat _ | RStatVFS _
2622        | RHashtable _ ->
2623            pr "  struct %s_ret ret;\n" name
2624       );
2625       pr "};\n";
2626       pr "\n";
2627
2628       (* Generate the reply callback function. *)
2629       pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2630       pr "{\n";
2631       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2632       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2633       pr "\n";
2634       pr "  /* This should definitely not happen. */\n";
2635       pr "  if (ctx->cb_sequence != 0) {\n";
2636       pr "    ctx->cb_sequence = 9999;\n";
2637       pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
2638       pr "    return;\n";
2639       pr "  }\n";
2640       pr "\n";
2641       pr "  ml->main_loop_quit (ml, g);\n";
2642       pr "\n";
2643       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2644       pr "    error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2645       pr "    return;\n";
2646       pr "  }\n";
2647       pr "  if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2648       pr "    if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2649       pr "      error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2650         name;
2651       pr "      return;\n";
2652       pr "    }\n";
2653       pr "    goto done;\n";
2654       pr "  }\n";
2655
2656       (match fst style with
2657        | RErr -> ()
2658        | RConstString _ ->
2659            failwithf "RConstString cannot be returned from a daemon function"
2660        | RInt _ | RInt64 _
2661        | RBool _ | RString _ | RStringList _
2662        | RIntBool _
2663        | RPVList _ | RVGList _ | RLVList _
2664        | RStat _ | RStatVFS _
2665        | RHashtable _ ->
2666             pr "  if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2667             pr "    error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2668             pr "    return;\n";
2669             pr "  }\n";
2670       );
2671
2672       pr " done:\n";
2673       pr "  ctx->cb_sequence = 1;\n";
2674       pr "}\n\n";
2675
2676       (* Generate the action stub. *)
2677       generate_prototype ~extern:false ~semicolon:false ~newline:true
2678         ~handle:"g" name style;
2679
2680       let error_code =
2681         match fst style with
2682         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2683         | RConstString _ ->
2684             failwithf "RConstString cannot be returned from a daemon function"
2685         | RString _ | RStringList _ | RIntBool _
2686         | RPVList _ | RVGList _ | RLVList _
2687         | RStat _ | RStatVFS _
2688         | RHashtable _ ->
2689             "NULL" in
2690
2691       pr "{\n";
2692
2693       (match snd style with
2694        | [] -> ()
2695        | _ -> pr "  struct %s_args args;\n" name
2696       );
2697
2698       pr "  struct %s_ctx ctx;\n" shortname;
2699       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2700       pr "  int serial;\n";
2701       pr "\n";
2702       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2703       pr "  guestfs_set_busy (g);\n";
2704       pr "\n";
2705       pr "  memset (&ctx, 0, sizeof ctx);\n";
2706       pr "\n";
2707
2708       (* Send the main header and arguments. *)
2709       (match snd style with
2710        | [] ->
2711            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2712              (String.uppercase shortname)
2713        | args ->
2714            List.iter (
2715              function
2716              | String n ->
2717                  pr "  args.%s = (char *) %s;\n" n n
2718              | OptString n ->
2719                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
2720              | StringList n ->
2721                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
2722                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2723              | Bool n ->
2724                  pr "  args.%s = %s;\n" n n
2725              | Int n ->
2726                  pr "  args.%s = %s;\n" n n
2727              | FileIn _ | FileOut _ -> ()
2728            ) args;
2729            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2730              (String.uppercase shortname);
2731            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2732              name;
2733       );
2734       pr "  if (serial == -1) {\n";
2735       pr "    guestfs_set_ready (g);\n";
2736       pr "    return %s;\n" error_code;
2737       pr "  }\n";
2738       pr "\n";
2739
2740       (* Send any additional files (FileIn) requested. *)
2741       let need_read_reply_label = ref false in
2742       List.iter (
2743         function
2744         | FileIn n ->
2745             pr "  {\n";
2746             pr "    int r;\n";
2747             pr "\n";
2748             pr "    r = guestfs__send_file_sync (g, %s);\n" n;
2749             pr "    if (r == -1) {\n";
2750             pr "      guestfs_set_ready (g);\n";
2751             pr "      return %s;\n" error_code;
2752             pr "    }\n";
2753             pr "    if (r == -2) /* daemon cancelled */\n";
2754             pr "      goto read_reply;\n";
2755             need_read_reply_label := true;
2756             pr "  }\n";
2757             pr "\n";
2758         | _ -> ()
2759       ) (snd style);
2760
2761       (* Wait for the reply from the remote end. *)
2762       if !need_read_reply_label then pr " read_reply:\n";
2763       pr "  guestfs__switch_to_receiving (g);\n";
2764       pr "  ctx.cb_sequence = 0;\n";
2765       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2766       pr "  (void) ml->main_loop_run (ml, g);\n";
2767       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
2768       pr "  if (ctx.cb_sequence != 1) {\n";
2769       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2770       pr "    guestfs_set_ready (g);\n";
2771       pr "    return %s;\n" error_code;
2772       pr "  }\n";
2773       pr "\n";
2774
2775       pr "  if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2776         (String.uppercase shortname);
2777       pr "    guestfs_set_ready (g);\n";
2778       pr "    return %s;\n" error_code;
2779       pr "  }\n";
2780       pr "\n";
2781
2782       pr "  if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2783       pr "    error (g, \"%%s\", ctx.err.error_message);\n";
2784       pr "    guestfs_set_ready (g);\n";
2785       pr "    return %s;\n" error_code;
2786       pr "  }\n";
2787       pr "\n";
2788
2789       (* Expecting to receive further files (FileOut)? *)
2790       List.iter (
2791         function
2792         | FileOut n ->
2793             pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2794             pr "    guestfs_set_ready (g);\n";
2795             pr "    return %s;\n" error_code;
2796             pr "  }\n";
2797             pr "\n";
2798         | _ -> ()
2799       ) (snd style);
2800
2801       pr "  guestfs_set_ready (g);\n";
2802
2803       (match fst style with
2804        | RErr -> pr "  return 0;\n"
2805        | RInt n | RInt64 n | RBool n ->
2806            pr "  return ctx.ret.%s;\n" n
2807        | RConstString _ ->
2808            failwithf "RConstString cannot be returned from a daemon function"
2809        | RString n ->
2810            pr "  return ctx.ret.%s; /* caller will free */\n" n
2811        | RStringList n | RHashtable n ->
2812            pr "  /* caller will free this, but we need to add a NULL entry */\n";
2813            pr "  ctx.ret.%s.%s_val =\n" n n;
2814            pr "    safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2815            pr "                  sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2816              n n;
2817            pr "  ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2818            pr "  return ctx.ret.%s.%s_val;\n" n n
2819        | RIntBool _ ->
2820            pr "  /* caller with free this */\n";
2821            pr "  return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2822        | RPVList n | RVGList n | RLVList n
2823        | RStat n | RStatVFS n ->
2824            pr "  /* caller will free this */\n";
2825            pr "  return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2826       );
2827
2828       pr "}\n\n"
2829   ) daemon_functions
2830
2831 (* Generate daemon/actions.h. *)
2832 and generate_daemon_actions_h () =
2833   generate_header CStyle GPLv2;
2834
2835   pr "#include \"../src/guestfs_protocol.h\"\n";
2836   pr "\n";
2837
2838   List.iter (
2839     fun (name, style, _, _, _, _, _) ->
2840         generate_prototype
2841           ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2842           name style;
2843   ) daemon_functions
2844
2845 (* Generate the server-side stubs. *)
2846 and generate_daemon_actions () =
2847   generate_header CStyle GPLv2;
2848
2849   pr "#include <config.h>\n";
2850   pr "\n";
2851   pr "#include <stdio.h>\n";
2852   pr "#include <stdlib.h>\n";
2853   pr "#include <string.h>\n";
2854   pr "#include <inttypes.h>\n";
2855   pr "#include <ctype.h>\n";
2856   pr "#include <rpc/types.h>\n";
2857   pr "#include <rpc/xdr.h>\n";
2858   pr "\n";
2859   pr "#include \"daemon.h\"\n";
2860   pr "#include \"../src/guestfs_protocol.h\"\n";
2861   pr "#include \"actions.h\"\n";
2862   pr "\n";
2863
2864   List.iter (
2865     fun (name, style, _, _, _, _, _) ->
2866       (* Generate server-side stubs. *)
2867       pr "static void %s_stub (XDR *xdr_in)\n" name;
2868       pr "{\n";
2869       let error_code =
2870         match fst style with
2871         | RErr | RInt _ -> pr "  int r;\n"; "-1"
2872         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
2873         | RBool _ -> pr "  int r;\n"; "-1"
2874         | RConstString _ ->
2875             failwithf "RConstString cannot be returned from a daemon function"
2876         | RString _ -> pr "  char *r;\n"; "NULL"
2877         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
2878         | RIntBool _ -> pr "  guestfs_%s_ret *r;\n" name; "NULL"
2879         | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
2880         | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
2881         | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL"
2882         | RStat _ -> pr "  guestfs_int_stat *r;\n"; "NULL"
2883         | RStatVFS _ -> pr "  guestfs_int_statvfs *r;\n"; "NULL" in
2884
2885       (match snd style with
2886        | [] -> ()
2887        | args ->
2888            pr "  struct guestfs_%s_args args;\n" name;
2889            List.iter (
2890              function
2891              | String n
2892              | OptString n -> pr "  const char *%s;\n" n
2893              | StringList n -> pr "  char **%s;\n" n
2894              | Bool n -> pr "  int %s;\n" n
2895              | Int n -> pr "  int %s;\n" n
2896              | FileIn _ | FileOut _ -> ()
2897            ) args
2898       );
2899       pr "\n";
2900
2901       (match snd style with
2902        | [] -> ()
2903        | args ->
2904            pr "  memset (&args, 0, sizeof args);\n";
2905            pr "\n";
2906            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2907            pr "    reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2908            pr "    return;\n";
2909            pr "  }\n";
2910            List.iter (
2911              function
2912              | String n -> pr "  %s = args.%s;\n" n n
2913              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
2914              | StringList n ->
2915                  pr "  %s = realloc (args.%s.%s_val,\n" n n n;
2916                  pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
2917                  pr "  if (%s == NULL) {\n" n;
2918                  pr "    reply_with_perror (\"realloc\");\n";
2919                  pr "    goto done;\n";
2920                  pr "  }\n";
2921                  pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
2922                  pr "  args.%s.%s_val = %s;\n" n n n;
2923              | Bool n -> pr "  %s = args.%s;\n" n n
2924              | Int n -> pr "  %s = args.%s;\n" n n
2925              | FileIn _ | FileOut _ -> ()
2926            ) args;
2927            pr "\n"
2928       );
2929
2930       (* Don't want to call the impl with any FileIn or FileOut
2931        * parameters, since these go "outside" the RPC protocol.
2932        *)
2933       let argsnofile =
2934         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2935           (snd style) in
2936       pr "  r = do_%s " name;
2937       generate_call_args argsnofile;
2938       pr ";\n";
2939
2940       pr "  if (r == %s)\n" error_code;
2941       pr "    /* do_%s has already called reply_with_error */\n" name;
2942       pr "    goto done;\n";
2943       pr "\n";
2944
2945       (* If there are any FileOut parameters, then the impl must
2946        * send its own reply.
2947        *)
2948       let no_reply =
2949         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2950       if no_reply then
2951         pr "  /* do_%s has already sent a reply */\n" name
2952       else (
2953         match fst style with
2954         | RErr -> pr "  reply (NULL, NULL);\n"
2955         | RInt n | RInt64 n | RBool n ->
2956             pr "  struct guestfs_%s_ret ret;\n" name;
2957             pr "  ret.%s = r;\n" n;
2958             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2959               name
2960         | RConstString _ ->
2961             failwithf "RConstString cannot be returned from a daemon function"
2962         | RString n ->
2963             pr "  struct guestfs_%s_ret ret;\n" name;
2964             pr "  ret.%s = r;\n" n;
2965             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2966               name;
2967             pr "  free (r);\n"
2968         | RStringList n | RHashtable n ->
2969             pr "  struct guestfs_%s_ret ret;\n" name;
2970             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
2971             pr "  ret.%s.%s_val = r;\n" n n;
2972             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2973               name;
2974             pr "  free_strings (r);\n"
2975         | RIntBool _ ->
2976             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2977               name;
2978             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2979         | RPVList n | RVGList n | RLVList n
2980         | RStat n | RStatVFS n ->
2981             pr "  struct guestfs_%s_ret ret;\n" name;
2982             pr "  ret.%s = *r;\n" n;
2983             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2984               name;
2985             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2986               name
2987       );
2988
2989       (* Free the args. *)
2990       (match snd style with
2991        | [] ->
2992            pr "done: ;\n";
2993        | _ ->
2994            pr "done:\n";
2995            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2996              name
2997       );
2998
2999       pr "}\n\n";
3000   ) daemon_functions;
3001
3002   (* Dispatch function. *)
3003   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3004   pr "{\n";
3005   pr "  switch (proc_nr) {\n";
3006
3007   List.iter (
3008     fun (name, style, _, _, _, _, _) ->
3009         pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
3010         pr "      %s_stub (xdr_in);\n" name;
3011         pr "      break;\n"
3012   ) daemon_functions;
3013
3014   pr "    default:\n";
3015   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3016   pr "  }\n";
3017   pr "}\n";
3018   pr "\n";
3019
3020   (* LVM columns and tokenization functions. *)
3021   (* XXX This generates crap code.  We should rethink how we
3022    * do this parsing.
3023    *)
3024   List.iter (
3025     function
3026     | typ, cols ->
3027         pr "static const char *lvm_%s_cols = \"%s\";\n"
3028           typ (String.concat "," (List.map fst cols));
3029         pr "\n";
3030
3031         pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3032         pr "{\n";
3033         pr "  char *tok, *p, *next;\n";
3034         pr "  int i, j;\n";
3035         pr "\n";
3036         (*
3037         pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3038         pr "\n";
3039         *)
3040         pr "  if (!str) {\n";
3041         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3042         pr "    return -1;\n";
3043         pr "  }\n";
3044         pr "  if (!*str || isspace (*str)) {\n";
3045         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3046         pr "    return -1;\n";
3047         pr "  }\n";
3048         pr "  tok = str;\n";
3049         List.iter (
3050           fun (name, coltype) ->
3051             pr "  if (!tok) {\n";
3052             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3053             pr "    return -1;\n";
3054             pr "  }\n";
3055             pr "  p = strchrnul (tok, ',');\n";
3056             pr "  if (*p) next = p+1; else next = NULL;\n";
3057             pr "  *p = '\\0';\n";
3058             (match coltype with
3059              | `String ->
3060                  pr "  r->%s = strdup (tok);\n" name;
3061                  pr "  if (r->%s == NULL) {\n" name;
3062                  pr "    perror (\"strdup\");\n";
3063                  pr "    return -1;\n";
3064                  pr "  }\n"
3065              | `UUID ->
3066                  pr "  for (i = j = 0; i < 32; ++j) {\n";
3067                  pr "    if (tok[j] == '\\0') {\n";
3068                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3069                  pr "      return -1;\n";
3070                  pr "    } else if (tok[j] != '-')\n";
3071                  pr "      r->%s[i++] = tok[j];\n" name;
3072                  pr "  }\n";
3073              | `Bytes ->
3074                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3075                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3076                  pr "    return -1;\n";
3077                  pr "  }\n";
3078              | `Int ->
3079                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3080                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3081                  pr "    return -1;\n";
3082                  pr "  }\n";
3083              | `OptPercent ->
3084                  pr "  if (tok[0] == '\\0')\n";
3085                  pr "    r->%s = -1;\n" name;
3086                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3087                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3088                  pr "    return -1;\n";
3089                  pr "  }\n";
3090             );
3091             pr "  tok = next;\n";
3092         ) cols;
3093
3094         pr "  if (tok != NULL) {\n";
3095         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3096         pr "    return -1;\n";
3097         pr "  }\n";
3098         pr "  return 0;\n";
3099         pr "}\n";
3100         pr "\n";
3101
3102         pr "guestfs_lvm_int_%s_list *\n" typ;
3103         pr "parse_command_line_%ss (void)\n" typ;
3104         pr "{\n";
3105         pr "  char *out, *err;\n";
3106         pr "  char *p, *pend;\n";
3107         pr "  int r, i;\n";
3108         pr "  guestfs_lvm_int_%s_list *ret;\n" typ;
3109         pr "  void *newp;\n";
3110         pr "\n";
3111         pr "  ret = malloc (sizeof *ret);\n";
3112         pr "  if (!ret) {\n";
3113         pr "    reply_with_perror (\"malloc\");\n";
3114         pr "    return NULL;\n";
3115         pr "  }\n";
3116         pr "\n";
3117         pr "  ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3118         pr "  ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3119         pr "\n";
3120         pr "  r = command (&out, &err,\n";
3121         pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
3122         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3123         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3124         pr "  if (r == -1) {\n";
3125         pr "    reply_with_error (\"%%s\", err);\n";
3126         pr "    free (out);\n";
3127         pr "    free (err);\n";
3128         pr "    free (ret);\n";
3129         pr "    return NULL;\n";
3130         pr "  }\n";
3131         pr "\n";
3132         pr "  free (err);\n";
3133         pr "\n";
3134         pr "  /* Tokenize each line of the output. */\n";
3135         pr "  p = out;\n";
3136         pr "  i = 0;\n";
3137         pr "  while (p) {\n";
3138         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
3139         pr "    if (pend) {\n";
3140         pr "      *pend = '\\0';\n";
3141         pr "      pend++;\n";
3142         pr "    }\n";
3143         pr "\n";
3144         pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
3145         pr "      p++;\n";
3146         pr "\n";
3147         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
3148         pr "      p = pend;\n";
3149         pr "      continue;\n";
3150         pr "    }\n";
3151         pr "\n";
3152         pr "    /* Allocate some space to store this next entry. */\n";
3153         pr "    newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3154         pr "                sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3155         pr "    if (newp == NULL) {\n";
3156         pr "      reply_with_perror (\"realloc\");\n";
3157         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3158         pr "      free (ret);\n";
3159         pr "      free (out);\n";
3160         pr "      return NULL;\n";
3161         pr "    }\n";
3162         pr "    ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3163         pr "\n";
3164         pr "    /* Tokenize the next entry. */\n";
3165         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3166         pr "    if (r == -1) {\n";
3167         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3168         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3169         pr "      free (ret);\n";
3170         pr "      free (out);\n";
3171         pr "      return NULL;\n";
3172         pr "    }\n";
3173         pr "\n";
3174         pr "    ++i;\n";
3175         pr "    p = pend;\n";
3176         pr "  }\n";
3177         pr "\n";
3178         pr "  ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3179         pr "\n";
3180         pr "  free (out);\n";
3181         pr "  return ret;\n";
3182         pr "}\n"
3183
3184   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3185
3186 (* Generate the tests. *)
3187 and generate_tests () =
3188   generate_header CStyle GPLv2;
3189
3190   pr "\
3191 #include <stdio.h>
3192 #include <stdlib.h>
3193 #include <string.h>
3194 #include <unistd.h>
3195 #include <sys/types.h>
3196 #include <fcntl.h>
3197
3198 #include \"guestfs.h\"
3199
3200 static guestfs_h *g;
3201 static int suppress_error = 0;
3202
3203 static void print_error (guestfs_h *g, void *data, const char *msg)
3204 {
3205   if (!suppress_error)
3206     fprintf (stderr, \"%%s\\n\", msg);
3207 }
3208
3209 static void print_strings (char * const * const argv)
3210 {
3211   int argc;
3212
3213   for (argc = 0; argv[argc] != NULL; ++argc)
3214     printf (\"\\t%%s\\n\", argv[argc]);
3215 }
3216
3217 /*
3218 static void print_table (char * const * const argv)
3219 {
3220   int i;
3221
3222   for (i = 0; argv[i] != NULL; i += 2)
3223     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3224 }
3225 */
3226
3227 static void no_test_warnings (void)
3228 {
3229 ";
3230
3231   List.iter (
3232     function
3233     | name, _, _, _, [], _, _ ->
3234         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3235     | name, _, _, _, tests, _, _ -> ()
3236   ) all_functions;
3237
3238   pr "}\n";
3239   pr "\n";
3240
3241   (* Generate the actual tests.  Note that we generate the tests
3242    * in reverse order, deliberately, so that (in general) the
3243    * newest tests run first.  This makes it quicker and easier to
3244    * debug them.
3245    *)
3246   let test_names =
3247     List.map (
3248       fun (name, _, _, _, tests, _, _) ->
3249         mapi (generate_one_test name) tests
3250     ) (List.rev all_functions) in
3251   let test_names = List.concat test_names in
3252   let nr_tests = List.length test_names in
3253
3254   pr "\
3255 int main (int argc, char *argv[])
3256 {
3257   char c = 0;
3258   int failed = 0;
3259   const char *srcdir;
3260   const char *filename;
3261   int fd;
3262   int nr_tests, test_num = 0;
3263
3264   no_test_warnings ();
3265
3266   g = guestfs_create ();
3267   if (g == NULL) {
3268     printf (\"guestfs_create FAILED\\n\");
3269     exit (1);
3270   }
3271
3272   guestfs_set_error_handler (g, print_error, NULL);
3273
3274   srcdir = getenv (\"srcdir\");
3275   if (!srcdir) srcdir = \".\";
3276   chdir (srcdir);
3277   guestfs_set_path (g, \".\");
3278
3279   filename = \"test1.img\";
3280   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3281   if (fd == -1) {
3282     perror (filename);
3283     exit (1);
3284   }
3285   if (lseek (fd, %d, SEEK_SET) == -1) {
3286     perror (\"lseek\");
3287     close (fd);
3288     unlink (filename);
3289     exit (1);
3290   }
3291   if (write (fd, &c, 1) == -1) {
3292     perror (\"write\");
3293     close (fd);
3294     unlink (filename);
3295     exit (1);
3296   }
3297   if (close (fd) == -1) {
3298     perror (filename);
3299     unlink (filename);
3300     exit (1);
3301   }
3302   if (guestfs_add_drive (g, filename) == -1) {
3303     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3304     exit (1);
3305   }
3306
3307   filename = \"test2.img\";
3308   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3309   if (fd == -1) {
3310     perror (filename);
3311     exit (1);
3312   }
3313   if (lseek (fd, %d, SEEK_SET) == -1) {
3314     perror (\"lseek\");
3315     close (fd);
3316     unlink (filename);
3317     exit (1);
3318   }
3319   if (write (fd, &c, 1) == -1) {
3320     perror (\"write\");
3321     close (fd);
3322     unlink (filename);
3323     exit (1);
3324   }
3325   if (close (fd) == -1) {
3326     perror (filename);
3327     unlink (filename);
3328     exit (1);
3329   }
3330   if (guestfs_add_drive (g, filename) == -1) {
3331     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3332     exit (1);
3333   }
3334
3335   filename = \"test3.img\";
3336   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3337   if (fd == -1) {
3338     perror (filename);
3339     exit (1);
3340   }
3341   if (lseek (fd, %d, SEEK_SET) == -1) {
3342     perror (\"lseek\");
3343     close (fd);
3344     unlink (filename);
3345     exit (1);
3346   }
3347   if (write (fd, &c, 1) == -1) {
3348     perror (\"write\");
3349     close (fd);
3350     unlink (filename);
3351     exit (1);
3352   }
3353   if (close (fd) == -1) {
3354     perror (filename);
3355     unlink (filename);
3356     exit (1);
3357   }
3358   if (guestfs_add_drive (g, filename) == -1) {
3359     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3360     exit (1);
3361   }
3362
3363   if (guestfs_launch (g) == -1) {
3364     printf (\"guestfs_launch FAILED\\n\");
3365     exit (1);
3366   }
3367   if (guestfs_wait_ready (g) == -1) {
3368     printf (\"guestfs_wait_ready FAILED\\n\");
3369     exit (1);
3370   }
3371
3372   nr_tests = %d;
3373
3374 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3375
3376   iteri (
3377     fun i test_name ->
3378       pr "  test_num++;\n";
3379       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3380       pr "  if (%s () == -1) {\n" test_name;
3381       pr "    printf (\"%s FAILED\\n\");\n" test_name;
3382       pr "    failed++;\n";
3383       pr "  }\n";
3384   ) test_names;
3385   pr "\n";
3386
3387   pr "  guestfs_close (g);\n";
3388   pr "  unlink (\"test1.img\");\n";
3389   pr "  unlink (\"test2.img\");\n";
3390   pr "  unlink (\"test3.img\");\n";
3391   pr "\n";
3392
3393   pr "  if (failed > 0) {\n";
3394   pr "    printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3395   pr "    exit (1);\n";
3396   pr "  }\n";
3397   pr "\n";
3398
3399   pr "  exit (0);\n";
3400   pr "}\n"
3401
3402 and generate_one_test name i (init, test) =
3403   let test_name = sprintf "test_%s_%d" name i in
3404
3405   pr "static int %s (void)\n" test_name;
3406   pr "{\n";
3407
3408   (match init with
3409    | InitNone -> ()
3410    | InitEmpty ->
3411        pr "  /* InitEmpty for %s (%d) */\n" name i;
3412        List.iter (generate_test_command_call test_name)
3413          [["umount_all"];
3414           ["lvm_remove_all"]]
3415    | InitBasicFS ->
3416        pr "  /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3417        List.iter (generate_test_command_call test_name)
3418          [["umount_all"];
3419           ["lvm_remove_all"];
3420           ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3421           ["mkfs"; "ext2"; "/dev/sda1"];
3422           ["mount"; "/dev/sda1"; "/"]]
3423    | InitBasicFSonLVM ->
3424        pr "  /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3425          name i;
3426        List.iter (generate_test_command_call test_name)
3427          [["umount_all"];
3428           ["lvm_remove_all"];
3429           ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3430           ["pvcreate"; "/dev/sda1"];
3431           ["vgcreate"; "VG"; "/dev/sda1"];
3432           ["lvcreate"; "LV"; "VG"; "8"];
3433           ["mkfs"; "ext2"; "/dev/VG/LV"];
3434           ["mount"; "/dev/VG/LV"; "/"]]
3435   );
3436
3437   let get_seq_last = function
3438     | [] ->
3439         failwithf "%s: you cannot use [] (empty list) when expecting a command"
3440           test_name
3441     | seq ->
3442         let seq = List.rev seq in
3443         List.rev (List.tl seq), List.hd seq
3444   in
3445
3446   (match test with
3447    | TestRun seq ->
3448        pr "  /* TestRun for %s (%d) */\n" name i;
3449        List.iter (generate_test_command_call test_name) seq
3450    | TestOutput (seq, expected) ->
3451        pr "  /* TestOutput for %s (%d) */\n" name i;
3452        let seq, last = get_seq_last seq in
3453        let test () =
3454          pr "    if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
3455          pr "      fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
3456          pr "      return -1;\n";
3457          pr "    }\n"
3458        in
3459        List.iter (generate_test_command_call test_name) seq;
3460        generate_test_command_call ~test test_name last
3461    | TestOutputList (seq, expected) ->
3462        pr "  /* TestOutputList for %s (%d) */\n" name i;
3463        let seq, last = get_seq_last seq in
3464        let test () =
3465          iteri (
3466            fun i str ->
3467              pr "    if (!r[%d]) {\n" i;
3468              pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3469              pr "      print_strings (r);\n";
3470              pr "      return -1;\n";
3471              pr "    }\n";
3472              pr "    if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
3473              pr "      fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3474              pr "      return -1;\n";
3475              pr "    }\n"
3476          ) expected;
3477          pr "    if (r[%d] != NULL) {\n" (List.length expected);
3478          pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3479            test_name;
3480          pr "      print_strings (r);\n";
3481          pr "      return -1;\n";
3482          pr "    }\n"
3483        in
3484        List.iter (generate_test_command_call test_name) seq;
3485        generate_test_command_call ~test test_name last
3486    | TestOutputInt (seq, expected) ->
3487        pr "  /* TestOutputInt for %s (%d) */\n" name i;
3488        let seq, last = get_seq_last seq in
3489        let test () =
3490          pr "    if (r != %d) {\n" expected;
3491          pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3492            test_name expected;
3493          pr "               (int) r);\n";
3494          pr "      return -1;\n";
3495          pr "    }\n"
3496        in
3497        List.iter (generate_test_command_call test_name) seq;
3498        generate_test_command_call ~test test_name last
3499    | TestOutputTrue seq ->
3500        pr "  /* TestOutputTrue for %s (%d) */\n" name i;
3501        let seq, last = get_seq_last seq in
3502        let test () =
3503          pr "    if (!r) {\n";
3504          pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3505            test_name;
3506          pr "      return -1;\n";
3507          pr "    }\n"
3508        in
3509        List.iter (generate_test_command_call test_name) seq;
3510        generate_test_command_call ~test test_name last
3511    | TestOutputFalse seq ->
3512        pr "  /* TestOutputFalse for %s (%d) */\n" name i;
3513        let seq, last = get_seq_last seq in
3514        let test () =
3515          pr "    if (r) {\n";
3516          pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3517            test_name;
3518          pr "      return -1;\n";
3519          pr "    }\n"
3520        in
3521        List.iter (generate_test_command_call test_name) seq;
3522        generate_test_command_call ~test test_name last
3523    | TestOutputLength (seq, expected) ->
3524        pr "  /* TestOutputLength for %s (%d) */\n" name i;
3525        let seq, last = get_seq_last seq in
3526        let test () =
3527          pr "    int j;\n";
3528          pr "    for (j = 0; j < %d; ++j)\n" expected;
3529          pr "      if (r[j] == NULL) {\n";
3530          pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
3531            test_name;
3532          pr "        print_strings (r);\n";
3533          pr "        return -1;\n";
3534          pr "      }\n";
3535          pr "    if (r[j] != NULL) {\n";
3536          pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
3537            test_name;
3538          pr "      print_strings (r);\n";
3539          pr "      return -1;\n";
3540          pr "    }\n"
3541        in
3542        List.iter (generate_test_command_call test_name) seq;
3543        generate_test_command_call ~test test_name last
3544    | TestOutputStruct (seq, checks) ->
3545        pr "  /* TestOutputStruct for %s (%d) */\n" name i;
3546        let seq, last = get_seq_last seq in
3547        let test () =
3548          List.iter (
3549            function
3550            | CompareWithInt (field, expected) ->
3551                pr "    if (r->%s != %d) {\n" field expected;
3552                pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3553                  test_name field expected;
3554                pr "               (int) r->%s);\n" field;
3555                pr "      return -1;\n";
3556                pr "    }\n"
3557            | CompareWithString (field, expected) ->
3558                pr "    if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3559                pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3560                  test_name field expected;
3561                pr "               r->%s);\n" field;
3562                pr "      return -1;\n";
3563                pr "    }\n"
3564            | CompareFieldsIntEq (field1, field2) ->
3565                pr "    if (r->%s != r->%s) {\n" field1 field2;
3566                pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3567                  test_name field1 field2;
3568                pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
3569                pr "      return -1;\n";
3570                pr "    }\n"
3571            | CompareFieldsStrEq (field1, field2) ->
3572                pr "    if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3573                pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3574                  test_name field1 field2;
3575                pr "               r->%s, r->%s);\n" field1 field2;
3576                pr "      return -1;\n";
3577                pr "    }\n"
3578          ) checks
3579        in
3580        List.iter (generate_test_command_call test_name) seq;
3581        generate_test_command_call ~test test_name last
3582    | TestLastFail seq ->
3583        pr "  /* TestLastFail for %s (%d) */\n" name i;
3584        let seq, last = get_seq_last seq in
3585        List.iter (generate_test_command_call test_name) seq;
3586        generate_test_command_call test_name ~expect_error:true last
3587   );
3588
3589   pr "  return 0;\n";
3590   pr "}\n";
3591   pr "\n";
3592   test_name
3593
3594 (* Generate the code to run a command, leaving the result in 'r'.
3595  * If you expect to get an error then you should set expect_error:true.
3596  *)
3597 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3598   match cmd with
3599   | [] -> assert false
3600   | name :: args ->
3601       (* Look up the command to find out what args/ret it has. *)
3602       let style =
3603         try
3604           let _, style, _, _, _, _, _ =
3605             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3606           style
3607         with Not_found ->
3608           failwithf "%s: in test, command %s was not found" test_name name in
3609
3610       if List.length (snd style) <> List.length args then
3611         failwithf "%s: in test, wrong number of args given to %s"
3612           test_name name;
3613
3614       pr "  {\n";
3615
3616       List.iter (
3617         function
3618         | String _, _
3619         | OptString _, _
3620         | Int _, _
3621         | Bool _, _ -> ()
3622         | FileIn _, _ | FileOut _, _ -> ()
3623         | StringList n, arg ->
3624             pr "    char *%s[] = {\n" n;
3625             let strs = string_split " " arg in
3626             List.iter (
3627               fun str -> pr "      \"%s\",\n" (c_quote str)
3628             ) strs;
3629             pr "      NULL\n";
3630             pr "    };\n";
3631       ) (List.combine (snd style) args);
3632
3633       let error_code =
3634         match fst style with
3635         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
3636         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
3637         | RConstString _ -> pr "    const char *r;\n"; "NULL"
3638         | RString _ -> pr "    char *r;\n"; "NULL"
3639         | RStringList _ | RHashtable _ ->
3640             pr "    char **r;\n";
3641             pr "    int i;\n";
3642             "NULL"
3643         | RIntBool _ ->
3644             pr "    struct guestfs_int_bool *r;\n"; "NULL"
3645         | RPVList _ ->
3646             pr "    struct guestfs_lvm_pv_list *r;\n"; "NULL"
3647         | RVGList _ ->
3648             pr "    struct guestfs_lvm_vg_list *r;\n"; "NULL"
3649         | RLVList _ ->
3650             pr "    struct guestfs_lvm_lv_list *r;\n"; "NULL"
3651         | RStat _ ->
3652             pr "    struct guestfs_stat *r;\n"; "NULL"
3653         | RStatVFS _ ->
3654             pr "    struct guestfs_statvfs *r;\n"; "NULL" in
3655
3656       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
3657       pr "    r = guestfs_%s (g" name;
3658
3659       (* Generate the parameters. *)
3660       List.iter (
3661         function
3662         | String _, arg
3663         | FileIn _, arg | FileOut _, arg ->
3664             pr ", \"%s\"" (c_quote arg)
3665         | OptString _, arg ->
3666             if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3667         | StringList n, _ ->
3668             pr ", %s" n
3669         | Int _, arg ->
3670             let i =
3671               try int_of_string arg
3672               with Failure "int_of_string" ->
3673                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3674             pr ", %d" i
3675         | Bool _, arg ->
3676             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3677       ) (List.combine (snd style) args);
3678
3679       pr ");\n";
3680       if not expect_error then
3681         pr "    if (r == %s)\n" error_code
3682       else
3683         pr "    if (r != %s)\n" error_code;
3684       pr "      return -1;\n";
3685
3686       (* Insert the test code. *)
3687       (match test with
3688        | None -> ()
3689        | Some f -> f ()
3690       );
3691
3692       (match fst style with
3693        | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3694        | RString _ -> pr "    free (r);\n"
3695        | RStringList _ | RHashtable _ ->
3696            pr "    for (i = 0; r[i] != NULL; ++i)\n";
3697            pr "      free (r[i]);\n";
3698            pr "    free (r);\n"
3699        | RIntBool _ ->
3700            pr "    guestfs_free_int_bool (r);\n"
3701        | RPVList _ ->
3702            pr "    guestfs_free_lvm_pv_list (r);\n"
3703        | RVGList _ ->
3704            pr "    guestfs_free_lvm_vg_list (r);\n"
3705        | RLVList _ ->
3706            pr "    guestfs_free_lvm_lv_list (r);\n"
3707        | RStat _ | RStatVFS _ ->
3708            pr "    free (r);\n"
3709       );
3710
3711       pr "  }\n"
3712
3713 and c_quote str =
3714   let str = replace_str str "\r" "\\r" in
3715   let str = replace_str str "\n" "\\n" in
3716   let str = replace_str str "\t" "\\t" in
3717   str
3718
3719 (* Generate a lot of different functions for guestfish. *)
3720 and generate_fish_cmds () =
3721   generate_header CStyle GPLv2;
3722
3723   let all_functions =
3724     List.filter (
3725       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3726     ) all_functions in
3727   let all_functions_sorted =
3728     List.filter (
3729       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3730     ) all_functions_sorted in
3731
3732   pr "#include <stdio.h>\n";
3733   pr "#include <stdlib.h>\n";
3734   pr "#include <string.h>\n";
3735   pr "#include <inttypes.h>\n";
3736   pr "\n";
3737   pr "#include <guestfs.h>\n";
3738   pr "#include \"fish.h\"\n";
3739   pr "\n";
3740
3741   (* list_commands function, which implements guestfish -h *)
3742   pr "void list_commands (void)\n";
3743   pr "{\n";
3744   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
3745   pr "  list_builtin_commands ();\n";
3746   List.iter (
3747     fun (name, _, _, flags, _, shortdesc, _) ->
3748       let name = replace_char name '_' '-' in
3749       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3750         name shortdesc
3751   ) all_functions_sorted;
3752   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3753   pr "}\n";
3754   pr "\n";
3755
3756   (* display_command function, which implements guestfish -h cmd *)
3757   pr "void display_command (const char *cmd)\n";
3758   pr "{\n";
3759   List.iter (
3760     fun (name, style, _, flags, _, shortdesc, longdesc) ->
3761       let name2 = replace_char name '_' '-' in
3762       let alias =
3763         try find_map (function FishAlias n -> Some n | _ -> None) flags
3764         with Not_found -> name in
3765       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3766       let synopsis =
3767         match snd style with
3768         | [] -> name2
3769         | args ->
3770             sprintf "%s <%s>"
3771               name2 (String.concat "> <" (List.map name_of_argt args)) in
3772
3773       let warnings =
3774         if List.mem ProtocolLimitWarning flags then
3775           ("\n\n" ^ protocol_limit_warning)
3776         else "" in
3777
3778       (* For DangerWillRobinson commands, we should probably have
3779        * guestfish prompt before allowing you to use them (especially
3780        * in interactive mode). XXX
3781        *)
3782       let warnings =
3783         warnings ^
3784           if List.mem DangerWillRobinson flags then
3785             ("\n\n" ^ danger_will_robinson)
3786           else "" in
3787
3788       let describe_alias =
3789         if name <> alias then
3790           sprintf "\n\nYou can use '%s' as an alias for this command." alias
3791         else "" in
3792
3793       pr "  if (";
3794       pr "strcasecmp (cmd, \"%s\") == 0" name;
3795       if name <> name2 then
3796         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3797       if name <> alias then
3798         pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3799       pr ")\n";
3800       pr "    pod2text (\"%s - %s\", %S);\n"
3801         name2 shortdesc
3802         (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3803       pr "  else\n"
3804   ) all_functions;
3805   pr "    display_builtin_command (cmd);\n";
3806   pr "}\n";
3807   pr "\n";
3808
3809   (* print_{pv,vg,lv}_list functions *)
3810   List.iter (
3811     function
3812     | typ, cols ->
3813         pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3814         pr "{\n";
3815         pr "  int i;\n";
3816         pr "\n";
3817         List.iter (
3818           function
3819           | name, `String ->
3820               pr "  printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3821           | name, `UUID ->
3822               pr "  printf (\"%s: \");\n" name;
3823               pr "  for (i = 0; i < 32; ++i)\n";
3824               pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
3825               pr "  printf (\"\\n\");\n"
3826           | name, `Bytes ->
3827               pr "  printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3828           | name, `Int ->
3829               pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3830           | name, `OptPercent ->
3831               pr "  if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3832                 typ name name typ name;
3833               pr "  else printf (\"%s: \\n\");\n" name
3834         ) cols;
3835         pr "}\n";
3836         pr "\n";
3837         pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3838           typ typ typ;
3839         pr "{\n";
3840         pr "  int i;\n";
3841         pr "\n";
3842         pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
3843         pr "    print_%s (&%ss->val[i]);\n" typ typ;
3844         pr "}\n";
3845         pr "\n";
3846   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3847
3848   (* print_{stat,statvfs} functions *)
3849   List.iter (
3850     function
3851     | typ, cols ->
3852         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3853         pr "{\n";
3854         List.iter (
3855           function
3856           | name, `Int ->
3857               pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3858         ) cols;
3859         pr "}\n";
3860         pr "\n";
3861   ) ["stat", stat_cols; "statvfs", statvfs_cols];
3862
3863   (* run_<action> actions *)
3864   List.iter (
3865     fun (name, style, _, flags, _, _, _) ->
3866       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3867       pr "{\n";
3868       (match fst style with
3869        | RErr
3870        | RInt _
3871        | RBool _ -> pr "  int r;\n"
3872        | RInt64 _ -> pr "  int64_t r;\n"
3873        | RConstString _ -> pr "  const char *r;\n"
3874        | RString _ -> pr "  char *r;\n"
3875        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
3876        | RIntBool _ -> pr "  struct guestfs_int_bool *r;\n"
3877        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
3878        | RVGList _ -> pr "  struct guestfs_lvm_vg_list *r;\n"
3879        | RLVList _ -> pr "  struct guestfs_lvm_lv_list *r;\n"
3880        | RStat _ -> pr "  struct guestfs_stat *r;\n"
3881        | RStatVFS _ -> pr "  struct guestfs_statvfs *r;\n"
3882       );
3883       List.iter (
3884         function
3885         | String n
3886         | OptString n
3887         | FileIn n
3888         | FileOut n -> pr "  const char *%s;\n" n
3889         | StringList n -> pr "  char **%s;\n" n
3890         | Bool n -> pr "  int %s;\n" n
3891         | Int n -> pr "  int %s;\n" n
3892       ) (snd style);
3893
3894       (* Check and convert parameters. *)
3895       let argc_expected = List.length (snd style) in
3896       pr "  if (argc != %d) {\n" argc_expected;
3897       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3898         argc_expected;
3899       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3900       pr "    return -1;\n";
3901       pr "  }\n";
3902       iteri (
3903         fun i ->
3904           function
3905           | String name -> pr "  %s = argv[%d];\n" name i
3906           | OptString name ->
3907               pr "  %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3908                 name i i
3909           | FileIn name ->
3910               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3911                 name i i
3912           | FileOut name ->
3913               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3914                 name i i
3915           | StringList name ->
3916               pr "  %s = parse_string_list (argv[%d]);\n" name i
3917           | Bool name ->
3918               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3919           | Int name ->
3920               pr "  %s = atoi (argv[%d]);\n" name i
3921       ) (snd style);
3922
3923       (* Call C API function. *)
3924       let fn =
3925         try find_map (function FishAction n -> Some n | _ -> None) flags
3926         with Not_found -> sprintf "guestfs_%s" name in
3927       pr "  r = %s " fn;
3928       generate_call_args ~handle:"g" (snd style);
3929       pr ";\n";
3930
3931       (* Check return value for errors and display command results. *)
3932       (match fst style with
3933        | RErr -> pr "  return r;\n"
3934        | RInt _ ->
3935            pr "  if (r == -1) return -1;\n";
3936            pr "  printf (\"%%d\\n\", r);\n";
3937            pr "  return 0;\n"
3938        | RInt64 _ ->
3939            pr "  if (r == -1) return -1;\n";
3940            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
3941            pr "  return 0;\n"
3942        | RBool _ ->
3943            pr "  if (r == -1) return -1;\n";
3944            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3945            pr "  return 0;\n"
3946        | RConstString _ ->
3947            pr "  if (r == NULL) return -1;\n";
3948            pr "  printf (\"%%s\\n\", r);\n";
3949            pr "  return 0;\n"
3950        | RString _ ->
3951            pr "  if (r == NULL) return -1;\n";
3952            pr "  printf (\"%%s\\n\", r);\n";
3953            pr "  free (r);\n";
3954            pr "  return 0;\n"
3955        | RStringList _ ->
3956            pr "  if (r == NULL) return -1;\n";
3957            pr "  print_strings (r);\n";
3958            pr "  free_strings (r);\n";
3959            pr "  return 0;\n"
3960        | RIntBool _ ->
3961            pr "  if (r == NULL) return -1;\n";
3962            pr "  printf (\"%%d, %%s\\n\", r->i,\n";
3963            pr "    r->b ? \"true\" : \"false\");\n";
3964            pr "  guestfs_free_int_bool (r);\n";
3965            pr "  return 0;\n"
3966        | RPVList _ ->
3967            pr "  if (r == NULL) return -1;\n";
3968            pr "  print_pv_list (r);\n";
3969            pr "  guestfs_free_lvm_pv_list (r);\n";
3970            pr "  return 0;\n"
3971        | RVGList _ ->
3972            pr "  if (r == NULL) return -1;\n";
3973            pr "  print_vg_list (r);\n";
3974            pr "  guestfs_free_lvm_vg_list (r);\n";
3975            pr "  return 0;\n"
3976        | RLVList _ ->
3977            pr "  if (r == NULL) return -1;\n";
3978            pr "  print_lv_list (r);\n";
3979            pr "  guestfs_free_lvm_lv_list (r);\n";
3980            pr "  return 0;\n"
3981        | RStat _ ->
3982            pr "  if (r == NULL) return -1;\n";
3983            pr "  print_stat (r);\n";
3984            pr "  free (r);\n";
3985            pr "  return 0;\n"
3986        | RStatVFS _ ->
3987            pr "  if (r == NULL) return -1;\n";
3988            pr "  print_statvfs (r);\n";
3989            pr "  free (r);\n";
3990            pr "  return 0;\n"
3991        | RHashtable _ ->
3992            pr "  if (r == NULL) return -1;\n";
3993            pr "  print_table (r);\n";
3994            pr "  free_strings (r);\n";
3995            pr "  return 0;\n"
3996       );
3997       pr "}\n";
3998       pr "\n"
3999   ) all_functions;
4000
4001   (* run_action function *)
4002   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
4003   pr "{\n";
4004   List.iter (
4005     fun (name, _, _, flags, _, _, _) ->
4006       let name2 = replace_char name '_' '-' in
4007       let alias =
4008         try find_map (function FishAlias n -> Some n | _ -> None) flags
4009         with Not_found -> name in
4010       pr "  if (";
4011       pr "strcasecmp (cmd, \"%s\") == 0" name;
4012       if name <> name2 then
4013         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4014       if name <> alias then
4015         pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4016       pr ")\n";
4017       pr "    return run_%s (cmd, argc, argv);\n" name;
4018       pr "  else\n";
4019   ) all_functions;
4020   pr "    {\n";
4021   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
4022   pr "      return -1;\n";
4023   pr "    }\n";
4024   pr "  return 0;\n";
4025   pr "}\n";
4026   pr "\n"
4027
4028 (* Readline completion for guestfish. *)
4029 and generate_fish_completion () =
4030   generate_header CStyle GPLv2;
4031
4032   let all_functions =
4033     List.filter (
4034       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4035     ) all_functions in
4036
4037   pr "\
4038 #include <config.h>
4039
4040 #include <stdio.h>
4041 #include <stdlib.h>
4042 #include <string.h>
4043
4044 #ifdef HAVE_LIBREADLINE
4045 #include <readline/readline.h>
4046 #endif
4047
4048 #include \"fish.h\"
4049
4050 #ifdef HAVE_LIBREADLINE
4051
4052 static const char *const commands[] = {
4053 ";
4054
4055   (* Get the commands and sort them, including the aliases. *)
4056   let commands =
4057     List.map (
4058       fun (name, _, _, flags, _, _, _) ->
4059         let name2 = replace_char name '_' '-' in
4060         let alias =
4061           try find_map (function FishAlias n -> Some n | _ -> None) flags
4062           with Not_found -> name in
4063
4064         if name <> alias then [name2; alias] else [name2]
4065     ) all_functions in
4066   let commands = List.flatten commands in
4067   let commands = List.sort compare commands in
4068
4069   List.iter (pr "  \"%s\",\n") commands;
4070
4071   pr "  NULL
4072 };
4073
4074 static char *
4075 generator (const char *text, int state)
4076 {
4077   static int index, len;
4078   const char *name;
4079
4080   if (!state) {
4081     index = 0;
4082     len = strlen (text);
4083   }
4084
4085   while ((name = commands[index]) != NULL) {
4086     index++;
4087     if (strncasecmp (name, text, len) == 0)
4088       return strdup (name);
4089   }
4090
4091   return NULL;
4092 }
4093
4094 #endif /* HAVE_LIBREADLINE */
4095
4096 char **do_completion (const char *text, int start, int end)
4097 {
4098   char **matches = NULL;
4099
4100 #ifdef HAVE_LIBREADLINE
4101   if (start == 0)
4102     matches = rl_completion_matches (text, generator);
4103 #endif
4104
4105   return matches;
4106 }
4107 ";
4108
4109 (* Generate the POD documentation for guestfish. *)
4110 and generate_fish_actions_pod () =
4111   let all_functions_sorted =
4112     List.filter (
4113       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4114     ) all_functions_sorted in
4115
4116   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
4117
4118   List.iter (
4119     fun (name, style, _, flags, _, _, longdesc) ->
4120       let longdesc =
4121         Str.global_substitute rex (
4122           fun s ->
4123             let sub =
4124               try Str.matched_group 1 s
4125               with Not_found ->
4126                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
4127             "C<" ^ replace_char sub '_' '-' ^ ">"
4128         ) longdesc in
4129       let name = replace_char name '_' '-' in
4130       let alias =
4131         try find_map (function FishAlias n -> Some n | _ -> None) flags
4132         with Not_found -> name in
4133
4134       pr "=head2 %s" name;
4135       if name <> alias then
4136         pr " | %s" alias;
4137       pr "\n";
4138       pr "\n";
4139       pr " %s" name;
4140       List.iter (
4141         function
4142         | String n -> pr " %s" n
4143         | OptString n -> pr " %s" n
4144         | StringList n -> pr " '%s ...'" n
4145         | Bool _ -> pr " true|false"
4146         | Int n -> pr " %s" n
4147         | FileIn n | FileOut n -> pr " (%s|-)" n
4148       ) (snd style);
4149       pr "\n";
4150       pr "\n";
4151       pr "%s\n\n" longdesc;
4152
4153       if List.exists (function FileIn _ | FileOut _ -> true
4154                       | _ -> false) (snd style) then
4155         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
4156
4157       if List.mem ProtocolLimitWarning flags then
4158         pr "%s\n\n" protocol_limit_warning;
4159
4160       if List.mem DangerWillRobinson flags then
4161         pr "%s\n\n" danger_will_robinson
4162   ) all_functions_sorted
4163
4164 (* Generate a C function prototype. *)
4165 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
4166     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
4167     ?(prefix = "")
4168     ?handle name style =
4169   if extern then pr "extern ";
4170   if static then pr "static ";
4171   (match fst style with
4172    | RErr -> pr "int "
4173    | RInt _ -> pr "int "
4174    | RInt64 _ -> pr "int64_t "
4175    | RBool _ -> pr "int "
4176    | RConstString _ -> pr "const char *"
4177    | RString _ -> pr "char *"
4178    | RStringList _ | RHashtable _ -> pr "char **"
4179    | RIntBool _ ->
4180        if not in_daemon then pr "struct guestfs_int_bool *"
4181        else pr "guestfs_%s_ret *" name
4182    | RPVList _ ->
4183        if not in_daemon then pr "struct guestfs_lvm_pv_list *"
4184        else pr "guestfs_lvm_int_pv_list *"
4185    | RVGList _ ->
4186        if not in_daemon then pr "struct guestfs_lvm_vg_list *"
4187        else pr "guestfs_lvm_int_vg_list *"
4188    | RLVList _ ->
4189        if not in_daemon then pr "struct guestfs_lvm_lv_list *"
4190        else pr "guestfs_lvm_int_lv_list *"
4191    | RStat _ ->
4192        if not in_daemon then pr "struct guestfs_stat *"
4193        else pr "guestfs_int_stat *"
4194    | RStatVFS _ ->
4195        if not in_daemon then pr "struct guestfs_statvfs *"
4196        else pr "guestfs_int_statvfs *"
4197   );
4198   pr "%s%s (" prefix name;
4199   if handle = None && List.length (snd style) = 0 then
4200     pr "void"
4201   else (
4202     let comma = ref false in
4203     (match handle with
4204      | None -> ()
4205      | Some handle -> pr "guestfs_h *%s" handle; comma := true
4206     );
4207     let next () =
4208       if !comma then (
4209         if single_line then pr ", " else pr ",\n\t\t"
4210       );
4211       comma := true
4212     in
4213     List.iter (
4214       function
4215       | String n
4216       | OptString n -> next (); pr "const char *%s" n
4217       | StringList n -> next (); pr "char * const* const %s" n
4218       | Bool n -> next (); pr "int %s" n
4219       | Int n -> next (); pr "int %s" n
4220       | FileIn n
4221       | FileOut n ->
4222           if not in_daemon then (next (); pr "const char *%s" n)
4223     ) (snd style);
4224   );
4225   pr ")";
4226   if semicolon then pr ";";
4227   if newline then pr "\n"
4228
4229 (* Generate C call arguments, eg "(handle, foo, bar)" *)
4230 and generate_call_args ?handle args =
4231   pr "(";
4232   let comma = ref false in
4233   (match handle with
4234    | None -> ()
4235    | Some handle -> pr "%s" handle; comma := true
4236   );
4237   List.iter (
4238     fun arg ->
4239       if !comma then pr ", ";
4240       comma := true;
4241       pr "%s" (name_of_argt arg)
4242   ) args;
4243   pr ")"
4244
4245 (* Generate the OCaml bindings interface. *)
4246 and generate_ocaml_mli () =
4247   generate_header OCamlStyle LGPLv2;
4248
4249   pr "\
4250 (** For API documentation you should refer to the C API
4251     in the guestfs(3) manual page.  The OCaml API uses almost
4252     exactly the same calls. *)
4253
4254 type t
4255 (** A [guestfs_h] handle. *)
4256
4257 exception Error of string
4258 (** This exception is raised when there is an error. *)
4259
4260 val create : unit -> t
4261
4262 val close : t -> unit
4263 (** Handles are closed by the garbage collector when they become
4264     unreferenced, but callers can also call this in order to
4265     provide predictable cleanup. *)
4266
4267 ";
4268   generate_ocaml_lvm_structure_decls ();
4269
4270   generate_ocaml_stat_structure_decls ();
4271
4272   (* The actions. *)
4273   List.iter (
4274     fun (name, style, _, _, _, shortdesc, _) ->
4275       generate_ocaml_prototype name style;
4276       pr "(** %s *)\n" shortdesc;
4277       pr "\n"
4278   ) all_functions
4279
4280 (* Generate the OCaml bindings implementation. *)
4281 and generate_ocaml_ml () =
4282   generate_header OCamlStyle LGPLv2;
4283
4284   pr "\
4285 type t
4286 exception Error of string
4287 external create : unit -> t = \"ocaml_guestfs_create\"
4288 external close : t -> unit = \"ocaml_guestfs_close\"
4289
4290 let () =
4291   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
4292
4293 ";
4294
4295   generate_ocaml_lvm_structure_decls ();
4296
4297