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