Added ping-daemon command.
[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   ("dmesg", (RString "kmsgs", []), 91, [],
1756    [InitEmpty, TestRun (
1757       [["dmesg"]])],
1758    "return kernel messages",
1759    "\
1760 This returns the kernel messages (C<dmesg> output) from
1761 the guest kernel.  This is sometimes useful for extended
1762 debugging of problems.
1763
1764 Another way to get the same information is to enable
1765 verbose messages with C<guestfs_set_verbose> or by setting
1766 the environment variable C<LIBGUESTFS_DEBUG=1> before
1767 running the program.");
1768
1769   ("ping_daemon", (RErr, []), 92, [],
1770    [InitEmpty, TestRun (
1771       [["ping_daemon"]])],
1772    "ping the guest daemon",
1773    "\
1774 This is a test probe into the guestfs daemon running inside
1775 the qemu subprocess.  Calling this function checks that the
1776 daemon responds to the ping message, without affecting the daemon
1777 or attached block device(s) in any other way.");
1778
1779 ]
1780
1781 let all_functions = non_daemon_functions @ daemon_functions
1782
1783 (* In some places we want the functions to be displayed sorted
1784  * alphabetically, so this is useful:
1785  *)
1786 let all_functions_sorted =
1787   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1788                compare n1 n2) all_functions
1789
1790 (* Column names and types from LVM PVs/VGs/LVs. *)
1791 let pv_cols = [
1792   "pv_name", `String;
1793   "pv_uuid", `UUID;
1794   "pv_fmt", `String;
1795   "pv_size", `Bytes;
1796   "dev_size", `Bytes;
1797   "pv_free", `Bytes;
1798   "pv_used", `Bytes;
1799   "pv_attr", `String (* XXX *);
1800   "pv_pe_count", `Int;
1801   "pv_pe_alloc_count", `Int;
1802   "pv_tags", `String;
1803   "pe_start", `Bytes;
1804   "pv_mda_count", `Int;
1805   "pv_mda_free", `Bytes;
1806 (* Not in Fedora 10:
1807   "pv_mda_size", `Bytes;
1808 *)
1809 ]
1810 let vg_cols = [
1811   "vg_name", `String;
1812   "vg_uuid", `UUID;
1813   "vg_fmt", `String;
1814   "vg_attr", `String (* XXX *);
1815   "vg_size", `Bytes;
1816   "vg_free", `Bytes;
1817   "vg_sysid", `String;
1818   "vg_extent_size", `Bytes;
1819   "vg_extent_count", `Int;
1820   "vg_free_count", `Int;
1821   "max_lv", `Int;
1822   "max_pv", `Int;
1823   "pv_count", `Int;
1824   "lv_count", `Int;
1825   "snap_count", `Int;
1826   "vg_seqno", `Int;
1827   "vg_tags", `String;
1828   "vg_mda_count", `Int;
1829   "vg_mda_free", `Bytes;
1830 (* Not in Fedora 10:
1831   "vg_mda_size", `Bytes;
1832 *)
1833 ]
1834 let lv_cols = [
1835   "lv_name", `String;
1836   "lv_uuid", `UUID;
1837   "lv_attr", `String (* XXX *);
1838   "lv_major", `Int;
1839   "lv_minor", `Int;
1840   "lv_kernel_major", `Int;
1841   "lv_kernel_minor", `Int;
1842   "lv_size", `Bytes;
1843   "seg_count", `Int;
1844   "origin", `String;
1845   "snap_percent", `OptPercent;
1846   "copy_percent", `OptPercent;
1847   "move_pv", `String;
1848   "lv_tags", `String;
1849   "mirror_log", `String;
1850   "modules", `String;
1851 ]
1852
1853 (* Column names and types from stat structures.
1854  * NB. Can't use things like 'st_atime' because glibc header files
1855  * define some of these as macros.  Ugh.
1856  *)
1857 let stat_cols = [
1858   "dev", `Int;
1859   "ino", `Int;
1860   "mode", `Int;
1861   "nlink", `Int;
1862   "uid", `Int;
1863   "gid", `Int;
1864   "rdev", `Int;
1865   "size", `Int;
1866   "blksize", `Int;
1867   "blocks", `Int;
1868   "atime", `Int;
1869   "mtime", `Int;
1870   "ctime", `Int;
1871 ]
1872 let statvfs_cols = [
1873   "bsize", `Int;
1874   "frsize", `Int;
1875   "blocks", `Int;
1876   "bfree", `Int;
1877   "bavail", `Int;
1878   "files", `Int;
1879   "ffree", `Int;
1880   "favail", `Int;
1881   "fsid", `Int;
1882   "flag", `Int;
1883   "namemax", `Int;
1884 ]
1885
1886 (* Useful functions.
1887  * Note we don't want to use any external OCaml libraries which
1888  * makes this a bit harder than it should be.
1889  *)
1890 let failwithf fs = ksprintf failwith fs
1891
1892 let replace_char s c1 c2 =
1893   let s2 = String.copy s in
1894   let r = ref false in
1895   for i = 0 to String.length s2 - 1 do
1896     if String.unsafe_get s2 i = c1 then (
1897       String.unsafe_set s2 i c2;
1898       r := true
1899     )
1900   done;
1901   if not !r then s else s2
1902
1903 let isspace c =
1904   c = ' '
1905   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1906
1907 let triml ?(test = isspace) str =
1908   let i = ref 0 in
1909   let n = ref (String.length str) in
1910   while !n > 0 && test str.[!i]; do
1911     decr n;
1912     incr i
1913   done;
1914   if !i = 0 then str
1915   else String.sub str !i !n
1916
1917 let trimr ?(test = isspace) str =
1918   let n = ref (String.length str) in
1919   while !n > 0 && test str.[!n-1]; do
1920     decr n
1921   done;
1922   if !n = String.length str then str
1923   else String.sub str 0 !n
1924
1925 let trim ?(test = isspace) str =
1926   trimr ~test (triml ~test str)
1927
1928 let rec find s sub =
1929   let len = String.length s in
1930   let sublen = String.length sub in
1931   let rec loop i =
1932     if i <= len-sublen then (
1933       let rec loop2 j =
1934         if j < sublen then (
1935           if s.[i+j] = sub.[j] then loop2 (j+1)
1936           else -1
1937         ) else
1938           i (* found *)
1939       in
1940       let r = loop2 0 in
1941       if r = -1 then loop (i+1) else r
1942     ) else
1943       -1 (* not found *)
1944   in
1945   loop 0
1946
1947 let rec replace_str s s1 s2 =
1948   let len = String.length s in
1949   let sublen = String.length s1 in
1950   let i = find s s1 in
1951   if i = -1 then s
1952   else (
1953     let s' = String.sub s 0 i in
1954     let s'' = String.sub s (i+sublen) (len-i-sublen) in
1955     s' ^ s2 ^ replace_str s'' s1 s2
1956   )
1957
1958 let rec string_split sep str =
1959   let len = String.length str in
1960   let seplen = String.length sep in
1961   let i = find str sep in
1962   if i = -1 then [str]
1963   else (
1964     let s' = String.sub str 0 i in
1965     let s'' = String.sub str (i+seplen) (len-i-seplen) in
1966     s' :: string_split sep s''
1967   )
1968
1969 let files_equal n1 n2 =
1970   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
1971   match Sys.command cmd with
1972   | 0 -> true
1973   | 1 -> false
1974   | i -> failwithf "%s: failed with error code %d" cmd i
1975
1976 let rec find_map f = function
1977   | [] -> raise Not_found
1978   | x :: xs ->
1979       match f x with
1980       | Some y -> y
1981       | None -> find_map f xs
1982
1983 let iteri f xs =
1984   let rec loop i = function
1985     | [] -> ()
1986     | x :: xs -> f i x; loop (i+1) xs
1987   in
1988   loop 0 xs
1989
1990 let mapi f xs =
1991   let rec loop i = function
1992     | [] -> []
1993     | x :: xs -> let r = f i x in r :: loop (i+1) xs
1994   in
1995   loop 0 xs
1996
1997 let name_of_argt = function
1998   | String n | OptString n | StringList n | Bool n | Int n
1999   | FileIn n | FileOut n -> n
2000
2001 let seq_of_test = function
2002   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
2003   | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
2004   | TestOutputLength (s, _) | TestOutputStruct (s, _)
2005   | TestLastFail s -> s
2006
2007 (* Check function names etc. for consistency. *)
2008 let check_functions () =
2009   let contains_uppercase str =
2010     let len = String.length str in
2011     let rec loop i =
2012       if i >= len then false
2013       else (
2014         let c = str.[i] in
2015         if c >= 'A' && c <= 'Z' then true
2016         else loop (i+1)
2017       )
2018     in
2019     loop 0
2020   in
2021
2022   (* Check function names. *)
2023   List.iter (
2024     fun (name, _, _, _, _, _, _) ->
2025       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2026         failwithf "function name %s does not need 'guestfs' prefix" name;
2027       if contains_uppercase name then
2028         failwithf "function name %s should not contain uppercase chars" name;
2029       if String.contains name '-' then
2030         failwithf "function name %s should not contain '-', use '_' instead."
2031           name
2032   ) all_functions;
2033
2034   (* Check function parameter/return names. *)
2035   List.iter (
2036     fun (name, style, _, _, _, _, _) ->
2037       let check_arg_ret_name n =
2038         if contains_uppercase n then
2039           failwithf "%s param/ret %s should not contain uppercase chars"
2040             name n;
2041         if String.contains n '-' || String.contains n '_' then
2042           failwithf "%s param/ret %s should not contain '-' or '_'"
2043             name n;
2044         if n = "value" then
2045           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;
2046         if n = "argv" || n = "args" then
2047           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
2048       in
2049
2050       (match fst style with
2051        | RErr -> ()
2052        | RInt n | RInt64 n | RBool n | RConstString n | RString n
2053        | RStringList n | RPVList n | RVGList n | RLVList n
2054        | RStat n | RStatVFS n
2055        | RHashtable n ->
2056            check_arg_ret_name n
2057        | RIntBool (n,m) ->
2058            check_arg_ret_name n;
2059            check_arg_ret_name m
2060       );
2061       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2062   ) all_functions;
2063
2064   (* Check short descriptions. *)
2065   List.iter (
2066     fun (name, _, _, _, _, shortdesc, _) ->
2067       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2068         failwithf "short description of %s should begin with lowercase." name;
2069       let c = shortdesc.[String.length shortdesc-1] in
2070       if c = '\n' || c = '.' then
2071         failwithf "short description of %s should not end with . or \\n." name
2072   ) all_functions;
2073
2074   (* Check long dscriptions. *)
2075   List.iter (
2076     fun (name, _, _, _, _, _, longdesc) ->
2077       if longdesc.[String.length longdesc-1] = '\n' then
2078         failwithf "long description of %s should not end with \\n." name
2079   ) all_functions;
2080
2081   (* Check proc_nrs. *)
2082   List.iter (
2083     fun (name, _, proc_nr, _, _, _, _) ->
2084       if proc_nr <= 0 then
2085         failwithf "daemon function %s should have proc_nr > 0" name
2086   ) daemon_functions;
2087
2088   List.iter (
2089     fun (name, _, proc_nr, _, _, _, _) ->
2090       if proc_nr <> -1 then
2091         failwithf "non-daemon function %s should have proc_nr -1" name
2092   ) non_daemon_functions;
2093
2094   let proc_nrs =
2095     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2096       daemon_functions in
2097   let proc_nrs =
2098     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2099   let rec loop = function
2100     | [] -> ()
2101     | [_] -> ()
2102     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2103         loop rest
2104     | (name1,nr1) :: (name2,nr2) :: _ ->
2105         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2106           name1 name2 nr1 nr2
2107   in
2108   loop proc_nrs;
2109
2110   (* Check tests. *)
2111   List.iter (
2112     function
2113       (* Ignore functions that have no tests.  We generate a
2114        * warning when the user does 'make check' instead.
2115        *)
2116     | name, _, _, _, [], _, _ -> ()
2117     | name, _, _, _, tests, _, _ ->
2118         let funcs =
2119           List.map (
2120             fun (_, test) ->
2121               match seq_of_test test with
2122               | [] ->
2123                   failwithf "%s has a test containing an empty sequence" name
2124               | cmds -> List.map List.hd cmds
2125           ) tests in
2126         let funcs = List.flatten funcs in
2127
2128         let tested = List.mem name funcs in
2129
2130         if not tested then
2131           failwithf "function %s has tests but does not test itself" name
2132   ) all_functions
2133
2134 (* 'pr' prints to the current output file. *)
2135 let chan = ref stdout
2136 let pr fs = ksprintf (output_string !chan) fs
2137
2138 (* Generate a header block in a number of standard styles. *)
2139 type comment_style = CStyle | HashStyle | OCamlStyle
2140 type license = GPLv2 | LGPLv2
2141
2142 let generate_header comment license =
2143   let c = match comment with
2144     | CStyle ->     pr "/* "; " *"
2145     | HashStyle ->  pr "# ";  "#"
2146     | OCamlStyle -> pr "(* "; " *" in
2147   pr "libguestfs generated file\n";
2148   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2149   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2150   pr "%s\n" c;
2151   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2152   pr "%s\n" c;
2153   (match license with
2154    | GPLv2 ->
2155        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2156        pr "%s it under the terms of the GNU General Public License as published by\n" c;
2157        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2158        pr "%s (at your option) any later version.\n" c;
2159        pr "%s\n" c;
2160        pr "%s This program is distributed in the hope that it will be useful,\n" c;
2161        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2162        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
2163        pr "%s GNU General Public License for more details.\n" c;
2164        pr "%s\n" c;
2165        pr "%s You should have received a copy of the GNU General Public License along\n" c;
2166        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2167        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2168
2169    | LGPLv2 ->
2170        pr "%s This library is free software; you can redistribute it and/or\n" c;
2171        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2172        pr "%s License as published by the Free Software Foundation; either\n" c;
2173        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2174        pr "%s\n" c;
2175        pr "%s This library is distributed in the hope that it will be useful,\n" c;
2176        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2177        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
2178        pr "%s Lesser General Public License for more details.\n" c;
2179        pr "%s\n" c;
2180        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2181        pr "%s License along with this library; if not, write to the Free Software\n" c;
2182        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2183   );
2184   (match comment with
2185    | CStyle -> pr " */\n"
2186    | HashStyle -> ()
2187    | OCamlStyle -> pr " *)\n"
2188   );
2189   pr "\n"
2190
2191 (* Start of main code generation functions below this line. *)
2192
2193 (* Generate the pod documentation for the C API. *)
2194 let rec generate_actions_pod () =
2195   List.iter (
2196     fun (shortname, style, _, flags, _, _, longdesc) ->
2197       let name = "guestfs_" ^ shortname in
2198       pr "=head2 %s\n\n" name;
2199       pr " ";
2200       generate_prototype ~extern:false ~handle:"handle" name style;
2201       pr "\n\n";
2202       pr "%s\n\n" longdesc;
2203       (match fst style with
2204        | RErr ->
2205            pr "This function returns 0 on success or -1 on error.\n\n"
2206        | RInt _ ->
2207            pr "On error this function returns -1.\n\n"
2208        | RInt64 _ ->
2209            pr "On error this function returns -1.\n\n"
2210        | RBool _ ->
2211            pr "This function returns a C truth value on success or -1 on error.\n\n"
2212        | RConstString _ ->
2213            pr "This function returns a string, or NULL on error.
2214 The string is owned by the guest handle and must I<not> be freed.\n\n"
2215        | RString _ ->
2216            pr "This function returns a string, or NULL on error.
2217 I<The caller must free the returned string after use>.\n\n"
2218        | RStringList _ ->
2219            pr "This function returns a NULL-terminated array of strings
2220 (like L<environ(3)>), or NULL if there was an error.
2221 I<The caller must free the strings and the array after use>.\n\n"
2222        | RIntBool _ ->
2223            pr "This function returns a C<struct guestfs_int_bool *>,
2224 or NULL if there was an error.
2225 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2226        | RPVList _ ->
2227            pr "This function returns a C<struct guestfs_lvm_pv_list *>
2228 (see E<lt>guestfs-structs.hE<gt>),
2229 or NULL if there was an error.
2230 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2231        | RVGList _ ->
2232            pr "This function returns a C<struct guestfs_lvm_vg_list *>
2233 (see E<lt>guestfs-structs.hE<gt>),
2234 or NULL if there was an error.
2235 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2236        | RLVList _ ->
2237            pr "This function returns a C<struct guestfs_lvm_lv_list *>
2238 (see E<lt>guestfs-structs.hE<gt>),
2239 or NULL if there was an error.
2240 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2241        | RStat _ ->
2242            pr "This function returns a C<struct guestfs_stat *>
2243 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2244 or NULL if there was an error.
2245 I<The caller must call C<free> after use>.\n\n"
2246        | RStatVFS _ ->
2247            pr "This function returns a C<struct guestfs_statvfs *>
2248 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2249 or NULL if there was an error.
2250 I<The caller must call C<free> after use>.\n\n"
2251        | RHashtable _ ->
2252            pr "This function returns a NULL-terminated array of
2253 strings, or NULL if there was an error.
2254 The array of strings will always have length C<2n+1>, where
2255 C<n> keys and values alternate, followed by the trailing NULL entry.
2256 I<The caller must free the strings and the array after use>.\n\n"
2257       );
2258       if List.mem ProtocolLimitWarning flags then
2259         pr "%s\n\n" protocol_limit_warning;
2260       if List.mem DangerWillRobinson flags then
2261         pr "%s\n\n" danger_will_robinson;
2262   ) all_functions_sorted
2263
2264 and generate_structs_pod () =
2265   (* LVM structs documentation. *)
2266   List.iter (
2267     fun (typ, cols) ->
2268       pr "=head2 guestfs_lvm_%s\n" typ;
2269       pr "\n";
2270       pr " struct guestfs_lvm_%s {\n" typ;
2271       List.iter (
2272         function
2273         | name, `String -> pr "  char *%s;\n" name
2274         | name, `UUID ->
2275             pr "  /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2276             pr "  char %s[32];\n" name
2277         | name, `Bytes -> pr "  uint64_t %s;\n" name
2278         | name, `Int -> pr "  int64_t %s;\n" name
2279         | name, `OptPercent ->
2280             pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
2281             pr "  float %s;\n" name
2282       ) cols;
2283       pr " \n";
2284       pr " struct guestfs_lvm_%s_list {\n" typ;
2285       pr "   uint32_t len; /* Number of elements in list. */\n";
2286       pr "   struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2287       pr " };\n";
2288       pr " \n";
2289       pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2290         typ typ;
2291       pr "\n"
2292   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2293
2294 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
2295  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
2296  *
2297  * We have to use an underscore instead of a dash because otherwise
2298  * rpcgen generates incorrect code.
2299  *
2300  * This header is NOT exported to clients, but see also generate_structs_h.
2301  *)
2302 and generate_xdr () =
2303   generate_header CStyle LGPLv2;
2304
2305   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
2306   pr "typedef string str<>;\n";
2307   pr "\n";
2308
2309   (* LVM internal structures. *)
2310   List.iter (
2311     function
2312     | typ, cols ->
2313         pr "struct guestfs_lvm_int_%s {\n" typ;
2314         List.iter (function
2315                    | name, `String -> pr "  string %s<>;\n" name
2316                    | name, `UUID -> pr "  opaque %s[32];\n" name
2317                    | name, `Bytes -> pr "  hyper %s;\n" name
2318                    | name, `Int -> pr "  hyper %s;\n" name
2319                    | name, `OptPercent -> pr "  float %s;\n" name
2320                   ) cols;
2321         pr "};\n";
2322         pr "\n";
2323         pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
2324         pr "\n";
2325   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2326
2327   (* Stat internal structures. *)
2328   List.iter (
2329     function
2330     | typ, cols ->
2331         pr "struct guestfs_int_%s {\n" typ;
2332         List.iter (function
2333                    | name, `Int -> pr "  hyper %s;\n" name
2334                   ) cols;
2335         pr "};\n";
2336         pr "\n";
2337   ) ["stat", stat_cols; "statvfs", statvfs_cols];
2338
2339   List.iter (
2340     fun (shortname, style, _, _, _, _, _) ->
2341       let name = "guestfs_" ^ shortname in
2342
2343       (match snd style with
2344        | [] -> ()
2345        | args ->
2346            pr "struct %s_args {\n" name;
2347            List.iter (
2348              function
2349              | String n -> pr "  string %s<>;\n" n
2350              | OptString n -> pr "  str *%s;\n" n
2351              | StringList n -> pr "  str %s<>;\n" n
2352              | Bool n -> pr "  bool %s;\n" n
2353              | Int n -> pr "  int %s;\n" n
2354              | FileIn _ | FileOut _ -> ()
2355            ) args;
2356            pr "};\n\n"
2357       );
2358       (match fst style with
2359        | RErr -> ()
2360        | RInt n ->
2361            pr "struct %s_ret {\n" name;
2362            pr "  int %s;\n" n;
2363            pr "};\n\n"
2364        | RInt64 n ->
2365            pr "struct %s_ret {\n" name;
2366            pr "  hyper %s;\n" n;
2367            pr "};\n\n"
2368        | RBool n ->
2369            pr "struct %s_ret {\n" name;
2370            pr "  bool %s;\n" n;
2371            pr "};\n\n"
2372        | RConstString _ ->
2373            failwithf "RConstString cannot be returned from a daemon function"
2374        | RString n ->
2375            pr "struct %s_ret {\n" name;
2376            pr "  string %s<>;\n" n;
2377            pr "};\n\n"
2378        | RStringList n ->
2379            pr "struct %s_ret {\n" name;
2380            pr "  str %s<>;\n" n;
2381            pr "};\n\n"
2382        | RIntBool (n,m) ->
2383            pr "struct %s_ret {\n" name;
2384            pr "  int %s;\n" n;
2385            pr "  bool %s;\n" m;
2386            pr "};\n\n"
2387        | RPVList n ->
2388            pr "struct %s_ret {\n" name;
2389            pr "  guestfs_lvm_int_pv_list %s;\n" n;
2390            pr "};\n\n"
2391        | RVGList n ->
2392            pr "struct %s_ret {\n" name;
2393            pr "  guestfs_lvm_int_vg_list %s;\n" n;
2394            pr "};\n\n"
2395        | RLVList n ->
2396            pr "struct %s_ret {\n" name;
2397            pr "  guestfs_lvm_int_lv_list %s;\n" n;
2398            pr "};\n\n"
2399        | RStat n ->
2400            pr "struct %s_ret {\n" name;
2401            pr "  guestfs_int_stat %s;\n" n;
2402            pr "};\n\n"
2403        | RStatVFS n ->
2404            pr "struct %s_ret {\n" name;
2405            pr "  guestfs_int_statvfs %s;\n" n;
2406            pr "};\n\n"
2407        | RHashtable n ->
2408            pr "struct %s_ret {\n" name;
2409            pr "  str %s<>;\n" n;
2410            pr "};\n\n"
2411       );
2412   ) daemon_functions;
2413
2414   (* Table of procedure numbers. *)
2415   pr "enum guestfs_procedure {\n";
2416   List.iter (
2417     fun (shortname, _, proc_nr, _, _, _, _) ->
2418       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2419   ) daemon_functions;
2420   pr "  GUESTFS_PROC_NR_PROCS\n";
2421   pr "};\n";
2422   pr "\n";
2423
2424   (* Having to choose a maximum message size is annoying for several
2425    * reasons (it limits what we can do in the API), but it (a) makes
2426    * the protocol a lot simpler, and (b) provides a bound on the size
2427    * of the daemon which operates in limited memory space.  For large
2428    * file transfers you should use FTP.
2429    *)
2430   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2431   pr "\n";
2432
2433   (* Message header, etc. *)
2434   pr "\
2435 /* The communication protocol is now documented in the guestfs(3)
2436  * manpage.
2437  */
2438
2439 const GUESTFS_PROGRAM = 0x2000F5F5;
2440 const GUESTFS_PROTOCOL_VERSION = 1;
2441
2442 /* These constants must be larger than any possible message length. */
2443 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2444 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2445
2446 enum guestfs_message_direction {
2447   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
2448   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
2449 };
2450
2451 enum guestfs_message_status {
2452   GUESTFS_STATUS_OK = 0,
2453   GUESTFS_STATUS_ERROR = 1
2454 };
2455
2456 const GUESTFS_ERROR_LEN = 256;
2457
2458 struct guestfs_message_error {
2459   string error_message<GUESTFS_ERROR_LEN>;
2460 };
2461
2462 struct guestfs_message_header {
2463   unsigned prog;                     /* GUESTFS_PROGRAM */
2464   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
2465   guestfs_procedure proc;            /* GUESTFS_PROC_x */
2466   guestfs_message_direction direction;
2467   unsigned serial;                   /* message serial number */
2468   guestfs_message_status status;
2469 };
2470
2471 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2472
2473 struct guestfs_chunk {
2474   int cancel;                        /* if non-zero, transfer is cancelled */
2475   /* data size is 0 bytes if the transfer has finished successfully */
2476   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2477 };
2478 "
2479
2480 (* Generate the guestfs-structs.h file. *)
2481 and generate_structs_h () =
2482   generate_header CStyle LGPLv2;
2483
2484   (* This is a public exported header file containing various
2485    * structures.  The structures are carefully written to have
2486    * exactly the same in-memory format as the XDR structures that
2487    * we use on the wire to the daemon.  The reason for creating
2488    * copies of these structures here is just so we don't have to
2489    * export the whole of guestfs_protocol.h (which includes much
2490    * unrelated and XDR-dependent stuff that we don't want to be
2491    * public, or required by clients).
2492    *
2493    * To reiterate, we will pass these structures to and from the
2494    * client with a simple assignment or memcpy, so the format
2495    * must be identical to what rpcgen / the RFC defines.
2496    *)
2497
2498   (* guestfs_int_bool structure. *)
2499   pr "struct guestfs_int_bool {\n";
2500   pr "  int32_t i;\n";
2501   pr "  int32_t b;\n";
2502   pr "};\n";
2503   pr "\n";
2504
2505   (* LVM public structures. *)
2506   List.iter (
2507     function
2508     | typ, cols ->
2509         pr "struct guestfs_lvm_%s {\n" typ;
2510         List.iter (
2511           function
2512           | name, `String -> pr "  char *%s;\n" name
2513           | name, `UUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2514           | name, `Bytes -> pr "  uint64_t %s;\n" name
2515           | name, `Int -> pr "  int64_t %s;\n" name
2516           | name, `OptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
2517         ) cols;
2518         pr "};\n";
2519         pr "\n";
2520         pr "struct guestfs_lvm_%s_list {\n" typ;
2521         pr "  uint32_t len;\n";
2522         pr "  struct guestfs_lvm_%s *val;\n" typ;
2523         pr "};\n";
2524         pr "\n"
2525   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2526
2527   (* Stat structures. *)
2528   List.iter (
2529     function
2530     | typ, cols ->
2531         pr "struct guestfs_%s {\n" typ;
2532         List.iter (
2533           function
2534           | name, `Int -> pr "  int64_t %s;\n" name
2535         ) cols;
2536         pr "};\n";
2537         pr "\n"
2538   ) ["stat", stat_cols; "statvfs", statvfs_cols]
2539
2540 (* Generate the guestfs-actions.h file. *)
2541 and generate_actions_h () =
2542   generate_header CStyle LGPLv2;
2543   List.iter (
2544     fun (shortname, style, _, _, _, _, _) ->
2545       let name = "guestfs_" ^ shortname in
2546       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2547         name style
2548   ) all_functions
2549
2550 (* Generate the client-side dispatch stubs. *)
2551 and generate_client_actions () =
2552   generate_header CStyle LGPLv2;
2553
2554   pr "\
2555 #include <stdio.h>
2556 #include <stdlib.h>
2557
2558 #include \"guestfs.h\"
2559 #include \"guestfs_protocol.h\"
2560
2561 #define error guestfs_error
2562 #define perrorf guestfs_perrorf
2563 #define safe_malloc guestfs_safe_malloc
2564 #define safe_realloc guestfs_safe_realloc
2565 #define safe_strdup guestfs_safe_strdup
2566 #define safe_memdup guestfs_safe_memdup
2567
2568 /* Check the return message from a call for validity. */
2569 static int
2570 check_reply_header (guestfs_h *g,
2571                     const struct guestfs_message_header *hdr,
2572                     int proc_nr, int serial)
2573 {
2574   if (hdr->prog != GUESTFS_PROGRAM) {
2575     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2576     return -1;
2577   }
2578   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2579     error (g, \"wrong protocol version (%%d/%%d)\",
2580            hdr->vers, GUESTFS_PROTOCOL_VERSION);
2581     return -1;
2582   }
2583   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2584     error (g, \"unexpected message direction (%%d/%%d)\",
2585            hdr->direction, GUESTFS_DIRECTION_REPLY);
2586     return -1;
2587   }
2588   if (hdr->proc != proc_nr) {
2589     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2590     return -1;
2591   }
2592   if (hdr->serial != serial) {
2593     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2594     return -1;
2595   }
2596
2597   return 0;
2598 }
2599
2600 /* Check we are in the right state to run a high-level action. */
2601 static int
2602 check_state (guestfs_h *g, const char *caller)
2603 {
2604   if (!guestfs_is_ready (g)) {
2605     if (guestfs_is_config (g))
2606       error (g, \"%%s: call launch() before using this function\",
2607         caller);
2608     else if (guestfs_is_launching (g))
2609       error (g, \"%%s: call wait_ready() before using this function\",
2610         caller);
2611     else
2612       error (g, \"%%s called from the wrong state, %%d != READY\",
2613         caller, guestfs_get_state (g));
2614     return -1;
2615   }
2616   return 0;
2617 }
2618
2619 ";
2620
2621   (* Client-side stubs for each function. *)
2622   List.iter (
2623     fun (shortname, style, _, _, _, _, _) ->
2624       let name = "guestfs_" ^ shortname in
2625
2626       (* Generate the context struct which stores the high-level
2627        * state between callback functions.
2628        *)
2629       pr "struct %s_ctx {\n" shortname;
2630       pr "  /* This flag is set by the callbacks, so we know we've done\n";
2631       pr "   * the callbacks as expected, and in the right sequence.\n";
2632       pr "   * 0 = not called, 1 = reply_cb called.\n";
2633       pr "   */\n";
2634       pr "  int cb_sequence;\n";
2635       pr "  struct guestfs_message_header hdr;\n";
2636       pr "  struct guestfs_message_error err;\n";
2637       (match fst style with
2638        | RErr -> ()
2639        | RConstString _ ->
2640            failwithf "RConstString cannot be returned from a daemon function"
2641        | RInt _ | RInt64 _
2642        | RBool _ | RString _ | RStringList _
2643        | RIntBool _
2644        | RPVList _ | RVGList _ | RLVList _
2645        | RStat _ | RStatVFS _
2646        | RHashtable _ ->
2647            pr "  struct %s_ret ret;\n" name
2648       );
2649       pr "};\n";
2650       pr "\n";
2651
2652       (* Generate the reply callback function. *)
2653       pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2654       pr "{\n";
2655       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2656       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2657       pr "\n";
2658       pr "  /* This should definitely not happen. */\n";
2659       pr "  if (ctx->cb_sequence != 0) {\n";
2660       pr "    ctx->cb_sequence = 9999;\n";
2661       pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
2662       pr "    return;\n";
2663       pr "  }\n";
2664       pr "\n";
2665       pr "  ml->main_loop_quit (ml, g);\n";
2666       pr "\n";
2667       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2668       pr "    error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2669       pr "    return;\n";
2670       pr "  }\n";
2671       pr "  if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2672       pr "    if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2673       pr "      error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2674         name;
2675       pr "      return;\n";
2676       pr "    }\n";
2677       pr "    goto done;\n";
2678       pr "  }\n";
2679
2680       (match fst style with
2681        | RErr -> ()
2682        | RConstString _ ->
2683            failwithf "RConstString cannot be returned from a daemon function"
2684        | RInt _ | RInt64 _
2685        | RBool _ | RString _ | RStringList _
2686        | RIntBool _
2687        | RPVList _ | RVGList _ | RLVList _
2688        | RStat _ | RStatVFS _
2689        | RHashtable _ ->
2690             pr "  if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2691             pr "    error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2692             pr "    return;\n";
2693             pr "  }\n";
2694       );
2695
2696       pr " done:\n";
2697       pr "  ctx->cb_sequence = 1;\n";
2698       pr "}\n\n";
2699
2700       (* Generate the action stub. *)
2701       generate_prototype ~extern:false ~semicolon:false ~newline:true
2702         ~handle:"g" name style;
2703
2704       let error_code =
2705         match fst style with
2706         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2707         | RConstString _ ->
2708             failwithf "RConstString cannot be returned from a daemon function"
2709         | RString _ | RStringList _ | RIntBool _
2710         | RPVList _ | RVGList _ | RLVList _
2711         | RStat _ | RStatVFS _
2712         | RHashtable _ ->
2713             "NULL" in
2714
2715       pr "{\n";
2716
2717       (match snd style with
2718        | [] -> ()
2719        | _ -> pr "  struct %s_args args;\n" name
2720       );
2721
2722       pr "  struct %s_ctx ctx;\n" shortname;
2723       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2724       pr "  int serial;\n";
2725       pr "\n";
2726       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2727       pr "  guestfs_set_busy (g);\n";
2728       pr "\n";
2729       pr "  memset (&ctx, 0, sizeof ctx);\n";
2730       pr "\n";
2731
2732       (* Send the main header and arguments. *)
2733       (match snd style with
2734        | [] ->
2735            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2736              (String.uppercase shortname)
2737        | args ->
2738            List.iter (
2739              function
2740              | String n ->
2741                  pr "  args.%s = (char *) %s;\n" n n
2742              | OptString n ->
2743                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
2744              | StringList n ->
2745                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
2746                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2747              | Bool n ->
2748                  pr "  args.%s = %s;\n" n n
2749              | Int n ->
2750                  pr "  args.%s = %s;\n" n n
2751              | FileIn _ | FileOut _ -> ()
2752            ) args;
2753            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2754              (String.uppercase shortname);
2755            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2756              name;
2757       );
2758       pr "  if (serial == -1) {\n";
2759       pr "    guestfs_set_ready (g);\n";
2760       pr "    return %s;\n" error_code;
2761       pr "  }\n";
2762       pr "\n";
2763
2764       (* Send any additional files (FileIn) requested. *)
2765       let need_read_reply_label = ref false in
2766       List.iter (
2767         function
2768         | FileIn n ->
2769             pr "  {\n";
2770             pr "    int r;\n";
2771             pr "\n";
2772             pr "    r = guestfs__send_file_sync (g, %s);\n" n;
2773             pr "    if (r == -1) {\n";
2774             pr "      guestfs_set_ready (g);\n";
2775             pr "      return %s;\n" error_code;
2776             pr "    }\n";
2777             pr "    if (r == -2) /* daemon cancelled */\n";
2778             pr "      goto read_reply;\n";
2779             need_read_reply_label := true;
2780             pr "  }\n";
2781             pr "\n";
2782         | _ -> ()
2783       ) (snd style);
2784
2785       (* Wait for the reply from the remote end. *)
2786       if !need_read_reply_label then pr " read_reply:\n";
2787       pr "  guestfs__switch_to_receiving (g);\n";
2788       pr "  ctx.cb_sequence = 0;\n";
2789       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2790       pr "  (void) ml->main_loop_run (ml, g);\n";
2791       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
2792       pr "  if (ctx.cb_sequence != 1) {\n";
2793       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2794       pr "    guestfs_set_ready (g);\n";
2795       pr "    return %s;\n" error_code;
2796       pr "  }\n";
2797       pr "\n";
2798
2799       pr "  if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2800         (String.uppercase shortname);
2801       pr "    guestfs_set_ready (g);\n";
2802       pr "    return %s;\n" error_code;
2803       pr "  }\n";
2804       pr "\n";
2805
2806       pr "  if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2807       pr "    error (g, \"%%s\", ctx.err.error_message);\n";
2808       pr "    guestfs_set_ready (g);\n";
2809       pr "    return %s;\n" error_code;
2810       pr "  }\n";
2811       pr "\n";
2812
2813       (* Expecting to receive further files (FileOut)? *)
2814       List.iter (
2815         function
2816         | FileOut n ->
2817             pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2818             pr "    guestfs_set_ready (g);\n";
2819             pr "    return %s;\n" error_code;
2820             pr "  }\n";
2821             pr "\n";
2822         | _ -> ()
2823       ) (snd style);
2824
2825       pr "  guestfs_set_ready (g);\n";
2826
2827       (match fst style with
2828        | RErr -> pr "  return 0;\n"
2829        | RInt n | RInt64 n | RBool n ->
2830            pr "  return ctx.ret.%s;\n" n
2831        | RConstString _ ->
2832            failwithf "RConstString cannot be returned from a daemon function"
2833        | RString n ->
2834            pr "  return ctx.ret.%s; /* caller will free */\n" n
2835        | RStringList n | RHashtable n ->
2836            pr "  /* caller will free this, but we need to add a NULL entry */\n";
2837            pr "  ctx.ret.%s.%s_val =\n" n n;
2838            pr "    safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2839            pr "                  sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2840              n n;
2841            pr "  ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2842            pr "  return ctx.ret.%s.%s_val;\n" n n
2843        | RIntBool _ ->
2844            pr "  /* caller with free this */\n";
2845            pr "  return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2846        | RPVList n | RVGList n | RLVList n
2847        | RStat n | RStatVFS n ->
2848            pr "  /* caller will free this */\n";
2849            pr "  return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2850       );
2851
2852       pr "}\n\n"
2853   ) daemon_functions
2854
2855 (* Generate daemon/actions.h. *)
2856 and generate_daemon_actions_h () =
2857   generate_header CStyle GPLv2;
2858
2859   pr "#include \"../src/guestfs_protocol.h\"\n";
2860   pr "\n";
2861
2862   List.iter (
2863     fun (name, style, _, _, _, _, _) ->
2864         generate_prototype
2865           ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2866           name style;
2867   ) daemon_functions
2868
2869 (* Generate the server-side stubs. *)
2870 and generate_daemon_actions () =
2871   generate_header CStyle GPLv2;
2872
2873   pr "#include <config.h>\n";
2874   pr "\n";
2875   pr "#include <stdio.h>\n";
2876   pr "#include <stdlib.h>\n";
2877   pr "#include <string.h>\n";
2878   pr "#include <inttypes.h>\n";
2879   pr "#include <ctype.h>\n";
2880   pr "#include <rpc/types.h>\n";
2881   pr "#include <rpc/xdr.h>\n";
2882   pr "\n";
2883   pr "#include \"daemon.h\"\n";
2884   pr "#include \"../src/guestfs_protocol.h\"\n";
2885   pr "#include \"actions.h\"\n";
2886   pr "\n";
2887
2888   List.iter (
2889     fun (name, style, _, _, _, _, _) ->
2890       (* Generate server-side stubs. *)
2891       pr "static void %s_stub (XDR *xdr_in)\n" name;
2892       pr "{\n";
2893       let error_code =
2894         match fst style with
2895         | RErr | RInt _ -> pr "  int r;\n"; "-1"
2896         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
2897         | RBool _ -> pr "  int r;\n"; "-1"
2898         | RConstString _ ->
2899             failwithf "RConstString cannot be returned from a daemon function"
2900         | RString _ -> pr "  char *r;\n"; "NULL"
2901         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
2902         | RIntBool _ -> pr "  guestfs_%s_ret *r;\n" name; "NULL"
2903         | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
2904         | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
2905         | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL"
2906         | RStat _ -> pr "  guestfs_int_stat *r;\n"; "NULL"
2907         | RStatVFS _ -> pr "  guestfs_int_statvfs *r;\n"; "NULL" in
2908
2909       (match snd style with
2910        | [] -> ()
2911        | args ->
2912            pr "  struct guestfs_%s_args args;\n" name;
2913            List.iter (
2914              function
2915              | String n
2916              | OptString n -> pr "  const char *%s;\n" n
2917              | StringList n -> pr "  char **%s;\n" n
2918              | Bool n -> pr "  int %s;\n" n
2919              | Int n -> pr "  int %s;\n" n
2920              | FileIn _ | FileOut _ -> ()
2921            ) args
2922       );
2923       pr "\n";
2924
2925       (match snd style with
2926        | [] -> ()
2927        | args ->
2928            pr "  memset (&args, 0, sizeof args);\n";
2929            pr "\n";
2930            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2931            pr "    reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2932            pr "    return;\n";
2933            pr "  }\n";
2934            List.iter (
2935              function
2936              | String n -> pr "  %s = args.%s;\n" n n
2937              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
2938              | StringList n ->
2939                  pr "  %s = realloc (args.%s.%s_val,\n" n n n;
2940                  pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
2941                  pr "  if (%s == NULL) {\n" n;
2942                  pr "    reply_with_perror (\"realloc\");\n";
2943                  pr "    goto done;\n";
2944                  pr "  }\n";
2945                  pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
2946                  pr "  args.%s.%s_val = %s;\n" n n n;
2947              | Bool n -> pr "  %s = args.%s;\n" n n
2948              | Int n -> pr "  %s = args.%s;\n" n n
2949              | FileIn _ | FileOut _ -> ()
2950            ) args;
2951            pr "\n"
2952       );
2953
2954       (* Don't want to call the impl with any FileIn or FileOut
2955        * parameters, since these go "outside" the RPC protocol.
2956        *)
2957       let argsnofile =
2958         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2959           (snd style) in
2960       pr "  r = do_%s " name;
2961       generate_call_args argsnofile;
2962       pr ";\n";
2963
2964       pr "  if (r == %s)\n" error_code;
2965       pr "    /* do_%s has already called reply_with_error */\n" name;
2966       pr "    goto done;\n";
2967       pr "\n";
2968
2969       (* If there are any FileOut parameters, then the impl must
2970        * send its own reply.
2971        *)
2972       let no_reply =
2973         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2974       if no_reply then
2975         pr "  /* do_%s has already sent a reply */\n" name
2976       else (
2977         match fst style with
2978         | RErr -> pr "  reply (NULL, NULL);\n"
2979         | RInt n | RInt64 n | RBool n ->
2980             pr "  struct guestfs_%s_ret ret;\n" name;
2981             pr "  ret.%s = r;\n" n;
2982             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2983               name
2984         | RConstString _ ->
2985             failwithf "RConstString cannot be returned from a daemon function"
2986         | RString n ->
2987             pr "  struct guestfs_%s_ret ret;\n" name;
2988             pr "  ret.%s = r;\n" n;
2989             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2990               name;
2991             pr "  free (r);\n"
2992         | RStringList n | RHashtable n ->
2993             pr "  struct guestfs_%s_ret ret;\n" name;
2994             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
2995             pr "  ret.%s.%s_val = r;\n" n n;
2996             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2997               name;
2998             pr "  free_strings (r);\n"
2999         | RIntBool _ ->
3000             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
3001               name;
3002             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
3003         | RPVList n | RVGList n | RLVList n
3004         | RStat n | RStatVFS n ->
3005             pr "  struct guestfs_%s_ret ret;\n" name;
3006             pr "  ret.%s = *r;\n" n;
3007             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3008               name;
3009             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3010               name
3011       );
3012
3013       (* Free the args. *)
3014       (match snd style with
3015        | [] ->
3016            pr "done: ;\n";
3017        | _ ->
3018            pr "done:\n";
3019            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
3020              name
3021       );
3022
3023       pr "}\n\n";
3024   ) daemon_functions;
3025
3026   (* Dispatch function. *)
3027   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3028   pr "{\n";
3029   pr "  switch (proc_nr) {\n";
3030
3031   List.iter (
3032     fun (name, style, _, _, _, _, _) ->
3033         pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
3034         pr "      %s_stub (xdr_in);\n" name;
3035         pr "      break;\n"
3036   ) daemon_functions;
3037
3038   pr "    default:\n";
3039   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3040   pr "  }\n";
3041   pr "}\n";
3042   pr "\n";
3043
3044   (* LVM columns and tokenization functions. *)
3045   (* XXX This generates crap code.  We should rethink how we
3046    * do this parsing.
3047    *)
3048   List.iter (
3049     function
3050     | typ, cols ->
3051         pr "static const char *lvm_%s_cols = \"%s\";\n"
3052           typ (String.concat "," (List.map fst cols));
3053         pr "\n";
3054
3055         pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3056         pr "{\n";
3057         pr "  char *tok, *p, *next;\n";
3058         pr "  int i, j;\n";
3059         pr "\n";
3060         (*
3061         pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3062         pr "\n";
3063         *)
3064         pr "  if (!str) {\n";
3065         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3066         pr "    return -1;\n";
3067         pr "  }\n";
3068         pr "  if (!*str || isspace (*str)) {\n";
3069         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3070         pr "    return -1;\n";
3071         pr "  }\n";
3072         pr "  tok = str;\n";
3073         List.iter (
3074           fun (name, coltype) ->
3075             pr "  if (!tok) {\n";
3076             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3077             pr "    return -1;\n";
3078             pr "  }\n";
3079             pr "  p = strchrnul (tok, ',');\n";
3080             pr "  if (*p) next = p+1; else next = NULL;\n";
3081             pr "  *p = '\\0';\n";
3082             (match coltype with
3083              | `String ->
3084                  pr "  r->%s = strdup (tok);\n" name;
3085                  pr "  if (r->%s == NULL) {\n" name;
3086                  pr "    perror (\"strdup\");\n";
3087                  pr "    return -1;\n";
3088                  pr "  }\n"
3089              | `UUID ->
3090                  pr "  for (i = j = 0; i < 32; ++j) {\n";
3091                  pr "    if (tok[j] == '\\0') {\n";
3092                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3093                  pr "      return -1;\n";
3094                  pr "    } else if (tok[j] != '-')\n";
3095                  pr "      r->%s[i++] = tok[j];\n" name;
3096                  pr "  }\n";
3097              | `Bytes ->
3098                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3099                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3100                  pr "    return -1;\n";
3101                  pr "  }\n";
3102              | `Int ->
3103                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3104                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3105                  pr "    return -1;\n";
3106                  pr "  }\n";
3107              | `OptPercent ->
3108                  pr "  if (tok[0] == '\\0')\n";
3109                  pr "    r->%s = -1;\n" name;
3110                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3111                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3112                  pr "    return -1;\n";
3113                  pr "  }\n";
3114             );
3115             pr "  tok = next;\n";
3116         ) cols;
3117
3118         pr "  if (tok != NULL) {\n";
3119         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3120         pr "    return -1;\n";
3121         pr "  }\n";
3122         pr "  return 0;\n";
3123         pr "}\n";
3124         pr "\n";
3125
3126         pr "guestfs_lvm_int_%s_list *\n" typ;
3127         pr "parse_command_line_%ss (void)\n" typ;
3128         pr "{\n";
3129         pr "  char *out, *err;\n";
3130         pr "  char *p, *pend;\n";
3131         pr "  int r, i;\n";
3132         pr "  guestfs_lvm_int_%s_list *ret;\n" typ;
3133         pr "  void *newp;\n";
3134         pr "\n";
3135         pr "  ret = malloc (sizeof *ret);\n";
3136         pr "  if (!ret) {\n";
3137         pr "    reply_with_perror (\"malloc\");\n";
3138         pr "    return NULL;\n";
3139         pr "  }\n";
3140         pr "\n";
3141         pr "  ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3142         pr "  ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3143         pr "\n";
3144         pr "  r = command (&out, &err,\n";
3145         pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
3146         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3147         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3148         pr "  if (r == -1) {\n";
3149         pr "    reply_with_error (\"%%s\", err);\n";
3150         pr "    free (out);\n";
3151         pr "    free (err);\n";
3152         pr "    free (ret);\n";
3153         pr "    return NULL;\n";
3154         pr "  }\n";
3155         pr "\n";
3156         pr "  free (err);\n";
3157         pr "\n";
3158         pr "  /* Tokenize each line of the output. */\n";
3159         pr "  p = out;\n";
3160         pr "  i = 0;\n";
3161         pr "  while (p) {\n";
3162         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
3163         pr "    if (pend) {\n";
3164         pr "      *pend = '\\0';\n";
3165         pr "      pend++;\n";
3166         pr "    }\n";
3167         pr "\n";
3168         pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
3169         pr "      p++;\n";
3170         pr "\n";
3171         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
3172         pr "      p = pend;\n";
3173         pr "      continue;\n";
3174         pr "    }\n";
3175         pr "\n";
3176         pr "    /* Allocate some space to store this next entry. */\n";
3177         pr "    newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3178         pr "                sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3179         pr "    if (newp == NULL) {\n";
3180         pr "      reply_with_perror (\"realloc\");\n";
3181         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3182         pr "      free (ret);\n";
3183         pr "      free (out);\n";
3184         pr "      return NULL;\n";
3185         pr "    }\n";
3186         pr "    ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3187         pr "\n";
3188         pr "    /* Tokenize the next entry. */\n";
3189         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3190         pr "    if (r == -1) {\n";
3191         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3192         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3193         pr "      free (ret);\n";
3194         pr "      free (out);\n";
3195         pr "      return NULL;\n";
3196         pr "    }\n";
3197         pr "\n";
3198         pr "    ++i;\n";
3199         pr "    p = pend;\n";
3200         pr "  }\n";
3201         pr "\n";
3202         pr "  ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3203         pr "\n";
3204         pr "  free (out);\n";
3205         pr "  return ret;\n";
3206         pr "}\n"
3207
3208   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3209
3210 (* Generate the tests. *)
3211 and generate_tests () =
3212   generate_header CStyle GPLv2;
3213
3214   pr "\
3215 #include <stdio.h>
3216 #include <stdlib.h>
3217 #include <string.h>
3218 #include <unistd.h>
3219 #include <sys/types.h>
3220 #include <fcntl.h>
3221
3222 #include \"guestfs.h\"
3223
3224 static guestfs_h *g;
3225 static int suppress_error = 0;
3226
3227 static void print_error (guestfs_h *g, void *data, const char *msg)
3228 {
3229   if (!suppress_error)
3230     fprintf (stderr, \"%%s\\n\", msg);
3231 }
3232
3233 static void print_strings (char * const * const argv)
3234 {
3235   int argc;
3236
3237   for (argc = 0; argv[argc] != NULL; ++argc)
3238     printf (\"\\t%%s\\n\", argv[argc]);
3239 }
3240
3241 /*
3242 static void print_table (char * const * const argv)
3243 {
3244   int i;
3245
3246   for (i = 0; argv[i] != NULL; i += 2)
3247     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3248 }
3249 */
3250
3251 static void no_test_warnings (void)
3252 {
3253 ";
3254
3255   List.iter (
3256     function
3257     | name, _, _, _, [], _, _ ->
3258         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3259     | name, _, _, _, tests, _, _ -> ()
3260   ) all_functions;
3261
3262   pr "}\n";
3263   pr "\n";
3264
3265   (* Generate the actual tests.  Note that we generate the tests
3266    * in reverse order, deliberately, so that (in general) the
3267    * newest tests run first.  This makes it quicker and easier to
3268    * debug them.
3269    *)
3270   let test_names =
3271     List.map (
3272       fun (name, _, _, _, tests, _, _) ->
3273         mapi (generate_one_test name) tests
3274     ) (List.rev all_functions) in
3275   let test_names = List.concat test_names in
3276   let nr_tests = List.length test_names in
3277
3278   pr "\
3279 int main (int argc, char *argv[])
3280 {
3281   char c = 0;
3282   int failed = 0;
3283   const char *srcdir;
3284   const char *filename;
3285   int fd;
3286   int nr_tests, test_num = 0;
3287
3288   no_test_warnings ();
3289
3290   g = guestfs_create ();
3291   if (g == NULL) {
3292     printf (\"guestfs_create FAILED\\n\");
3293     exit (1);
3294   }
3295
3296   guestfs_set_error_handler (g, print_error, NULL);
3297
3298   srcdir = getenv (\"srcdir\");
3299   if (!srcdir) srcdir = \".\";
3300   chdir (srcdir);
3301   guestfs_set_path (g, \".\");
3302
3303   filename = \"test1.img\";
3304   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3305   if (fd == -1) {
3306     perror (filename);
3307     exit (1);
3308   }
3309   if (lseek (fd, %d, SEEK_SET) == -1) {
3310     perror (\"lseek\");
3311     close (fd);
3312     unlink (filename);
3313     exit (1);
3314   }
3315   if (write (fd, &c, 1) == -1) {
3316     perror (\"write\");
3317     close (fd);
3318     unlink (filename);
3319     exit (1);
3320   }
3321   if (close (fd) == -1) {
3322     perror (filename);
3323     unlink (filename);
3324     exit (1);
3325   }
3326   if (guestfs_add_drive (g, filename) == -1) {
3327     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3328     exit (1);
3329   }
3330
3331   filename = \"test2.img\";
3332   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3333   if (fd == -1) {
3334     perror (filename);
3335     exit (1);
3336   }
3337   if (lseek (fd, %d, SEEK_SET) == -1) {
3338     perror (\"lseek\");
3339     close (fd);
3340     unlink (filename);
3341     exit (1);
3342   }
3343   if (write (fd, &c, 1) == -1) {
3344     perror (\"write\");
3345     close (fd);
3346     unlink (filename);
3347     exit (1);
3348   }
3349   if (close (fd) == -1) {
3350     perror (filename);
3351     unlink (filename);
3352     exit (1);
3353   }
3354   if (guestfs_add_drive (g, filename) == -1) {
3355     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3356     exit (1);
3357   }
3358
3359   filename = \"test3.img\";
3360   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3361   if (fd == -1) {
3362     perror (filename);
3363     exit (1);
3364   }
3365   if (lseek (fd, %d, SEEK_SET) == -1) {
3366     perror (\"lseek\");
3367     close (fd);
3368     unlink (filename);
3369     exit (1);
3370   }
3371   if (write (fd, &c, 1) == -1) {
3372     perror (\"write\");
3373     close (fd);
3374     unlink (filename);
3375     exit (1);
3376   }
3377   if (close (fd) == -1) {
3378     perror (filename);
3379     unlink (filename);
3380     exit (1);
3381   }
3382   if (guestfs_add_drive (g, filename) == -1) {
3383     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3384     exit (1);
3385   }
3386
3387   if (guestfs_launch (g) == -1) {
3388     printf (\"guestfs_launch FAILED\\n\");
3389     exit (1);
3390   }
3391   if (guestfs_wait_ready (g) == -1) {
3392     printf (\"guestfs_wait_ready FAILED\\n\");
3393     exit (1);
3394   }
3395
3396   nr_tests = %d;
3397
3398 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3399
3400   iteri (
3401     fun i test_name ->
3402       pr "  test_num++;\n";
3403       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3404       pr "  if (%s () == -1) {\n" test_name;
3405       pr "    printf (\"%s FAILED\\n\");\n" test_name;
3406       pr "    failed++;\n";
3407       pr "  }\n";
3408   ) test_names;
3409   pr "\n";
3410
3411   pr "  guestfs_close (g);\n";
3412   pr "  unlink (\"test1.img\");\n";
3413   pr "  unlink (\"test2.img\");\n";
3414   pr "  unlink (\"test3.img\");\n";
3415   pr "\n";
3416
3417   pr "  if (failed > 0) {\n";
3418   pr "    printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3419   pr "    exit (1);\n";
3420   pr "  }\n";
3421   pr "\n";
3422
3423   pr "  exit (0);\n";
3424   pr "}\n"
3425
3426 and generate_one_test name i (init, test) =
3427   let test_name = sprintf "test_%s_%d" name i in
3428
3429   pr "static int %s (void)\n" test_name;
3430   pr "{\n";
3431
3432   (match init with
3433    | InitNone -> ()
3434    | InitEmpty ->
3435        pr "  /* InitEmpty for %s (%d) */\n" name i;
3436        List.iter (generate_test_command_call test_name)
3437          [["umount_all"];
3438           ["lvm_remove_all"]]
3439    | InitBasicFS ->
3440        pr "  /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3441        List.iter (generate_test_command_call test_name)
3442          [["umount_all"];
3443           ["lvm_remove_all"];
3444           ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3445           ["mkfs"; "ext2"; "/dev/sda1"];
3446           ["mount"; "/dev/sda1"; "/"]]
3447    | InitBasicFSonLVM ->
3448        pr "  /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3449          name i;
3450        List.iter (generate_test_command_call test_name)
3451          [["umount_all"];
3452           ["lvm_remove_all"];
3453           ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3454           ["pvcreate"; "/dev/sda1"];
3455           ["vgcreate"; "VG"; "/dev/sda1"];
3456           ["lvcreate"; "LV"; "VG"; "8"];
3457           ["mkfs"; "ext2"; "/dev/VG/LV"];
3458           ["mount"; "/dev/VG/LV"; "/"]]
3459   );
3460
3461   let get_seq_last = function
3462     | [] ->
3463         failwithf "%s: you cannot use [] (empty list) when expecting a command"
3464           test_name
3465     | seq ->
3466         let seq = List.rev seq in
3467         List.rev (List.tl seq), List.hd seq
3468   in
3469
3470   (match test with
3471    | TestRun seq ->
3472        pr "  /* TestRun for %s (%d) */\n" name i;
3473        List.iter (generate_test_command_call test_name) seq
3474    | TestOutput (seq, expected) ->
3475        pr "  /* TestOutput for %s (%d) */\n" name i;
3476        let seq, last = get_seq_last seq in
3477        let test () =
3478          pr "    if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
3479          pr "      fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
3480          pr "      return -1;\n";
3481          pr "    }\n"
3482        in
3483        List.iter (generate_test_command_call test_name) seq;
3484        generate_test_command_call ~test test_name last
3485    | TestOutputList (seq, expected) ->
3486        pr "  /* TestOutputList for %s (%d) */\n" name i;
3487        let seq, last = get_seq_last seq in
3488        let test () =
3489          iteri (
3490            fun i str ->
3491              pr "    if (!r[%d]) {\n" i;
3492              pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3493              pr "      print_strings (r);\n";
3494              pr "      return -1;\n";
3495              pr "    }\n";
3496              pr "    if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
3497              pr "      fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3498              pr "      return -1;\n";
3499              pr "    }\n"
3500          ) expected;
3501          pr "    if (r[%d] != NULL) {\n" (List.length expected);
3502          pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3503            test_name;
3504          pr "      print_strings (r);\n";
3505          pr "      return -1;\n";
3506          pr "    }\n"
3507        in
3508        List.iter (generate_test_command_call test_name) seq;
3509        generate_test_command_call ~test test_name last
3510    | TestOutputInt (seq, expected) ->
3511        pr "  /* TestOutputInt for %s (%d) */\n" name i;
3512        let seq, last = get_seq_last seq in
3513        let test () =
3514          pr "    if (r != %d) {\n" expected;
3515          pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3516            test_name expected;
3517          pr "               (int) r);\n";
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    | TestOutputTrue seq ->
3524        pr "  /* TestOutputTrue for %s (%d) */\n" name i;
3525        let seq, last = get_seq_last seq in
3526        let test () =
3527          pr "    if (!r) {\n";
3528          pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3529            test_name;
3530          pr "      return -1;\n";
3531          pr "    }\n"
3532        in
3533        List.iter (generate_test_command_call test_name) seq;
3534        generate_test_command_call ~test test_name last
3535    | TestOutputFalse seq ->
3536        pr "  /* TestOutputFalse for %s (%d) */\n" name i;
3537        let seq, last = get_seq_last seq in
3538        let test () =
3539          pr "    if (r) {\n";
3540          pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3541            test_name;
3542          pr "      return -1;\n";
3543          pr "    }\n"
3544        in
3545        List.iter (generate_test_command_call test_name) seq;
3546        generate_test_command_call ~test test_name last
3547    | TestOutputLength (seq, expected) ->
3548        pr "  /* TestOutputLength for %s (%d) */\n" name i;
3549        let seq, last = get_seq_last seq in
3550        let test () =
3551          pr "    int j;\n";
3552          pr "    for (j = 0; j < %d; ++j)\n" expected;
3553          pr "      if (r[j] == NULL) {\n";
3554          pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
3555            test_name;
3556          pr "        print_strings (r);\n";
3557          pr "        return -1;\n";
3558          pr "      }\n";
3559          pr "    if (r[j] != NULL) {\n";
3560          pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
3561            test_name;
3562          pr "      print_strings (r);\n";
3563          pr "      return -1;\n";
3564          pr "    }\n"
3565        in
3566        List.iter (generate_test_command_call test_name) seq;
3567        generate_test_command_call ~test test_name last
3568    | TestOutputStruct (seq, checks) ->
3569        pr "  /* TestOutputStruct for %s (%d) */\n" name i;
3570        let seq, last = get_seq_last seq in
3571        let test () =
3572          List.iter (
3573            function
3574            | CompareWithInt (field, expected) ->
3575                pr "    if (r->%s != %d) {\n" field expected;
3576                pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3577                  test_name field expected;
3578                pr "               (int) r->%s);\n" field;
3579                pr "      return -1;\n";
3580                pr "    }\n"
3581            | CompareWithString (field, expected) ->
3582                pr "    if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3583                pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3584                  test_name field expected;
3585                pr "               r->%s);\n" field;
3586                pr "      return -1;\n";
3587                pr "    }\n"
3588            | CompareFieldsIntEq (field1, field2) ->
3589                pr "    if (r->%s != r->%s) {\n" field1 field2;
3590                pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3591                  test_name field1 field2;
3592                pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
3593                pr "      return -1;\n";
3594                pr "    }\n"
3595            | CompareFieldsStrEq (field1, field2) ->
3596                pr "    if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3597                pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3598                  test_name field1 field2;
3599                pr "               r->%s, r->%s);\n" field1 field2;
3600                pr "      return -1;\n";
3601                pr "    }\n"
3602          ) checks
3603        in
3604        List.iter (generate_test_command_call test_name) seq;
3605        generate_test_command_call ~test test_name last
3606    | TestLastFail seq ->
3607        pr "  /* TestLastFail for %s (%d) */\n" name i;
3608        let seq, last = get_seq_last seq in
3609        List.iter (generate_test_command_call test_name) seq;
3610        generate_test_command_call test_name ~expect_error:true last
3611   );
3612
3613   pr "  return 0;\n";
3614   pr "}\n";
3615   pr "\n";
3616   test_name
3617
3618 (* Generate the code to run a command, leaving the result in 'r'.
3619  * If you expect to get an error then you should set expect_error:true.
3620  *)
3621 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3622   match cmd with
3623   | [] -> assert false
3624   | name :: args ->
3625       (* Look up the command to find out what args/ret it has. *)
3626       let style =
3627         try
3628           let _, style, _, _, _, _, _ =
3629             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3630           style
3631         with Not_found ->
3632           failwithf "%s: in test, command %s was not found" test_name name in
3633
3634       if List.length (snd style) <> List.length args then
3635         failwithf "%s: in test, wrong number of args given to %s"
3636           test_name name;
3637
3638       pr "  {\n";
3639
3640       List.iter (
3641         function
3642         | String _, _
3643         | OptString _, _
3644         | Int _, _
3645         | Bool _, _ -> ()
3646         | FileIn _, _ | FileOut _, _ -> ()