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