3 * Copyright (C) 2009 Red Hat Inc.
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.
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.
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
20 (* This script generates a large amount of code and documentation for
21 * all the daemon actions.
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.
27 * After editing this file, run it (./src/generator.ml) to regenerate
28 * all the output files.
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]
39 type style = ret * args
41 (* "RErr" as a return value means an int used as a simple error
42 * indication, ie. 0 or -1.
45 (* "RInt" as a return value means an int which is -1 for error
46 * or any value >= 0 on success.
49 (* "RBool" is a bool return value which can be true/false or
53 (* "RConstString" is a string that refers to a constant value.
54 * Try to avoid using this. In particular you cannot use this
55 * for values returned from the daemon, because there is no
56 * thread-safe way to return them in the C API.
58 | RConstString of string
59 (* "RString" and "RStringList" are caller-frees. *)
61 | RStringList of string
62 (* Some limited tuples are possible: *)
63 | RIntBool of string * string
64 (* LVM PVs, VGs and LVs. *)
68 and args = argt list (* Function parameters, guestfs handle is implicit. *)
70 (* Note in future we should allow a "variable args" parameter as
71 * the final parameter, to allow commands like
72 * chmod mode file [file(s)...]
73 * This is not implemented yet, but many commands (such as chmod)
74 * are currently defined with the argument order keeping this future
75 * possibility in mind.
78 | String of string (* const char *name, cannot be NULL *)
79 | OptString of string (* const char *name, may be NULL *)
80 | StringList of string(* list of strings (each string cannot be NULL) *)
81 | Bool of string (* boolean *)
82 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
85 | ProtocolLimitWarning (* display warning about protocol size limits *)
86 | DangerWillRobinson (* flags particularly dangerous commands *)
87 | FishAlias of string (* provide an alias for this cmd in guestfish *)
88 | FishAction of string (* call this function in guestfish *)
89 | NotInFish (* do not export via guestfish *)
91 let protocol_limit_warning =
92 "Because of the message protocol, there is a transfer limit
93 of somewhere between 2MB and 4MB. To transfer large files you should use
96 let danger_will_robinson =
97 "B<This command is dangerous. Without careful use you
98 can easily destroy all your data>."
100 (* You can supply zero or as many tests as you want per API call.
102 * Note that the test environment has 3 block devices, of size 500MB,
103 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
104 * Note for partitioning purposes, the 500MB device has 63 cylinders.
106 * To be able to run the tests in a reasonable amount of time,
107 * the virtual machine and block devices are reused between tests.
108 * So don't try testing kill_subprocess :-x
110 * Between each test we umount-all and lvm-remove-all.
112 * Don't assume anything about the previous contents of the block
113 * devices. Use 'Init*' to create some initial scenarios.
115 type tests = (test_init * test) list
117 (* Run the command sequence and just expect nothing to fail. *)
119 (* Run the command sequence and expect the output of the final
120 * command to be the string.
122 | TestOutput of seq * string
123 (* Run the command sequence and expect the output of the final
124 * command to be the list of strings.
126 | TestOutputList of seq * string list
127 (* Run the command sequence and expect the output of the final
128 * command to be the integer.
130 | TestOutputInt of seq * int
131 (* Run the command sequence and expect the output of the final
132 * command to be a true value (!= 0 or != NULL).
134 | TestOutputTrue of seq
135 (* Run the command sequence and expect the output of the final
136 * command to be a false value (== 0 or == NULL, but not an error).
138 | TestOutputFalse of seq
139 (* Run the command sequence and expect the output of the final
140 * command to be a list of the given length (but don't care about
143 | TestOutputLength of seq * int
144 (* Run the command sequence and expect the final command (only)
147 | TestLastFail of seq
149 (* Some initial scenarios for testing. *)
151 (* Do nothing, block devices could contain random stuff including
152 * LVM PVs, and some filesystems might be mounted. This is usually
156 (* Block devices are empty and no filesystems are mounted. *)
158 (* /dev/sda contains a single partition /dev/sda1, which is formatted
159 * as ext2, empty [except for lost+found] and mounted on /.
160 * /dev/sdb and /dev/sdc may have random content.
165 * /dev/sda1 (is a PV):
166 * /dev/VG/LV (size 8MB):
167 * formatted as ext2, empty [except for lost+found], mounted on /
168 * /dev/sdb and /dev/sdc may have random content.
172 (* Sequence of commands for testing. *)
174 and cmd = string list
176 (* Note about long descriptions: When referring to another
177 * action, use the format C<guestfs_other> (ie. the full name of
178 * the C function). This will be replaced as appropriate in other
181 * Apart from that, long descriptions are just perldoc paragraphs.
184 let non_daemon_functions = [
185 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
187 "launch the qemu subprocess",
189 Internally libguestfs is implemented by running a virtual machine
192 You should call this after configuring the handle
193 (eg. adding drives) but before performing any actions.");
195 ("wait_ready", (RErr, []), -1, [NotInFish],
197 "wait until the qemu subprocess launches",
199 Internally libguestfs is implemented by running a virtual machine
202 You should call this after C<guestfs_launch> to wait for the launch
205 ("kill_subprocess", (RErr, []), -1, [],
207 "kill the qemu subprocess",
209 This kills the qemu subprocess. You should never need to call this.");
211 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
213 "add an image to examine or modify",
215 This function adds a virtual machine disk image C<filename> to the
216 guest. The first time you call this function, the disk appears as IDE
217 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
220 You don't necessarily need to be root when using libguestfs. However
221 you obviously do need sufficient permissions to access the filename
222 for whatever operations you want to perform (ie. read access if you
223 just want to read the image or write access if you want to modify the
226 This is equivalent to the qemu parameter C<-drive file=filename>.");
228 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
230 "add a CD-ROM disk image to examine",
232 This function adds a virtual CD-ROM disk image to the guest.
234 This is equivalent to the qemu parameter C<-cdrom filename>.");
236 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
238 "add qemu parameters",
240 This can be used to add arbitrary qemu command line parameters
241 of the form C<-param value>. Actually it's not quite arbitrary - we
242 prevent you from setting some parameters which would interfere with
243 parameters that we use.
245 The first character of C<param> string must be a C<-> (dash).
247 C<value> can be NULL.");
249 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
251 "set the search path",
253 Set the path that libguestfs searches for kernel and initrd.img.
255 The default is C<$libdir/guestfs> unless overridden by setting
256 C<LIBGUESTFS_PATH> environment variable.
258 The string C<path> is stashed in the libguestfs handle, so the caller
259 must make sure it remains valid for the lifetime of the handle.
261 Setting C<path> to C<NULL> restores the default path.");
263 ("get_path", (RConstString "path", []), -1, [],
265 "get the search path",
267 Return the current search path.
269 This is always non-NULL. If it wasn't set already, then this will
270 return the default path.");
272 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
276 If C<autosync> is true, this enables autosync. Libguestfs will make a
277 best effort attempt to run C<guestfs_sync> when the handle is closed
278 (also if the program exits without closing handles).");
280 ("get_autosync", (RBool "autosync", []), -1, [],
284 Get the autosync flag.");
286 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
290 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
292 Verbose messages are disabled unless the environment variable
293 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
295 ("get_verbose", (RBool "verbose", []), -1, [],
299 This returns the verbose messages flag.")
302 let daemon_functions = [
303 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
304 [InitEmpty, TestOutput (
305 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
306 ["mkfs"; "ext2"; "/dev/sda1"];
307 ["mount"; "/dev/sda1"; "/"];
308 ["write_file"; "/new"; "new file contents"; "0"];
309 ["cat"; "/new"]], "new file contents")],
310 "mount a guest disk at a position in the filesystem",
312 Mount a guest disk at a position in the filesystem. Block devices
313 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
314 the guest. If those block devices contain partitions, they will have
315 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
318 The rules are the same as for L<mount(2)>: A filesystem must
319 first be mounted on C</> before others can be mounted. Other
320 filesystems can only be mounted on directories which already
323 The mounted filesystem is writable, if we have sufficient permissions
324 on the underlying device.
326 The filesystem options C<sync> and C<noatime> are set with this
327 call, in order to improve reliability.");
329 ("sync", (RErr, []), 2, [],
330 [ InitEmpty, TestRun [["sync"]]],
331 "sync disks, writes are flushed through to the disk image",
333 This syncs the disk, so that any writes are flushed through to the
334 underlying disk image.
336 You should always call this if you have modified a disk image, before
337 closing the handle.");
339 ("touch", (RErr, [String "path"]), 3, [],
340 [InitBasicFS, TestOutputTrue (
342 ["exists"; "/new"]])],
343 "update file timestamps or create a new file",
345 Touch acts like the L<touch(1)> command. It can be used to
346 update the timestamps on a file, or, if the file does not exist,
347 to create a new zero-length file.");
349 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
350 [InitBasicFS, TestOutput (
351 [["write_file"; "/new"; "new file contents"; "0"];
352 ["cat"; "/new"]], "new file contents")],
353 "list the contents of a file",
355 Return the contents of the file named C<path>.
357 Note that this function cannot correctly handle binary files
358 (specifically, files containing C<\\0> character which is treated
359 as end of string). For those you need to use the C<guestfs_read_file>
360 function which has a more complex interface.");
362 ("ll", (RString "listing", [String "directory"]), 5, [],
363 [], (* XXX Tricky to test because it depends on the exact format
364 * of the 'ls -l' command, which changes between F10 and F11.
366 "list the files in a directory (long format)",
368 List the files in C<directory> (relative to the root directory,
369 there is no cwd) in the format of 'ls -la'.
371 This command is mostly useful for interactive sessions. It
372 is I<not> intended that you try to parse the output string.");
374 ("ls", (RStringList "listing", [String "directory"]), 6, [],
375 [InitBasicFS, TestOutputList (
378 ["touch"; "/newest"];
379 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
380 "list the files in a directory",
382 List the files in C<directory> (relative to the root directory,
383 there is no cwd). The '.' and '..' entries are not returned, but
384 hidden files are shown.
386 This command is mostly useful for interactive sessions. Programs
387 should probably use C<guestfs_readdir> instead.");
389 ("list_devices", (RStringList "devices", []), 7, [],
390 [InitEmpty, TestOutputList (
391 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
392 "list the block devices",
394 List all the block devices.
396 The full block device names are returned, eg. C</dev/sda>");
398 ("list_partitions", (RStringList "partitions", []), 8, [],
399 [InitBasicFS, TestOutputList (
400 [["list_partitions"]], ["/dev/sda1"]);
401 InitEmpty, TestOutputList (
402 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
403 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
404 "list the partitions",
406 List all the partitions detected on all block devices.
408 The full partition device names are returned, eg. C</dev/sda1>
410 This does not return logical volumes. For that you will need to
411 call C<guestfs_lvs>.");
413 ("pvs", (RStringList "physvols", []), 9, [],
414 [InitBasicFSonLVM, TestOutputList (
415 [["pvs"]], ["/dev/sda1"]);
416 InitEmpty, TestOutputList (
417 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
418 ["pvcreate"; "/dev/sda1"];
419 ["pvcreate"; "/dev/sda2"];
420 ["pvcreate"; "/dev/sda3"];
421 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
422 "list the LVM physical volumes (PVs)",
424 List all the physical volumes detected. This is the equivalent
425 of the L<pvs(8)> command.
427 This returns a list of just the device names that contain
428 PVs (eg. C</dev/sda2>).
430 See also C<guestfs_pvs_full>.");
432 ("vgs", (RStringList "volgroups", []), 10, [],
433 [InitBasicFSonLVM, TestOutputList (
435 InitEmpty, TestOutputList (
436 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
437 ["pvcreate"; "/dev/sda1"];
438 ["pvcreate"; "/dev/sda2"];
439 ["pvcreate"; "/dev/sda3"];
440 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
441 ["vgcreate"; "VG2"; "/dev/sda3"];
442 ["vgs"]], ["VG1"; "VG2"])],
443 "list the LVM volume groups (VGs)",
445 List all the volumes groups detected. This is the equivalent
446 of the L<vgs(8)> command.
448 This returns a list of just the volume group names that were
449 detected (eg. C<VolGroup00>).
451 See also C<guestfs_vgs_full>.");
453 ("lvs", (RStringList "logvols", []), 11, [],
454 [InitBasicFSonLVM, TestOutputList (
455 [["lvs"]], ["/dev/VG/LV"]);
456 InitEmpty, TestOutputList (
457 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
458 ["pvcreate"; "/dev/sda1"];
459 ["pvcreate"; "/dev/sda2"];
460 ["pvcreate"; "/dev/sda3"];
461 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
462 ["vgcreate"; "VG2"; "/dev/sda3"];
463 ["lvcreate"; "LV1"; "VG1"; "50"];
464 ["lvcreate"; "LV2"; "VG1"; "50"];
465 ["lvcreate"; "LV3"; "VG2"; "50"];
466 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
467 "list the LVM logical volumes (LVs)",
469 List all the logical volumes detected. This is the equivalent
470 of the L<lvs(8)> command.
472 This returns a list of the logical volume device names
473 (eg. C</dev/VolGroup00/LogVol00>).
475 See also C<guestfs_lvs_full>.");
477 ("pvs_full", (RPVList "physvols", []), 12, [],
478 [InitBasicFSonLVM, TestOutputLength (
480 "list the LVM physical volumes (PVs)",
482 List all the physical volumes detected. This is the equivalent
483 of the L<pvs(8)> command. The \"full\" version includes all fields.");
485 ("vgs_full", (RVGList "volgroups", []), 13, [],
486 [InitBasicFSonLVM, TestOutputLength (
488 "list the LVM volume groups (VGs)",
490 List all the volumes groups detected. This is the equivalent
491 of the L<vgs(8)> command. The \"full\" version includes all fields.");
493 ("lvs_full", (RLVList "logvols", []), 14, [],
494 [InitBasicFSonLVM, TestOutputLength (
496 "list the LVM logical volumes (LVs)",
498 List all the logical volumes detected. This is the equivalent
499 of the L<lvs(8)> command. The \"full\" version includes all fields.");
501 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
502 [InitBasicFS, TestOutputList (
503 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
504 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
505 InitBasicFS, TestOutputList (
506 [["write_file"; "/new"; ""; "0"];
507 ["read_lines"; "/new"]], [])],
508 "read file as lines",
510 Return the contents of the file named C<path>.
512 The file contents are returned as a list of lines. Trailing
513 C<LF> and C<CRLF> character sequences are I<not> returned.
515 Note that this function cannot correctly handle binary files
516 (specifically, files containing C<\\0> character which is treated
517 as end of line). For those you need to use the C<guestfs_read_file>
518 function which has a more complex interface.");
520 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
521 [], (* XXX Augeas code needs tests. *)
522 "create a new Augeas handle",
524 Create a new Augeas handle for editing configuration files.
525 If there was any previous Augeas handle associated with this
526 guestfs session, then it is closed.
528 You must call this before using any other C<guestfs_aug_*>
531 C<root> is the filesystem root. C<root> must not be NULL,
534 The flags are the same as the flags defined in
535 E<lt>augeas.hE<gt>, the logical I<or> of the following
540 =item C<AUG_SAVE_BACKUP> = 1
542 Keep the original file with a C<.augsave> extension.
544 =item C<AUG_SAVE_NEWFILE> = 2
546 Save changes into a file with extension C<.augnew>, and
547 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
549 =item C<AUG_TYPE_CHECK> = 4
551 Typecheck lenses (can be expensive).
553 =item C<AUG_NO_STDINC> = 8
555 Do not use standard load path for modules.
557 =item C<AUG_SAVE_NOOP> = 16
559 Make save a no-op, just record what would have been changed.
561 =item C<AUG_NO_LOAD> = 32
563 Do not load the tree in C<guestfs_aug_init>.
567 To close the handle, you can call C<guestfs_aug_close>.
569 To find out more about Augeas, see L<http://augeas.net/>.");
571 ("aug_close", (RErr, []), 26, [],
572 [], (* XXX Augeas code needs tests. *)
573 "close the current Augeas handle",
575 Close the current Augeas handle and free up any resources
576 used by it. After calling this, you have to call
577 C<guestfs_aug_init> again before you can use any other
580 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
581 [], (* XXX Augeas code needs tests. *)
582 "define an Augeas variable",
584 Defines an Augeas variable C<name> whose value is the result
585 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
588 On success this returns the number of nodes in C<expr>, or
589 C<0> if C<expr> evaluates to something which is not a nodeset.");
591 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
592 [], (* XXX Augeas code needs tests. *)
593 "define an Augeas node",
595 Defines a variable C<name> whose value is the result of
598 If C<expr> evaluates to an empty nodeset, a node is created,
599 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
600 C<name> will be the nodeset containing that single node.
602 On success this returns a pair containing the
603 number of nodes in the nodeset, and a boolean flag
604 if a node was created.");
606 ("aug_get", (RString "val", [String "path"]), 19, [],
607 [], (* XXX Augeas code needs tests. *)
608 "look up the value of an Augeas path",
610 Look up the value associated with C<path>. If C<path>
611 matches exactly one node, the C<value> is returned.");
613 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
614 [], (* XXX Augeas code needs tests. *)
615 "set Augeas path to value",
617 Set the value associated with C<path> to C<value>.");
619 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
620 [], (* XXX Augeas code needs tests. *)
621 "insert a sibling Augeas node",
623 Create a new sibling C<label> for C<path>, inserting it into
624 the tree before or after C<path> (depending on the boolean
627 C<path> must match exactly one existing node in the tree, and
628 C<label> must be a label, ie. not contain C</>, C<*> or end
629 with a bracketed index C<[N]>.");
631 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
632 [], (* XXX Augeas code needs tests. *)
633 "remove an Augeas path",
635 Remove C<path> and all of its children.
637 On success this returns the number of entries which were removed.");
639 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
640 [], (* XXX Augeas code needs tests. *)
643 Move the node C<src> to C<dest>. C<src> must match exactly
644 one node. C<dest> is overwritten if it exists.");
646 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
647 [], (* XXX Augeas code needs tests. *)
648 "return Augeas nodes which match path",
650 Returns a list of paths which match the path expression C<path>.
651 The returned paths are sufficiently qualified so that they match
652 exactly one node in the current tree.");
654 ("aug_save", (RErr, []), 25, [],
655 [], (* XXX Augeas code needs tests. *)
656 "write all pending Augeas changes to disk",
658 This writes all pending changes to disk.
660 The flags which were passed to C<guestfs_aug_init> affect exactly
661 how files are saved.");
663 ("aug_load", (RErr, []), 27, [],
664 [], (* XXX Augeas code needs tests. *)
665 "load files into the tree",
667 Load files into the tree.
669 See C<aug_load> in the Augeas documentation for the full gory
672 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
673 [], (* XXX Augeas code needs tests. *)
674 "list Augeas nodes under a path",
676 This is just a shortcut for listing C<guestfs_aug_match>
677 C<path/*> and sorting the resulting nodes into alphabetical order.");
679 ("rm", (RErr, [String "path"]), 29, [],
680 [InitBasicFS, TestRun
683 InitBasicFS, TestLastFail
685 InitBasicFS, TestLastFail
690 Remove the single file C<path>.");
692 ("rmdir", (RErr, [String "path"]), 30, [],
693 [InitBasicFS, TestRun
696 InitBasicFS, TestLastFail
698 InitBasicFS, TestLastFail
701 "remove a directory",
703 Remove the single directory C<path>.");
705 ("rm_rf", (RErr, [String "path"]), 31, [],
706 [InitBasicFS, TestOutputFalse
708 ["mkdir"; "/new/foo"];
709 ["touch"; "/new/foo/bar"];
711 ["exists"; "/new"]]],
712 "remove a file or directory recursively",
714 Remove the file or directory C<path>, recursively removing the
715 contents if its a directory. This is like the C<rm -rf> shell
718 ("mkdir", (RErr, [String "path"]), 32, [],
719 [InitBasicFS, TestOutputTrue
722 InitBasicFS, TestLastFail
723 [["mkdir"; "/new/foo/bar"]]],
724 "create a directory",
726 Create a directory named C<path>.");
728 ("mkdir_p", (RErr, [String "path"]), 33, [],
729 [InitBasicFS, TestOutputTrue
730 [["mkdir_p"; "/new/foo/bar"];
731 ["is_dir"; "/new/foo/bar"]];
732 InitBasicFS, TestOutputTrue
733 [["mkdir_p"; "/new/foo/bar"];
734 ["is_dir"; "/new/foo"]];
735 InitBasicFS, TestOutputTrue
736 [["mkdir_p"; "/new/foo/bar"];
737 ["is_dir"; "/new"]]],
738 "create a directory and parents",
740 Create a directory named C<path>, creating any parent directories
741 as necessary. This is like the C<mkdir -p> shell command.");
743 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
744 [], (* XXX Need stat command to test *)
747 Change the mode (permissions) of C<path> to C<mode>. Only
748 numeric modes are supported.");
750 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
751 [], (* XXX Need stat command to test *)
752 "change file owner and group",
754 Change the file owner to C<owner> and group to C<group>.
756 Only numeric uid and gid are supported. If you want to use
757 names, you will need to locate and parse the password file
758 yourself (Augeas support makes this relatively easy).");
760 ("exists", (RBool "existsflag", [String "path"]), 36, [],
761 [InitBasicFS, TestOutputTrue (
763 ["exists"; "/new"]]);
764 InitBasicFS, TestOutputTrue (
766 ["exists"; "/new"]])],
767 "test if file or directory exists",
769 This returns C<true> if and only if there is a file, directory
770 (or anything) with the given C<path> name.
772 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
774 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
775 [InitBasicFS, TestOutputTrue (
777 ["is_file"; "/new"]]);
778 InitBasicFS, TestOutputFalse (
780 ["is_file"; "/new"]])],
781 "test if file exists",
783 This returns C<true> if and only if there is a file
784 with the given C<path> name. Note that it returns false for
785 other objects like directories.
787 See also C<guestfs_stat>.");
789 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
790 [InitBasicFS, TestOutputFalse (
792 ["is_dir"; "/new"]]);
793 InitBasicFS, TestOutputTrue (
795 ["is_dir"; "/new"]])],
796 "test if file exists",
798 This returns C<true> if and only if there is a directory
799 with the given C<path> name. Note that it returns false for
800 other objects like files.
802 See also C<guestfs_stat>.");
804 ("pvcreate", (RErr, [String "device"]), 39, [],
805 [InitEmpty, TestOutputList (
806 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
807 ["pvcreate"; "/dev/sda1"];
808 ["pvcreate"; "/dev/sda2"];
809 ["pvcreate"; "/dev/sda3"];
810 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
811 "create an LVM physical volume",
813 This creates an LVM physical volume on the named C<device>,
814 where C<device> should usually be a partition name such
817 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
818 [InitEmpty, TestOutputList (
819 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
820 ["pvcreate"; "/dev/sda1"];
821 ["pvcreate"; "/dev/sda2"];
822 ["pvcreate"; "/dev/sda3"];
823 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
824 ["vgcreate"; "VG2"; "/dev/sda3"];
825 ["vgs"]], ["VG1"; "VG2"])],
826 "create an LVM volume group",
828 This creates an LVM volume group called C<volgroup>
829 from the non-empty list of physical volumes C<physvols>.");
831 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
832 [InitEmpty, TestOutputList (
833 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
834 ["pvcreate"; "/dev/sda1"];
835 ["pvcreate"; "/dev/sda2"];
836 ["pvcreate"; "/dev/sda3"];
837 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
838 ["vgcreate"; "VG2"; "/dev/sda3"];
839 ["lvcreate"; "LV1"; "VG1"; "50"];
840 ["lvcreate"; "LV2"; "VG1"; "50"];
841 ["lvcreate"; "LV3"; "VG2"; "50"];
842 ["lvcreate"; "LV4"; "VG2"; "50"];
843 ["lvcreate"; "LV5"; "VG2"; "50"];
845 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
846 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
847 "create an LVM volume group",
849 This creates an LVM volume group called C<logvol>
850 on the volume group C<volgroup>, with C<size> megabytes.");
852 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
853 [InitEmpty, TestOutput (
854 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
855 ["mkfs"; "ext2"; "/dev/sda1"];
856 ["mount"; "/dev/sda1"; "/"];
857 ["write_file"; "/new"; "new file contents"; "0"];
858 ["cat"; "/new"]], "new file contents")],
861 This creates a filesystem on C<device> (usually a partition
862 of LVM logical volume). The filesystem type is C<fstype>, for
865 ("sfdisk", (RErr, [String "device";
866 Int "cyls"; Int "heads"; Int "sectors";
867 StringList "lines"]), 43, [DangerWillRobinson],
869 "create partitions on a block device",
871 This is a direct interface to the L<sfdisk(8)> program for creating
872 partitions on block devices.
874 C<device> should be a block device, for example C</dev/sda>.
876 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
877 and sectors on the device, which are passed directly to sfdisk as
878 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
879 of these, then the corresponding parameter is omitted. Usually for
880 'large' disks, you can just pass C<0> for these, but for small
881 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
882 out the right geometry and you will need to tell it.
884 C<lines> is a list of lines that we feed to C<sfdisk>. For more
885 information refer to the L<sfdisk(8)> manpage.
887 To create a single partition occupying the whole disk, you would
888 pass C<lines> as a single element list, when the single element being
889 the string C<,> (comma).");
891 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
892 [InitEmpty, TestOutput (
893 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
894 ["mkfs"; "ext2"; "/dev/sda1"];
895 ["mount"; "/dev/sda1"; "/"];
896 ["write_file"; "/new"; "new file contents"; "0"];
897 ["cat"; "/new"]], "new file contents")],
900 This call creates a file called C<path>. The contents of the
901 file is the string C<content> (which can contain any 8 bit data),
904 As a special case, if C<size> is C<0>
905 then the length is calculated using C<strlen> (so in this case
906 the content cannot contain embedded ASCII NULs).");
908 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
909 [InitEmpty, TestOutputList (
910 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
911 ["mkfs"; "ext2"; "/dev/sda1"];
912 ["mount"; "/dev/sda1"; "/"];
913 ["mounts"]], ["/dev/sda1"]);
914 InitEmpty, TestOutputList (
915 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
916 ["mkfs"; "ext2"; "/dev/sda1"];
917 ["mount"; "/dev/sda1"; "/"];
920 "unmount a filesystem",
922 This unmounts the given filesystem. The filesystem may be
923 specified either by its mountpoint (path) or the device which
924 contains the filesystem.");
926 ("mounts", (RStringList "devices", []), 46, [],
927 [InitBasicFS, TestOutputList (
928 [["mounts"]], ["/dev/sda1"])],
929 "show mounted filesystems",
931 This returns the list of currently mounted filesystems. It returns
932 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
934 Some internal mounts are not shown.");
936 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
937 [InitBasicFS, TestOutputList (
940 "unmount all filesystems",
942 This unmounts all mounted filesystems.
944 Some internal mounts are not unmounted by this call.");
946 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
948 "remove all LVM LVs, VGs and PVs",
950 This command removes all LVM logical volumes, volume groups
951 and physical volumes.");
953 ("file", (RString "description", [String "path"]), 49, [],
954 [InitBasicFS, TestOutput (
956 ["file"; "/new"]], "empty");
957 InitBasicFS, TestOutput (
958 [["write_file"; "/new"; "some content\n"; "0"];
959 ["file"; "/new"]], "ASCII text");
960 InitBasicFS, TestLastFail (
961 [["file"; "/nofile"]])],
962 "determine file type",
964 This call uses the standard L<file(1)> command to determine
965 the type or contents of the file. This also works on devices,
966 for example to find out whether a partition contains a filesystem.
968 The exact command which runs is C<file -bsL path>. Note in
969 particular that the filename is not prepended to the output
970 (the C<-b> option).");
974 let all_functions = non_daemon_functions @ daemon_functions
976 (* In some places we want the functions to be displayed sorted
977 * alphabetically, so this is useful:
979 let all_functions_sorted =
980 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
981 compare n1 n2) all_functions
983 (* Column names and types from LVM PVs/VGs/LVs. *)
992 "pv_attr", `String (* XXX *);
994 "pv_pe_alloc_count", `Int;
997 "pv_mda_count", `Int;
998 "pv_mda_free", `Bytes;
1000 "pv_mda_size", `Bytes;
1007 "vg_attr", `String (* XXX *);
1010 "vg_sysid", `String;
1011 "vg_extent_size", `Bytes;
1012 "vg_extent_count", `Int;
1013 "vg_free_count", `Int;
1021 "vg_mda_count", `Int;
1022 "vg_mda_free", `Bytes;
1023 (* Not in Fedora 10:
1024 "vg_mda_size", `Bytes;
1030 "lv_attr", `String (* XXX *);
1033 "lv_kernel_major", `Int;
1034 "lv_kernel_minor", `Int;
1038 "snap_percent", `OptPercent;
1039 "copy_percent", `OptPercent;
1042 "mirror_log", `String;
1046 (* Useful functions.
1047 * Note we don't want to use any external OCaml libraries which
1048 * makes this a bit harder than it should be.
1050 let failwithf fs = ksprintf failwith fs
1052 let replace_char s c1 c2 =
1053 let s2 = String.copy s in
1054 let r = ref false in
1055 for i = 0 to String.length s2 - 1 do
1056 if String.unsafe_get s2 i = c1 then (
1057 String.unsafe_set s2 i c2;
1061 if not !r then s else s2
1063 let rec find s sub =
1064 let len = String.length s in
1065 let sublen = String.length sub in
1067 if i <= len-sublen then (
1069 if j < sublen then (
1070 if s.[i+j] = sub.[j] then loop2 (j+1)
1076 if r = -1 then loop (i+1) else r
1082 let rec replace_str s s1 s2 =
1083 let len = String.length s in
1084 let sublen = String.length s1 in
1085 let i = find s s1 in
1088 let s' = String.sub s 0 i in
1089 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1090 s' ^ s2 ^ replace_str s'' s1 s2
1093 let rec string_split sep str =
1094 let len = String.length str in
1095 let seplen = String.length sep in
1096 let i = find str sep in
1097 if i = -1 then [str]
1099 let s' = String.sub str 0 i in
1100 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1101 s' :: string_split sep s''
1104 let rec find_map f = function
1105 | [] -> raise Not_found
1109 | None -> find_map f xs
1112 let rec loop i = function
1114 | x :: xs -> f i x; loop (i+1) xs
1119 let rec loop i = function
1121 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1125 let name_of_argt = function
1126 | String n | OptString n | StringList n | Bool n | Int n -> n
1128 (* Check function names etc. for consistency. *)
1129 let check_functions () =
1130 let contains_uppercase str =
1131 let len = String.length str in
1133 if i >= len then false
1136 if c >= 'A' && c <= 'Z' then true
1143 (* Check function names. *)
1145 fun (name, _, _, _, _, _, _) ->
1146 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1147 failwithf "function name %s does not need 'guestfs' prefix" name;
1148 if contains_uppercase name then
1149 failwithf "function name %s should not contain uppercase chars" name;
1150 if String.contains name '-' then
1151 failwithf "function name %s should not contain '-', use '_' instead."
1155 (* Check function parameter/return names. *)
1157 fun (name, style, _, _, _, _, _) ->
1158 let check_arg_ret_name n =
1159 if contains_uppercase n then
1160 failwithf "%s param/ret %s should not contain uppercase chars"
1162 if String.contains n '-' || String.contains n '_' then
1163 failwithf "%s param/ret %s should not contain '-' or '_'"
1166 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
1169 (match fst style with
1171 | RInt n | RBool n | RConstString n | RString n
1172 | RStringList n | RPVList n | RVGList n | RLVList n ->
1173 check_arg_ret_name n
1175 check_arg_ret_name n;
1176 check_arg_ret_name m
1178 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1181 (* Check short descriptions. *)
1183 fun (name, _, _, _, _, shortdesc, _) ->
1184 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1185 failwithf "short description of %s should begin with lowercase." name;
1186 let c = shortdesc.[String.length shortdesc-1] in
1187 if c = '\n' || c = '.' then
1188 failwithf "short description of %s should not end with . or \\n." name
1191 (* Check long dscriptions. *)
1193 fun (name, _, _, _, _, _, longdesc) ->
1194 if longdesc.[String.length longdesc-1] = '\n' then
1195 failwithf "long description of %s should not end with \\n." name
1198 (* Check proc_nrs. *)
1200 fun (name, _, proc_nr, _, _, _, _) ->
1201 if proc_nr <= 0 then
1202 failwithf "daemon function %s should have proc_nr > 0" name
1206 fun (name, _, proc_nr, _, _, _, _) ->
1207 if proc_nr <> -1 then
1208 failwithf "non-daemon function %s should have proc_nr -1" name
1209 ) non_daemon_functions;
1212 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1215 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1216 let rec loop = function
1219 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1221 | (name1,nr1) :: (name2,nr2) :: _ ->
1222 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1227 (* 'pr' prints to the current output file. *)
1228 let chan = ref stdout
1229 let pr fs = ksprintf (output_string !chan) fs
1231 (* Generate a header block in a number of standard styles. *)
1232 type comment_style = CStyle | HashStyle | OCamlStyle
1233 type license = GPLv2 | LGPLv2
1235 let generate_header comment license =
1236 let c = match comment with
1237 | CStyle -> pr "/* "; " *"
1238 | HashStyle -> pr "# "; "#"
1239 | OCamlStyle -> pr "(* "; " *" in
1240 pr "libguestfs generated file\n";
1241 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1242 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1244 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1248 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1249 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1250 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1251 pr "%s (at your option) any later version.\n" c;
1253 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1254 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1255 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1256 pr "%s GNU General Public License for more details.\n" c;
1258 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1259 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1260 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1263 pr "%s This library is free software; you can redistribute it and/or\n" c;
1264 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1265 pr "%s License as published by the Free Software Foundation; either\n" c;
1266 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1268 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1269 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1270 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1271 pr "%s Lesser General Public License for more details.\n" c;
1273 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1274 pr "%s License along with this library; if not, write to the Free Software\n" c;
1275 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1278 | CStyle -> pr " */\n"
1280 | OCamlStyle -> pr " *)\n"
1284 (* Start of main code generation functions below this line. *)
1286 (* Generate the pod documentation for the C API. *)
1287 let rec generate_actions_pod () =
1289 fun (shortname, style, _, flags, _, _, longdesc) ->
1290 let name = "guestfs_" ^ shortname in
1291 pr "=head2 %s\n\n" name;
1293 generate_prototype ~extern:false ~handle:"handle" name style;
1295 pr "%s\n\n" longdesc;
1296 (match fst style with
1298 pr "This function returns 0 on success or -1 on error.\n\n"
1300 pr "On error this function returns -1.\n\n"
1302 pr "This function returns a C truth value on success or -1 on error.\n\n"
1304 pr "This function returns a string or NULL on error.
1305 The string is owned by the guest handle and must I<not> be freed.\n\n"
1307 pr "This function returns a string or NULL on error.
1308 I<The caller must free the returned string after use>.\n\n"
1310 pr "This function returns a NULL-terminated array of strings
1311 (like L<environ(3)>), or NULL if there was an error.
1312 I<The caller must free the strings and the array after use>.\n\n"
1314 pr "This function returns a C<struct guestfs_int_bool *>.
1315 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1317 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
1318 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1320 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
1321 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1323 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
1324 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1326 if List.mem ProtocolLimitWarning flags then
1327 pr "%s\n\n" protocol_limit_warning;
1328 if List.mem DangerWillRobinson flags then
1329 pr "%s\n\n" danger_will_robinson;
1330 ) all_functions_sorted
1332 and generate_structs_pod () =
1333 (* LVM structs documentation. *)
1336 pr "=head2 guestfs_lvm_%s\n" typ;
1338 pr " struct guestfs_lvm_%s {\n" typ;
1341 | name, `String -> pr " char *%s;\n" name
1343 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1344 pr " char %s[32];\n" name
1345 | name, `Bytes -> pr " uint64_t %s;\n" name
1346 | name, `Int -> pr " int64_t %s;\n" name
1347 | name, `OptPercent ->
1348 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1349 pr " float %s;\n" name
1352 pr " struct guestfs_lvm_%s_list {\n" typ;
1353 pr " uint32_t len; /* Number of elements in list. */\n";
1354 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1357 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1360 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1362 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1363 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1365 * We have to use an underscore instead of a dash because otherwise
1366 * rpcgen generates incorrect code.
1368 * This header is NOT exported to clients, but see also generate_structs_h.
1370 and generate_xdr () =
1371 generate_header CStyle LGPLv2;
1373 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1374 pr "typedef string str<>;\n";
1377 (* LVM internal structures. *)
1381 pr "struct guestfs_lvm_int_%s {\n" typ;
1383 | name, `String -> pr " string %s<>;\n" name
1384 | name, `UUID -> pr " opaque %s[32];\n" name
1385 | name, `Bytes -> pr " hyper %s;\n" name
1386 | name, `Int -> pr " hyper %s;\n" name
1387 | name, `OptPercent -> pr " float %s;\n" name
1391 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1393 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1396 fun (shortname, style, _, _, _, _, _) ->
1397 let name = "guestfs_" ^ shortname in
1399 (match snd style with
1402 pr "struct %s_args {\n" name;
1405 | String n -> pr " string %s<>;\n" n
1406 | OptString n -> pr " str *%s;\n" n
1407 | StringList n -> pr " str %s<>;\n" n
1408 | Bool n -> pr " bool %s;\n" n
1409 | Int n -> pr " int %s;\n" n
1413 (match fst style with
1416 pr "struct %s_ret {\n" name;
1420 pr "struct %s_ret {\n" name;
1424 failwithf "RConstString cannot be returned from a daemon function"
1426 pr "struct %s_ret {\n" name;
1427 pr " string %s<>;\n" n;
1430 pr "struct %s_ret {\n" name;
1431 pr " str %s<>;\n" n;
1434 pr "struct %s_ret {\n" name;
1439 pr "struct %s_ret {\n" name;
1440 pr " guestfs_lvm_int_pv_list %s;\n" n;
1443 pr "struct %s_ret {\n" name;
1444 pr " guestfs_lvm_int_vg_list %s;\n" n;
1447 pr "struct %s_ret {\n" name;
1448 pr " guestfs_lvm_int_lv_list %s;\n" n;
1453 (* Table of procedure numbers. *)
1454 pr "enum guestfs_procedure {\n";
1456 fun (shortname, _, proc_nr, _, _, _, _) ->
1457 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1459 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1463 (* Having to choose a maximum message size is annoying for several
1464 * reasons (it limits what we can do in the API), but it (a) makes
1465 * the protocol a lot simpler, and (b) provides a bound on the size
1466 * of the daemon which operates in limited memory space. For large
1467 * file transfers you should use FTP.
1469 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1472 (* Message header, etc. *)
1474 const GUESTFS_PROGRAM = 0x2000F5F5;
1475 const GUESTFS_PROTOCOL_VERSION = 1;
1477 enum guestfs_message_direction {
1478 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1479 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1482 enum guestfs_message_status {
1483 GUESTFS_STATUS_OK = 0,
1484 GUESTFS_STATUS_ERROR = 1
1487 const GUESTFS_ERROR_LEN = 256;
1489 struct guestfs_message_error {
1490 string error<GUESTFS_ERROR_LEN>; /* error message */
1493 struct guestfs_message_header {
1494 unsigned prog; /* GUESTFS_PROGRAM */
1495 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1496 guestfs_procedure proc; /* GUESTFS_PROC_x */
1497 guestfs_message_direction direction;
1498 unsigned serial; /* message serial number */
1499 guestfs_message_status status;
1503 (* Generate the guestfs-structs.h file. *)
1504 and generate_structs_h () =
1505 generate_header CStyle LGPLv2;
1507 (* This is a public exported header file containing various
1508 * structures. The structures are carefully written to have
1509 * exactly the same in-memory format as the XDR structures that
1510 * we use on the wire to the daemon. The reason for creating
1511 * copies of these structures here is just so we don't have to
1512 * export the whole of guestfs_protocol.h (which includes much
1513 * unrelated and XDR-dependent stuff that we don't want to be
1514 * public, or required by clients).
1516 * To reiterate, we will pass these structures to and from the
1517 * client with a simple assignment or memcpy, so the format
1518 * must be identical to what rpcgen / the RFC defines.
1521 (* guestfs_int_bool structure. *)
1522 pr "struct guestfs_int_bool {\n";
1528 (* LVM public structures. *)
1532 pr "struct guestfs_lvm_%s {\n" typ;
1535 | name, `String -> pr " char *%s;\n" name
1536 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1537 | name, `Bytes -> pr " uint64_t %s;\n" name
1538 | name, `Int -> pr " int64_t %s;\n" name
1539 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1543 pr "struct guestfs_lvm_%s_list {\n" typ;
1544 pr " uint32_t len;\n";
1545 pr " struct guestfs_lvm_%s *val;\n" typ;
1548 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1550 (* Generate the guestfs-actions.h file. *)
1551 and generate_actions_h () =
1552 generate_header CStyle LGPLv2;
1554 fun (shortname, style, _, _, _, _, _) ->
1555 let name = "guestfs_" ^ shortname in
1556 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1560 (* Generate the client-side dispatch stubs. *)
1561 and generate_client_actions () =
1562 generate_header CStyle LGPLv2;
1564 (* Client-side stubs for each function. *)
1566 fun (shortname, style, _, _, _, _, _) ->
1567 let name = "guestfs_" ^ shortname in
1569 (* Generate the return value struct. *)
1570 pr "struct %s_rv {\n" shortname;
1571 pr " int cb_done; /* flag to indicate callback was called */\n";
1572 pr " struct guestfs_message_header hdr;\n";
1573 pr " struct guestfs_message_error err;\n";
1574 (match fst style with
1577 failwithf "RConstString cannot be returned from a daemon function"
1579 | RBool _ | RString _ | RStringList _
1581 | RPVList _ | RVGList _ | RLVList _ ->
1582 pr " struct %s_ret ret;\n" name
1586 (* Generate the callback function. *)
1587 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1589 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1591 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1592 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1595 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1596 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1597 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1603 (match fst style with
1606 failwithf "RConstString cannot be returned from a daemon function"
1608 | RBool _ | RString _ | RStringList _
1610 | RPVList _ | RVGList _ | RLVList _ ->
1611 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1612 pr " error (g, \"%s: failed to parse reply\");\n" name;
1618 pr " rv->cb_done = 1;\n";
1619 pr " main_loop.main_loop_quit (g);\n";
1622 (* Generate the action stub. *)
1623 generate_prototype ~extern:false ~semicolon:false ~newline:true
1624 ~handle:"g" name style;
1627 match fst style with
1628 | RErr | RInt _ | RBool _ -> "-1"
1630 failwithf "RConstString cannot be returned from a daemon function"
1631 | RString _ | RStringList _ | RIntBool _
1632 | RPVList _ | RVGList _ | RLVList _ ->
1637 (match snd style with
1639 | _ -> pr " struct %s_args args;\n" name
1642 pr " struct %s_rv rv;\n" shortname;
1643 pr " int serial;\n";
1645 pr " if (g->state != READY) {\n";
1646 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1649 pr " return %s;\n" error_code;
1652 pr " memset (&rv, 0, sizeof rv);\n";
1655 (match snd style with
1657 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1658 (String.uppercase shortname)
1663 pr " args.%s = (char *) %s;\n" n n
1665 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1667 pr " args.%s.%s_val = (char **) %s;\n" n n n;
1668 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
1670 pr " args.%s = %s;\n" n n
1672 pr " args.%s = %s;\n" n n
1674 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1675 (String.uppercase shortname);
1676 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1679 pr " if (serial == -1)\n";
1680 pr " return %s;\n" error_code;
1683 pr " rv.cb_done = 0;\n";
1684 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1685 pr " g->reply_cb_internal_data = &rv;\n";
1686 pr " main_loop.main_loop_run (g);\n";
1687 pr " g->reply_cb_internal = NULL;\n";
1688 pr " g->reply_cb_internal_data = NULL;\n";
1689 pr " if (!rv.cb_done) {\n";
1690 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1691 pr " return %s;\n" error_code;
1695 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1696 (String.uppercase shortname);
1697 pr " return %s;\n" error_code;
1700 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1701 pr " error (g, \"%%s\", rv.err.error);\n";
1702 pr " return %s;\n" error_code;
1706 (match fst style with
1707 | RErr -> pr " return 0;\n"
1709 | RBool n -> pr " return rv.ret.%s;\n" n
1711 failwithf "RConstString cannot be returned from a daemon function"
1713 pr " return rv.ret.%s; /* caller will free */\n" n
1715 pr " /* caller will free this, but we need to add a NULL entry */\n";
1716 pr " rv.ret.%s.%s_val =" n n;
1717 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1718 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1720 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1721 pr " return rv.ret.%s.%s_val;\n" n n
1723 pr " /* caller with free this */\n";
1724 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1726 pr " /* caller will free this */\n";
1727 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1729 pr " /* caller will free this */\n";
1730 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1732 pr " /* caller will free this */\n";
1733 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1739 (* Generate daemon/actions.h. *)
1740 and generate_daemon_actions_h () =
1741 generate_header CStyle GPLv2;
1743 pr "#include \"../src/guestfs_protocol.h\"\n";
1747 fun (name, style, _, _, _, _, _) ->
1749 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1753 (* Generate the server-side stubs. *)
1754 and generate_daemon_actions () =
1755 generate_header CStyle GPLv2;
1757 pr "#define _GNU_SOURCE // for strchrnul\n";
1759 pr "#include <stdio.h>\n";
1760 pr "#include <stdlib.h>\n";
1761 pr "#include <string.h>\n";
1762 pr "#include <inttypes.h>\n";
1763 pr "#include <ctype.h>\n";
1764 pr "#include <rpc/types.h>\n";
1765 pr "#include <rpc/xdr.h>\n";
1767 pr "#include \"daemon.h\"\n";
1768 pr "#include \"../src/guestfs_protocol.h\"\n";
1769 pr "#include \"actions.h\"\n";
1773 fun (name, style, _, _, _, _, _) ->
1774 (* Generate server-side stubs. *)
1775 pr "static void %s_stub (XDR *xdr_in)\n" name;
1778 match fst style with
1779 | RErr | RInt _ -> pr " int r;\n"; "-1"
1780 | RBool _ -> pr " int r;\n"; "-1"
1782 failwithf "RConstString cannot be returned from a daemon function"
1783 | RString _ -> pr " char *r;\n"; "NULL"
1784 | RStringList _ -> pr " char **r;\n"; "NULL"
1785 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1786 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1787 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1788 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1790 (match snd style with
1793 pr " struct guestfs_%s_args args;\n" name;
1797 | OptString n -> pr " const char *%s;\n" n
1798 | StringList n -> pr " char **%s;\n" n
1799 | Bool n -> pr " int %s;\n" n
1800 | Int n -> pr " int %s;\n" n
1805 (match snd style with
1808 pr " memset (&args, 0, sizeof args);\n";
1810 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1811 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1816 | String n -> pr " %s = args.%s;\n" n n
1817 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1819 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
1820 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
1821 pr " %s = args.%s.%s_val;\n" n n n
1822 | Bool n -> pr " %s = args.%s;\n" n n
1823 | Int n -> pr " %s = args.%s;\n" n n
1828 pr " r = do_%s " name;
1829 generate_call_args style;
1832 pr " if (r == %s)\n" error_code;
1833 pr " /* do_%s has already called reply_with_error */\n" name;
1837 (match fst style with
1838 | RErr -> pr " reply (NULL, NULL);\n"
1840 pr " struct guestfs_%s_ret ret;\n" name;
1841 pr " ret.%s = r;\n" n;
1842 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1844 pr " struct guestfs_%s_ret ret;\n" name;
1845 pr " ret.%s = r;\n" n;
1846 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1848 failwithf "RConstString cannot be returned from a daemon function"
1850 pr " struct guestfs_%s_ret ret;\n" name;
1851 pr " ret.%s = r;\n" n;
1852 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1855 pr " struct guestfs_%s_ret ret;\n" name;
1856 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1857 pr " ret.%s.%s_val = r;\n" n n;
1858 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1859 pr " free_strings (r);\n"
1861 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1862 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1864 pr " struct guestfs_%s_ret ret;\n" name;
1865 pr " ret.%s = *r;\n" n;
1866 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1867 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1869 pr " struct guestfs_%s_ret ret;\n" name;
1870 pr " ret.%s = *r;\n" n;
1871 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1872 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1874 pr " struct guestfs_%s_ret ret;\n" name;
1875 pr " ret.%s = *r;\n" n;
1876 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1877 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1880 (* Free the args. *)
1881 (match snd style with
1886 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
1893 (* Dispatch function. *)
1894 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1896 pr " switch (proc_nr) {\n";
1899 fun (name, style, _, _, _, _, _) ->
1900 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1901 pr " %s_stub (xdr_in);\n" name;
1906 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1911 (* LVM columns and tokenization functions. *)
1912 (* XXX This generates crap code. We should rethink how we
1918 pr "static const char *lvm_%s_cols = \"%s\";\n"
1919 typ (String.concat "," (List.map fst cols));
1922 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1924 pr " char *tok, *p, *next;\n";
1928 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1931 pr " if (!str) {\n";
1932 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1935 pr " if (!*str || isspace (*str)) {\n";
1936 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1941 fun (name, coltype) ->
1942 pr " if (!tok) {\n";
1943 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1946 pr " p = strchrnul (tok, ',');\n";
1947 pr " if (*p) next = p+1; else next = NULL;\n";
1948 pr " *p = '\\0';\n";
1951 pr " r->%s = strdup (tok);\n" name;
1952 pr " if (r->%s == NULL) {\n" name;
1953 pr " perror (\"strdup\");\n";
1957 pr " for (i = j = 0; i < 32; ++j) {\n";
1958 pr " if (tok[j] == '\\0') {\n";
1959 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1961 pr " } else if (tok[j] != '-')\n";
1962 pr " r->%s[i++] = tok[j];\n" name;
1965 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1966 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1970 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1971 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1975 pr " if (tok[0] == '\\0')\n";
1976 pr " r->%s = -1;\n" name;
1977 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1978 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1982 pr " tok = next;\n";
1985 pr " if (tok != NULL) {\n";
1986 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1993 pr "guestfs_lvm_int_%s_list *\n" typ;
1994 pr "parse_command_line_%ss (void)\n" typ;
1996 pr " char *out, *err;\n";
1997 pr " char *p, *pend;\n";
1999 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2000 pr " void *newp;\n";
2002 pr " ret = malloc (sizeof *ret);\n";
2003 pr " if (!ret) {\n";
2004 pr " reply_with_perror (\"malloc\");\n";
2005 pr " return NULL;\n";
2008 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2009 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2011 pr " r = command (&out, &err,\n";
2012 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2013 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2014 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2015 pr " if (r == -1) {\n";
2016 pr " reply_with_error (\"%%s\", err);\n";
2017 pr " free (out);\n";
2018 pr " free (err);\n";
2019 pr " return NULL;\n";
2022 pr " free (err);\n";
2024 pr " /* Tokenize each line of the output. */\n";
2027 pr " while (p) {\n";
2028 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2029 pr " if (pend) {\n";
2030 pr " *pend = '\\0';\n";
2034 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2037 pr " if (!*p) { /* Empty line? Skip it. */\n";
2042 pr " /* Allocate some space to store this next entry. */\n";
2043 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2044 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2045 pr " if (newp == NULL) {\n";
2046 pr " reply_with_perror (\"realloc\");\n";
2047 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2048 pr " free (ret);\n";
2049 pr " free (out);\n";
2050 pr " return NULL;\n";
2052 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2054 pr " /* Tokenize the next entry. */\n";
2055 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2056 pr " if (r == -1) {\n";
2057 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2058 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2059 pr " free (ret);\n";
2060 pr " free (out);\n";
2061 pr " return NULL;\n";
2068 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2070 pr " free (out);\n";
2071 pr " return ret;\n";
2074 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2076 (* Generate the tests. *)
2077 and generate_tests () =
2078 generate_header CStyle GPLv2;
2085 #include <sys/types.h>
2088 #include \"guestfs.h\"
2090 static guestfs_h *g;
2091 static int suppress_error = 0;
2093 static void print_error (guestfs_h *g, void *data, const char *msg)
2095 if (!suppress_error)
2096 fprintf (stderr, \"%%s\\n\", msg);
2099 static void print_strings (char * const * const argv)
2103 for (argc = 0; argv[argc] != NULL; ++argc)
2104 printf (\"\\t%%s\\n\", argv[argc]);
2111 fun (name, _, _, _, tests, _, _) ->
2112 mapi (generate_one_test name) tests
2114 let test_names = List.concat test_names in
2115 let nr_tests = List.length test_names in
2118 int main (int argc, char *argv[])
2126 g = guestfs_create ();
2128 printf (\"guestfs_create FAILED\\n\");
2132 guestfs_set_error_handler (g, print_error, NULL);
2134 srcdir = getenv (\"srcdir\");
2135 if (!srcdir) srcdir = \".\";
2136 guestfs_set_path (g, srcdir);
2138 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2139 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2144 if (lseek (fd, %d, SEEK_SET) == -1) {
2150 if (write (fd, &c, 1) == -1) {
2156 if (close (fd) == -1) {
2161 if (guestfs_add_drive (g, buf) == -1) {
2162 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2166 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2167 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2172 if (lseek (fd, %d, SEEK_SET) == -1) {
2178 if (write (fd, &c, 1) == -1) {
2184 if (close (fd) == -1) {
2189 if (guestfs_add_drive (g, buf) == -1) {
2190 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2194 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2195 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2200 if (lseek (fd, %d, SEEK_SET) == -1) {
2206 if (write (fd, &c, 1) == -1) {
2212 if (close (fd) == -1) {
2217 if (guestfs_add_drive (g, buf) == -1) {
2218 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2222 if (guestfs_launch (g) == -1) {
2223 printf (\"guestfs_launch FAILED\\n\");
2226 if (guestfs_wait_ready (g) == -1) {
2227 printf (\"guestfs_wait_ready FAILED\\n\");
2231 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
2235 pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
2236 pr " if (%s () == -1) {\n" test_name;
2237 pr " printf (\"%s FAILED\\n\");\n" test_name;
2243 pr " guestfs_close (g);\n";
2244 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2245 pr " unlink (buf);\n";
2246 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2247 pr " unlink (buf);\n";
2248 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2249 pr " unlink (buf);\n";
2252 pr " if (failed > 0) {\n";
2253 pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
2262 and generate_one_test name i (init, test) =
2263 let test_name = sprintf "test_%s_%d" name i in
2265 pr "static int %s (void)\n" test_name;
2271 pr " /* InitEmpty for %s (%d) */\n" name i;
2272 List.iter (generate_test_command_call test_name)
2276 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2277 List.iter (generate_test_command_call test_name)
2280 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2281 ["mkfs"; "ext2"; "/dev/sda1"];
2282 ["mount"; "/dev/sda1"; "/"]]
2283 | InitBasicFSonLVM ->
2284 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2286 List.iter (generate_test_command_call test_name)
2289 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2290 ["pvcreate"; "/dev/sda1"];
2291 ["vgcreate"; "VG"; "/dev/sda1"];
2292 ["lvcreate"; "LV"; "VG"; "8"];
2293 ["mkfs"; "ext2"; "/dev/VG/LV"];
2294 ["mount"; "/dev/VG/LV"; "/"]]
2297 let get_seq_last = function
2299 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2302 let seq = List.rev seq in
2303 List.rev (List.tl seq), List.hd seq
2308 pr " /* TestRun for %s (%d) */\n" name i;
2309 List.iter (generate_test_command_call test_name) seq
2310 | TestOutput (seq, expected) ->
2311 pr " /* TestOutput for %s (%d) */\n" name i;
2312 let seq, last = get_seq_last seq in
2314 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2315 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2319 List.iter (generate_test_command_call test_name) seq;
2320 generate_test_command_call ~test test_name last
2321 | TestOutputList (seq, expected) ->
2322 pr " /* TestOutputList for %s (%d) */\n" name i;
2323 let seq, last = get_seq_last seq in
2327 pr " if (!r[%d]) {\n" i;
2328 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2329 pr " print_strings (r);\n";
2332 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2333 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2337 pr " if (r[%d] != NULL) {\n" (List.length expected);
2338 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2340 pr " print_strings (r);\n";
2344 List.iter (generate_test_command_call test_name) seq;
2345 generate_test_command_call ~test test_name last
2346 | TestOutputInt (seq, expected) ->
2347 pr " /* TestOutputInt for %s (%d) */\n" name i;
2348 let seq, last = get_seq_last seq in
2350 pr " if (r != %d) {\n" expected;
2351 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
2356 List.iter (generate_test_command_call test_name) seq;
2357 generate_test_command_call ~test test_name last
2358 | TestOutputTrue seq ->
2359 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2360 let seq, last = get_seq_last seq in
2363 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2368 List.iter (generate_test_command_call test_name) seq;
2369 generate_test_command_call ~test test_name last
2370 | TestOutputFalse seq ->
2371 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2372 let seq, last = get_seq_last seq in
2375 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2380 List.iter (generate_test_command_call test_name) seq;
2381 generate_test_command_call ~test test_name last
2382 | TestOutputLength (seq, expected) ->
2383 pr " /* TestOutputLength for %s (%d) */\n" name i;
2384 let seq, last = get_seq_last seq in
2387 pr " for (j = 0; j < %d; ++j)\n" expected;
2388 pr " if (r[j] == NULL) {\n";
2389 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2391 pr " print_strings (r);\n";
2394 pr " if (r[j] != NULL) {\n";
2395 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2397 pr " print_strings (r);\n";
2401 List.iter (generate_test_command_call test_name) seq;
2402 generate_test_command_call ~test test_name last
2403 | TestLastFail seq ->
2404 pr " /* TestLastFail for %s (%d) */\n" name i;
2405 let seq, last = get_seq_last seq in
2406 List.iter (generate_test_command_call test_name) seq;
2407 generate_test_command_call test_name ~expect_error:true last
2415 (* Generate the code to run a command, leaving the result in 'r'.
2416 * If you expect to get an error then you should set expect_error:true.
2418 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2420 | [] -> assert false
2422 (* Look up the command to find out what args/ret it has. *)
2425 let _, style, _, _, _, _, _ =
2426 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2429 failwithf "%s: in test, command %s was not found" test_name name in
2431 if List.length (snd style) <> List.length args then
2432 failwithf "%s: in test, wrong number of args given to %s"
2443 | StringList n, arg ->
2444 pr " char *%s[] = {\n" n;
2445 let strs = string_split " " arg in
2447 fun str -> pr " \"%s\",\n" (c_quote str)
2451 ) (List.combine (snd style) args);
2454 match fst style with
2455 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2456 | RConstString _ -> pr " const char *r;\n"; "NULL"
2457 | RString _ -> pr " char *r;\n"; "NULL"
2463 pr " struct guestfs_int_bool *r;\n";
2466 pr " struct guestfs_lvm_pv_list *r;\n";
2469 pr " struct guestfs_lvm_vg_list *r;\n";
2472 pr " struct guestfs_lvm_lv_list *r;\n";
2475 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2476 pr " r = guestfs_%s (g" name;
2478 (* Generate the parameters. *)
2481 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2482 | OptString _, arg ->
2483 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2484 | StringList n, _ ->
2488 try int_of_string arg
2489 with Failure "int_of_string" ->
2490 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2493 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2494 ) (List.combine (snd style) args);
2497 if not expect_error then
2498 pr " if (r == %s)\n" error_code
2500 pr " if (r != %s)\n" error_code;
2503 (* Insert the test code. *)
2509 (match fst style with
2510 | RErr | RInt _ | RBool _ | RConstString _ -> ()
2511 | RString _ -> pr " free (r);\n"
2513 pr " for (i = 0; r[i] != NULL; ++i)\n";
2514 pr " free (r[i]);\n";
2517 pr " guestfs_free_int_bool (r);\n"
2519 pr " guestfs_free_lvm_pv_list (r);\n"
2521 pr " guestfs_free_lvm_vg_list (r);\n"
2523 pr " guestfs_free_lvm_lv_list (r);\n"
2529 let str = replace_str str "\r" "\\r" in
2530 let str = replace_str str "\n" "\\n" in
2531 let str = replace_str str "\t" "\\t" in
2534 (* Generate a lot of different functions for guestfish. *)
2535 and generate_fish_cmds () =
2536 generate_header CStyle GPLv2;
2540 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2542 let all_functions_sorted =
2544 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2545 ) all_functions_sorted in
2547 pr "#include <stdio.h>\n";
2548 pr "#include <stdlib.h>\n";
2549 pr "#include <string.h>\n";
2550 pr "#include <inttypes.h>\n";
2552 pr "#include <guestfs.h>\n";
2553 pr "#include \"fish.h\"\n";
2556 (* list_commands function, which implements guestfish -h *)
2557 pr "void list_commands (void)\n";
2559 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2560 pr " list_builtin_commands ();\n";
2562 fun (name, _, _, flags, _, shortdesc, _) ->
2563 let name = replace_char name '_' '-' in
2564 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2566 ) all_functions_sorted;
2567 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2571 (* display_command function, which implements guestfish -h cmd *)
2572 pr "void display_command (const char *cmd)\n";
2575 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2576 let name2 = replace_char name '_' '-' in
2578 try find_map (function FishAlias n -> Some n | _ -> None) flags
2579 with Not_found -> name in
2580 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2582 match snd style with
2586 name2 (String.concat "> <" (List.map name_of_argt args)) in
2589 if List.mem ProtocolLimitWarning flags then
2590 ("\n\n" ^ protocol_limit_warning)
2593 (* For DangerWillRobinson commands, we should probably have
2594 * guestfish prompt before allowing you to use them (especially
2595 * in interactive mode). XXX
2599 if List.mem DangerWillRobinson flags then
2600 ("\n\n" ^ danger_will_robinson)
2603 let describe_alias =
2604 if name <> alias then
2605 sprintf "\n\nYou can use '%s' as an alias for this command." alias
2609 pr "strcasecmp (cmd, \"%s\") == 0" name;
2610 if name <> name2 then
2611 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2612 if name <> alias then
2613 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2615 pr " pod2text (\"%s - %s\", %S);\n"
2617 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
2620 pr " display_builtin_command (cmd);\n";
2624 (* print_{pv,vg,lv}_list functions *)
2628 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
2635 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
2637 pr " printf (\"%s: \");\n" name;
2638 pr " for (i = 0; i < 32; ++i)\n";
2639 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
2640 pr " printf (\"\\n\");\n"
2642 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
2644 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2645 | name, `OptPercent ->
2646 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
2647 typ name name typ name;
2648 pr " else printf (\"%s: \\n\");\n" name
2652 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
2657 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
2658 pr " print_%s (&%ss->val[i]);\n" typ typ;
2661 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2663 (* run_<action> actions *)
2665 fun (name, style, _, flags, _, _, _) ->
2666 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
2668 (match fst style with
2671 | RBool _ -> pr " int r;\n"
2672 | RConstString _ -> pr " const char *r;\n"
2673 | RString _ -> pr " char *r;\n"
2674 | RStringList _ -> pr " char **r;\n"
2675 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
2676 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
2677 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
2678 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
2683 | OptString n -> pr " const char *%s;\n" n
2684 | StringList n -> pr " char **%s;\n" n
2685 | Bool n -> pr " int %s;\n" n
2686 | Int n -> pr " int %s;\n" n
2689 (* Check and convert parameters. *)
2690 let argc_expected = List.length (snd style) in
2691 pr " if (argc != %d) {\n" argc_expected;
2692 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
2694 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
2700 | String name -> pr " %s = argv[%d];\n" name i
2702 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
2704 | StringList name ->
2705 pr " %s = parse_string_list (argv[%d]);\n" name i
2707 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
2709 pr " %s = atoi (argv[%d]);\n" name i
2712 (* Call C API function. *)
2714 try find_map (function FishAction n -> Some n | _ -> None) flags
2715 with Not_found -> sprintf "guestfs_%s" name in
2717 generate_call_args ~handle:"g" style;
2720 (* Check return value for errors and display command results. *)
2721 (match fst style with
2722 | RErr -> pr " return r;\n"
2724 pr " if (r == -1) return -1;\n";
2725 pr " if (r) printf (\"%%d\\n\", r);\n";
2728 pr " if (r == -1) return -1;\n";
2729 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
2732 pr " if (r == NULL) return -1;\n";
2733 pr " printf (\"%%s\\n\", r);\n";
2736 pr " if (r == NULL) return -1;\n";
2737 pr " printf (\"%%s\\n\", r);\n";
2741 pr " if (r == NULL) return -1;\n";
2742 pr " print_strings (r);\n";
2743 pr " free_strings (r);\n";
2746 pr " if (r == NULL) return -1;\n";
2747 pr " printf (\"%%d, %%s\\n\", r->i,\n";
2748 pr " r->b ? \"true\" : \"false\");\n";
2749 pr " guestfs_free_int_bool (r);\n";
2752 pr " if (r == NULL) return -1;\n";
2753 pr " print_pv_list (r);\n";
2754 pr " guestfs_free_lvm_pv_list (r);\n";
2757 pr " if (r == NULL) return -1;\n";
2758 pr " print_vg_list (r);\n";
2759 pr " guestfs_free_lvm_vg_list (r);\n";
2762 pr " if (r == NULL) return -1;\n";
2763 pr " print_lv_list (r);\n";
2764 pr " guestfs_free_lvm_lv_list (r);\n";
2771 (* run_action function *)
2772 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
2775 fun (name, _, _, flags, _, _, _) ->
2776 let name2 = replace_char name '_' '-' in
2778 try find_map (function FishAlias n -> Some n | _ -> None) flags
2779 with Not_found -> name in
2781 pr "strcasecmp (cmd, \"%s\") == 0" name;
2782 if name <> name2 then
2783 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2784 if name <> alias then
2785 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2787 pr " return run_%s (cmd, argc, argv);\n" name;
2791 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
2798 (* Generate the POD documentation for guestfish. *)
2799 and generate_fish_actions_pod () =
2800 let all_functions_sorted =
2802 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2803 ) all_functions_sorted in
2806 fun (name, style, _, flags, _, _, longdesc) ->
2807 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2808 let name = replace_char name '_' '-' in
2810 try find_map (function FishAlias n -> Some n | _ -> None) flags
2811 with Not_found -> name in
2813 pr "=head2 %s" name;
2814 if name <> alias then
2821 | String n -> pr " %s" n
2822 | OptString n -> pr " %s" n
2823 | StringList n -> pr " %s,..." n
2824 | Bool _ -> pr " true|false"
2825 | Int n -> pr " %s" n
2829 pr "%s\n\n" longdesc;
2831 if List.mem ProtocolLimitWarning flags then
2832 pr "%s\n\n" protocol_limit_warning;
2834 if List.mem DangerWillRobinson flags then
2835 pr "%s\n\n" danger_will_robinson
2836 ) all_functions_sorted
2838 (* Generate a C function prototype. *)
2839 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
2840 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
2842 ?handle name style =
2843 if extern then pr "extern ";
2844 if static then pr "static ";
2845 (match fst style with
2847 | RInt _ -> pr "int "
2848 | RBool _ -> pr "int "
2849 | RConstString _ -> pr "const char *"
2850 | RString _ -> pr "char *"
2851 | RStringList _ -> pr "char **"
2853 if not in_daemon then pr "struct guestfs_int_bool *"
2854 else pr "guestfs_%s_ret *" name
2856 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
2857 else pr "guestfs_lvm_int_pv_list *"
2859 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
2860 else pr "guestfs_lvm_int_vg_list *"
2862 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
2863 else pr "guestfs_lvm_int_lv_list *"
2865 pr "%s%s (" prefix name;
2866 if handle = None && List.length (snd style) = 0 then
2869 let comma = ref false in
2872 | Some handle -> pr "guestfs_h *%s" handle; comma := true
2876 if single_line then pr ", " else pr ",\n\t\t"
2882 | String n -> next (); pr "const char *%s" n
2883 | OptString n -> next (); pr "const char *%s" n
2884 | StringList n -> next (); pr "char * const* const %s" n
2885 | Bool n -> next (); pr "int %s" n
2886 | Int n -> next (); pr "int %s" n
2890 if semicolon then pr ";";
2891 if newline then pr "\n"
2893 (* Generate C call arguments, eg "(handle, foo, bar)" *)
2894 and generate_call_args ?handle style =
2896 let comma = ref false in
2899 | Some handle -> pr "%s" handle; comma := true
2903 if !comma then pr ", ";
2910 | Int n -> pr "%s" n
2914 (* Generate the OCaml bindings interface. *)
2915 and generate_ocaml_mli () =
2916 generate_header OCamlStyle LGPLv2;
2919 (** For API documentation you should refer to the C API
2920 in the guestfs(3) manual page. The OCaml API uses almost
2921 exactly the same calls. *)
2924 (** A [guestfs_h] handle. *)
2926 exception Error of string
2927 (** This exception is raised when there is an error. *)
2929 val create : unit -> t
2931 val close : t -> unit
2932 (** Handles are closed by the garbage collector when they become
2933 unreferenced, but callers can also call this in order to
2934 provide predictable cleanup. *)
2937 generate_ocaml_lvm_structure_decls ();
2941 fun (name, style, _, _, _, shortdesc, _) ->
2942 generate_ocaml_prototype name style;
2943 pr "(** %s *)\n" shortdesc;
2947 (* Generate the OCaml bindings implementation. *)
2948 and generate_ocaml_ml () =
2949 generate_header OCamlStyle LGPLv2;
2953 exception Error of string
2954 external create : unit -> t = \"ocaml_guestfs_create\"
2955 external close : t -> unit = \"ocaml_guestfs_close\"
2958 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
2962 generate_ocaml_lvm_structure_decls ();
2966 fun (name, style, _, _, _, shortdesc, _) ->
2967 generate_ocaml_prototype ~is_external:true name style;
2970 (* Generate the OCaml bindings C implementation. *)
2971 and generate_ocaml_c () =
2972 generate_header CStyle LGPLv2;
2974 pr "#include <stdio.h>\n";
2975 pr "#include <stdlib.h>\n";
2976 pr "#include <string.h>\n";
2978 pr "#include <caml/config.h>\n";
2979 pr "#include <caml/alloc.h>\n";
2980 pr "#include <caml/callback.h>\n";
2981 pr "#include <caml/fail.h>\n";
2982 pr "#include <caml/memory.h>\n";
2983 pr "#include <caml/mlvalues.h>\n";
2984 pr "#include <caml/signals.h>\n";
2986 pr "#include <guestfs.h>\n";
2988 pr "#include \"guestfs_c.h\"\n";
2991 (* LVM struct copy functions. *)
2994 let has_optpercent_col =
2995 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
2997 pr "static CAMLprim value\n";
2998 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3000 pr " CAMLparam0 ();\n";
3001 if has_optpercent_col then
3002 pr " CAMLlocal3 (rv, v, v2);\n"
3004 pr " CAMLlocal2 (rv, v);\n";
3006 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3011 pr " v = caml_copy_string (%s->%s);\n" typ name
3013 pr " v = caml_alloc_string (32);\n";
3014 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3017 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3018 | name, `OptPercent ->
3019 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3020 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3021 pr " v = caml_alloc (1, 0);\n";
3022 pr " Store_field (v, 0, v2);\n";
3023 pr " } else /* None */\n";
3024 pr " v = Val_int (0);\n";
3026 pr " Store_field (rv, %d, v);\n" i
3028 pr " CAMLreturn (rv);\n";
3032 pr "static CAMLprim value\n";
3033 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3036 pr " CAMLparam0 ();\n";
3037 pr " CAMLlocal2 (rv, v);\n";
3040 pr " if (%ss->len == 0)\n" typ;
3041 pr " CAMLreturn (Atom (0));\n";
3043 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3044 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3045 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3046 pr " caml_modify (&Field (rv, i), v);\n";
3048 pr " CAMLreturn (rv);\n";
3052 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3055 fun (name, style, _, _, _, _, _) ->
3057 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3059 pr "CAMLprim value\n";
3060 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3061 List.iter (pr ", value %s") (List.tl params);
3066 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3067 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3068 pr " CAMLxparam%d (%s);\n"
3069 (List.length rest) (String.concat ", " rest)
3071 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3073 pr " CAMLlocal1 (rv);\n";
3076 pr " guestfs_h *g = Guestfs_val (gv);\n";
3077 pr " if (g == NULL)\n";
3078 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3084 pr " const char *%s = String_val (%sv);\n" n n
3086 pr " const char *%s =\n" n;
3087 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3090 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3092 pr " int %s = Bool_val (%sv);\n" n n
3094 pr " int %s = Int_val (%sv);\n" n n
3097 match fst style with
3098 | RErr -> pr " int r;\n"; "-1"
3099 | RInt _ -> pr " int r;\n"; "-1"
3100 | RBool _ -> pr " int r;\n"; "-1"
3101 | RConstString _ -> pr " const char *r;\n"; "NULL"
3102 | RString _ -> pr " char *r;\n"; "NULL"
3108 pr " struct guestfs_int_bool *r;\n";
3111 pr " struct guestfs_lvm_pv_list *r;\n";
3114 pr " struct guestfs_lvm_vg_list *r;\n";
3117 pr " struct guestfs_lvm_lv_list *r;\n";
3121 pr " caml_enter_blocking_section ();\n";
3122 pr " r = guestfs_%s " name;
3123 generate_call_args ~handle:"g" style;
3125 pr " caml_leave_blocking_section ();\n";
3130 pr " ocaml_guestfs_free_strings (%s);\n" n;
3131 | String _ | OptString _ | Bool _ | Int _ -> ()
3134 pr " if (r == %s)\n" error_code;
3135 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3138 (match fst style with
3139 | RErr -> pr " rv = Val_unit;\n"
3140 | RInt _ -> pr " rv = Val_int (r);\n"
3141 | RBool _ -> pr " rv = Val_bool (r);\n"
3142 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3144 pr " rv = caml_copy_string (r);\n";
3147 pr " rv = caml_copy_string_array ((const char **) r);\n";
3148 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3151 pr " rv = caml_alloc (2, 0);\n";
3152 pr " Store_field (rv, 0, Val_int (r->i));\n";
3153 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3154 pr " guestfs_free_int_bool (r);\n";
3156 pr " rv = copy_lvm_pv_list (r);\n";
3157 pr " guestfs_free_lvm_pv_list (r);\n";
3159 pr " rv = copy_lvm_vg_list (r);\n";
3160 pr " guestfs_free_lvm_vg_list (r);\n";
3162 pr " rv = copy_lvm_lv_list (r);\n";
3163 pr " guestfs_free_lvm_lv_list (r);\n";
3166 pr " CAMLreturn (rv);\n";
3170 if List.length params > 5 then (
3171 pr "CAMLprim value\n";
3172 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3174 pr " return ocaml_guestfs_%s (argv[0]" name;
3175 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3182 and generate_ocaml_lvm_structure_decls () =
3185 pr "type lvm_%s = {\n" typ;
3188 | name, `String -> pr " %s : string;\n" name
3189 | name, `UUID -> pr " %s : string;\n" name
3190 | name, `Bytes -> pr " %s : int64;\n" name
3191 | name, `Int -> pr " %s : int64;\n" name
3192 | name, `OptPercent -> pr " %s : float option;\n" name
3196 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3198 and generate_ocaml_prototype ?(is_external = false) name style =
3199 if is_external then pr "external " else pr "val ";
3200 pr "%s : t -> " name;
3203 | String _ -> pr "string -> "
3204 | OptString _ -> pr "string option -> "
3205 | StringList _ -> pr "string array -> "
3206 | Bool _ -> pr "bool -> "
3207 | Int _ -> pr "int -> "
3209 (match fst style with
3210 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3211 | RInt _ -> pr "int"
3212 | RBool _ -> pr "bool"
3213 | RConstString _ -> pr "string"
3214 | RString _ -> pr "string"
3215 | RStringList _ -> pr "string array"
3216 | RIntBool _ -> pr "int * bool"
3217 | RPVList _ -> pr "lvm_pv array"
3218 | RVGList _ -> pr "lvm_vg array"
3219 | RLVList _ -> pr "lvm_lv array"
3221 if is_external then (
3223 if List.length (snd style) + 1 > 5 then
3224 pr "\"ocaml_guestfs_%s_byte\" " name;
3225 pr "\"ocaml_guestfs_%s\"" name
3229 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3230 and generate_perl_xs () =
3231 generate_header CStyle LGPLv2;
3234 #include \"EXTERN.h\"
3238 #include <guestfs.h>
3241 #define PRId64 \"lld\"
3245 my_newSVll(long long val) {
3246 #ifdef USE_64_BIT_ALL
3247 return newSViv(val);
3251 len = snprintf(buf, 100, \"%%\" PRId64, val);
3252 return newSVpv(buf, len);
3257 #define PRIu64 \"llu\"
3261 my_newSVull(unsigned long long val) {
3262 #ifdef USE_64_BIT_ALL
3263 return newSVuv(val);
3267 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3268 return newSVpv(buf, len);
3272 /* http://www.perlmonks.org/?node_id=680842 */
3274 XS_unpack_charPtrPtr (SV *arg) {
3279 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3280 croak (\"array reference expected\");
3283 av = (AV *)SvRV (arg);
3284 ret = (char **)malloc (av_len (av) + 1 + 1);
3286 for (i = 0; i <= av_len (av); i++) {
3287 SV **elem = av_fetch (av, i, 0);
3289 if (!elem || !*elem)
3290 croak (\"missing element in list\");
3292 ret[i] = SvPV_nolen (*elem);
3300 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3305 RETVAL = guestfs_create ();
3307 croak (\"could not create guestfs handle\");
3308 guestfs_set_error_handler (RETVAL, NULL, NULL);
3321 fun (name, style, _, _, _, _, _) ->
3322 (match fst style with
3323 | RErr -> pr "void\n"
3324 | RInt _ -> pr "SV *\n"
3325 | RBool _ -> pr "SV *\n"
3326 | RConstString _ -> pr "SV *\n"
3327 | RString _ -> pr "SV *\n"
3330 | RPVList _ | RVGList _ | RLVList _ ->
3331 pr "void\n" (* all lists returned implictly on the stack *)
3333 (* Call and arguments. *)
3335 generate_call_args ~handle:"g" style;
3337 pr " guestfs_h *g;\n";
3340 | String n -> pr " char *%s;\n" n
3341 | OptString n -> pr " char *%s;\n" n
3342 | StringList n -> pr " char **%s;\n" n
3343 | Bool n -> pr " int %s;\n" n
3344 | Int n -> pr " int %s;\n" n
3347 let do_cleanups () =
3354 | StringList n -> pr " free (%s);\n" n
3359 (match fst style with
3362 pr " if (guestfs_%s " name;
3363 generate_call_args ~handle:"g" style;
3366 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3373 pr " %s = guestfs_%s " n name;
3374 generate_call_args ~handle:"g" style;
3376 pr " if (%s == -1) {\n" n;
3378 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3380 pr " RETVAL = newSViv (%s);\n" n;
3385 pr " const char *%s;\n" n;
3387 pr " %s = guestfs_%s " n name;
3388 generate_call_args ~handle:"g" style;
3390 pr " if (%s == NULL) {\n" n;
3392 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3394 pr " RETVAL = newSVpv (%s, 0);\n" n;
3399 pr " char *%s;\n" n;
3401 pr " %s = guestfs_%s " n name;
3402 generate_call_args ~handle:"g" style;
3404 pr " if (%s == NULL) {\n" n;
3406 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3408 pr " RETVAL = newSVpv (%s, 0);\n" n;
3409 pr " free (%s);\n" n;
3414 pr " char **%s;\n" n;
3417 pr " %s = guestfs_%s " n name;
3418 generate_call_args ~handle:"g" style;
3420 pr " if (%s == NULL) {\n" n;
3422 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3424 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
3425 pr " EXTEND (SP, n);\n";
3426 pr " for (i = 0; i < n; ++i) {\n";
3427 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
3428 pr " free (%s[i]);\n" n;
3430 pr " free (%s);\n" n;
3433 pr " struct guestfs_int_bool *r;\n";
3435 pr " r = guestfs_%s " name;
3436 generate_call_args ~handle:"g" style;
3438 pr " if (r == NULL) {\n";
3440 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3442 pr " EXTEND (SP, 2);\n";
3443 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
3444 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
3445 pr " guestfs_free_int_bool (r);\n";
3447 generate_perl_lvm_code "pv" pv_cols name style n;
3449 generate_perl_lvm_code "vg" vg_cols name style n;
3451 generate_perl_lvm_code "lv" lv_cols name style n;
3459 and generate_perl_lvm_code typ cols name style n =
3461 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
3465 pr " %s = guestfs_%s " n name;
3466 generate_call_args ~handle:"g" style;
3468 pr " if (%s == NULL)\n" n;
3469 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3470 pr " EXTEND (SP, %s->len);\n" n;
3471 pr " for (i = 0; i < %s->len; ++i) {\n" n;
3472 pr " hv = newHV ();\n";
3476 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
3477 name (String.length name) n name
3479 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
3480 name (String.length name) n name
3482 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
3483 name (String.length name) n name
3485 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
3486 name (String.length name) n name
3487 | name, `OptPercent ->
3488 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
3489 name (String.length name) n name
3491 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
3493 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
3495 (* Generate Sys/Guestfs.pm. *)
3496 and generate_perl_pm () =
3497 generate_header HashStyle LGPLv2;
3504 Sys::Guestfs - Perl bindings for libguestfs
3510 my $h = Sys::Guestfs->new ();
3511 $h->add_drive ('guest.img');
3514 $h->mount ('/dev/sda1', '/');
3515 $h->touch ('/hello');
3520 The C<Sys::Guestfs> module provides a Perl XS binding to the
3521 libguestfs API for examining and modifying virtual machine
3524 Amongst the things this is good for: making batch configuration
3525 changes to guests, getting disk used/free statistics (see also:
3526 virt-df), migrating between virtualization systems (see also:
3527 virt-p2v), performing partial backups, performing partial guest
3528 clones, cloning guests and changing registry/UUID/hostname info, and
3531 Libguestfs uses Linux kernel and qemu code, and can access any type of
3532 guest filesystem that Linux and qemu can, including but not limited
3533 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
3534 schemes, qcow, qcow2, vmdk.
3536 Libguestfs provides ways to enumerate guest storage (eg. partitions,
3537 LVs, what filesystem is in each LV, etc.). It can also run commands
3538 in the context of the guest. Also you can access filesystems over FTP.
3542 All errors turn into calls to C<croak> (see L<Carp(3)>).
3550 package Sys::Guestfs;
3556 XSLoader::load ('Sys::Guestfs');
3558 =item $h = Sys::Guestfs->new ();
3560 Create a new guestfs handle.
3566 my $class = ref ($proto) || $proto;
3568 my $self = Sys::Guestfs::_create ();
3569 bless $self, $class;
3575 (* Actions. We only need to print documentation for these as
3576 * they are pulled in from the XS code automatically.
3579 fun (name, style, _, flags, _, _, longdesc) ->
3580 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
3582 generate_perl_prototype name style;
3584 pr "%s\n\n" longdesc;
3585 if List.mem ProtocolLimitWarning flags then
3586 pr "%s\n\n" protocol_limit_warning;
3587 if List.mem DangerWillRobinson flags then
3588 pr "%s\n\n" danger_will_robinson
3589 ) all_functions_sorted;
3601 Copyright (C) 2009 Red Hat Inc.
3605 Please see the file COPYING.LIB for the full license.
3609 L<guestfs(3)>, L<guestfish(1)>.
3614 and generate_perl_prototype name style =
3615 (match fst style with
3620 | RString n -> pr "$%s = " n
3621 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
3625 | RLVList n -> pr "@%s = " n
3628 let comma = ref false in
3631 if !comma then pr ", ";
3634 | String n | OptString n | Bool n | Int n ->
3641 (* Generate Python C module. *)
3642 and generate_python_c () =
3643 generate_header CStyle LGPLv2;
3652 #include \"guestfs.h\"
3660 get_handle (PyObject *obj)
3663 assert (obj != Py_None);
3664 return ((Pyguestfs_Object *) obj)->g;
3668 put_handle (guestfs_h *g)
3672 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
3675 /* This list should be freed (but not the strings) after use. */
3676 static const char **
3677 get_string_list (PyObject *obj)
3684 if (!PyList_Check (obj)) {
3685 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
3689 len = PyList_Size (obj);
3690 r = malloc (sizeof (char *) * (len+1));
3692 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
3696 for (i = 0; i < len; ++i)
3697 r[i] = PyString_AsString (PyList_GetItem (obj, i));
3704 put_string_list (char * const * const argv)
3709 for (argc = 0; argv[argc] != NULL; ++argc)
3712 list = PyList_New (argc);
3713 for (i = 0; i < argc; ++i)
3714 PyList_SetItem (list, i, PyString_FromString (argv[i]));
3720 free_strings (char **argv)
3724 for (argc = 0; argv[argc] != NULL; ++argc)
3730 py_guestfs_create (PyObject *self, PyObject *args)
3734 g = guestfs_create ();
3736 PyErr_SetString (PyExc_RuntimeError,
3737 \"guestfs.create: failed to allocate handle\");
3740 guestfs_set_error_handler (g, NULL, NULL);
3741 return put_handle (g);
3745 py_guestfs_close (PyObject *self, PyObject *args)
3750 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
3752 g = get_handle (py_g);
3756 Py_INCREF (Py_None);
3762 (* LVM structures, turned into Python dictionaries. *)
3765 pr "static PyObject *\n";
3766 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3768 pr " PyObject *dict;\n";
3770 pr " dict = PyDict_New ();\n";
3774 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3775 pr " PyString_FromString (%s->%s));\n"
3778 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3779 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
3782 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3783 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
3786 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3787 pr " PyLong_FromLongLong (%s->%s));\n"
3789 | name, `OptPercent ->
3790 pr " if (%s->%s >= 0)\n" typ name;
3791 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3792 pr " PyFloat_FromDouble ((double) %s->%s));\n"
3795 pr " Py_INCREF (Py_None);\n";
3796 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
3799 pr " return dict;\n";
3803 pr "static PyObject *\n";
3804 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
3806 pr " PyObject *list;\n";
3809 pr " list = PyList_New (%ss->len);\n" typ;
3810 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3811 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
3812 pr " return list;\n";
3815 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3817 (* Python wrapper functions. *)
3819 fun (name, style, _, _, _, _, _) ->
3820 pr "static PyObject *\n";
3821 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
3824 pr " PyObject *py_g;\n";
3825 pr " guestfs_h *g;\n";
3826 pr " PyObject *py_r;\n";
3829 match fst style with
3830 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3831 | RConstString _ -> pr " const char *r;\n"; "NULL"
3832 | RString _ -> pr " char *r;\n"; "NULL"
3833 | RStringList _ -> pr " char **r;\n"; "NULL"
3834 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
3835 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3836 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3837 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" in
3841 | String n -> pr " const char *%s;\n" n
3842 | OptString n -> pr " const char *%s;\n" n
3844 pr " PyObject *py_%s;\n" n;
3845 pr " const char **%s;\n" n
3846 | Bool n -> pr " int %s;\n" n
3847 | Int n -> pr " int %s;\n" n
3852 (* Convert the parameters. *)
3853 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
3856 | String _ -> pr "s"
3857 | OptString _ -> pr "z"
3858 | StringList _ -> pr "O"
3859 | Bool _ -> pr "i" (* XXX Python has booleans? *)
3862 pr ":guestfs_%s\",\n" name;
3866 | String n -> pr ", &%s" n
3867 | OptString n -> pr ", &%s" n
3868 | StringList n -> pr ", &py_%s" n
3869 | Bool n -> pr ", &%s" n
3870 | Int n -> pr ", &%s" n
3874 pr " return NULL;\n";
3876 pr " g = get_handle (py_g);\n";
3879 | String _ | OptString _ | Bool _ | Int _ -> ()
3881 pr " %s = get_string_list (py_%s);\n" n n;
3882 pr " if (!%s) return NULL;\n" n
3887 pr " r = guestfs_%s " name;
3888 generate_call_args ~handle:"g" style;
3893 | String _ | OptString _ | Bool _ | Int _ -> ()
3895 pr " free (%s);\n" n
3898 pr " if (r == %s) {\n" error_code;
3899 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
3900 pr " return NULL;\n";
3904 (match fst style with
3906 pr " Py_INCREF (Py_None);\n";
3907 pr " py_r = Py_None;\n"
3909 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
3910 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
3912 pr " py_r = PyString_FromString (r);\n";
3915 pr " py_r = put_string_list (r);\n";
3916 pr " free_strings (r);\n"
3918 pr " py_r = PyTuple_New (2);\n";
3919 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
3920 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
3921 pr " guestfs_free_int_bool (r);\n"
3923 pr " py_r = put_lvm_pv_list (r);\n";
3924 pr " guestfs_free_lvm_pv_list (r);\n"
3926 pr " py_r = put_lvm_vg_list (r);\n";
3927 pr " guestfs_free_lvm_vg_list (r);\n"
3929 pr " py_r = put_lvm_lv_list (r);\n";
3930 pr " guestfs_free_lvm_lv_list (r);\n"
3933 pr " return py_r;\n";
3938 (* Table of functions. *)
3939 pr "static PyMethodDef methods[] = {\n";
3940 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
3941 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
3943 fun (name, _, _, _, _, _, _) ->
3944 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
3947 pr " { NULL, NULL, 0, NULL }\n";
3951 (* Init function. *)
3954 initlibguestfsmod (void)
3956 static int initialized = 0;
3958 if (initialized) return;
3959 Py_InitModule ((char *) \"libguestfsmod\", methods);
3964 (* Generate Python module. *)
3965 and generate_python_py () =
3966 generate_header HashStyle LGPLv2;
3968 pr "import libguestfsmod\n";
3970 pr "class GuestFS:\n";
3971 pr " def __init__ (self):\n";
3972 pr " self._o = libguestfsmod.create ()\n";
3974 pr " def __del__ (self):\n";
3975 pr " libguestfsmod.close (self._o)\n";
3979 fun (name, style, _, _, _, _, _) ->
3981 generate_call_args ~handle:"self" style;
3983 pr " return libguestfsmod.%s " name;
3984 generate_call_args ~handle:"self._o" style;
3989 let output_to filename =
3990 let filename_new = filename ^ ".new" in
3991 chan := open_out filename_new;
3995 Unix.rename filename_new filename;
3996 printf "written %s\n%!" filename;
4004 if not (Sys.file_exists "configure.ac") then (
4006 You are probably running this from the wrong directory.
4007 Run it from the top source directory using the command
4013 let close = output_to "src/guestfs_protocol.x" in
4017 let close = output_to "src/guestfs-structs.h" in
4018 generate_structs_h ();
4021 let close = output_to "src/guestfs-actions.h" in
4022 generate_actions_h ();
4025 let close = output_to "src/guestfs-actions.c" in
4026 generate_client_actions ();
4029 let close = output_to "daemon/actions.h" in
4030 generate_daemon_actions_h ();
4033 let close = output_to "daemon/stubs.c" in
4034 generate_daemon_actions ();
4037 let close = output_to "tests.c" in
4041 let close = output_to "fish/cmds.c" in
4042 generate_fish_cmds ();
4045 let close = output_to "guestfs-structs.pod" in
4046 generate_structs_pod ();
4049 let close = output_to "guestfs-actions.pod" in
4050 generate_actions_pod ();
4053 let close = output_to "guestfish-actions.pod" in
4054 generate_fish_actions_pod ();
4057 let close = output_to "ocaml/guestfs.mli" in
4058 generate_ocaml_mli ();
4061 let close = output_to "ocaml/guestfs.ml" in
4062 generate_ocaml_ml ();
4065 let close = output_to "ocaml/guestfs_c_actions.c" in
4066 generate_ocaml_c ();
4069 let close = output_to "perl/Guestfs.xs" in
4070 generate_perl_xs ();
4073 let close = output_to "perl/lib/Sys/Guestfs.pm" in
4074 generate_perl_pm ();
4077 let close = output_to "python/guestfs-py.c" in
4078 generate_python_c ();
4081 let close = output_to "python/guestfs.py" in
4082 generate_python_py ();