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