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