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