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