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