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