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