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