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