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