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.");
955 let all_functions = non_daemon_functions @ daemon_functions
957 (* In some places we want the functions to be displayed sorted
958 * alphabetically, so this is useful:
960 let all_functions_sorted =
961 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
962 compare n1 n2) all_functions
964 (* Column names and types from LVM PVs/VGs/LVs. *)
973 "pv_attr", `String (* XXX *);
975 "pv_pe_alloc_count", `Int;
978 "pv_mda_count", `Int;
979 "pv_mda_free", `Bytes;
981 "pv_mda_size", `Bytes;
988 "vg_attr", `String (* XXX *);
992 "vg_extent_size", `Bytes;
993 "vg_extent_count", `Int;
994 "vg_free_count", `Int;
1002 "vg_mda_count", `Int;
1003 "vg_mda_free", `Bytes;
1004 (* Not in Fedora 10:
1005 "vg_mda_size", `Bytes;
1011 "lv_attr", `String (* XXX *);
1014 "lv_kernel_major", `Int;
1015 "lv_kernel_minor", `Int;
1019 "snap_percent", `OptPercent;
1020 "copy_percent", `OptPercent;
1023 "mirror_log", `String;
1027 (* Useful functions.
1028 * Note we don't want to use any external OCaml libraries which
1029 * makes this a bit harder than it should be.
1031 let failwithf fs = ksprintf failwith fs
1033 let replace_char s c1 c2 =
1034 let s2 = String.copy s in
1035 let r = ref false in
1036 for i = 0 to String.length s2 - 1 do
1037 if String.unsafe_get s2 i = c1 then (
1038 String.unsafe_set s2 i c2;
1042 if not !r then s else s2
1044 let rec find s sub =
1045 let len = String.length s in
1046 let sublen = String.length sub in
1048 if i <= len-sublen then (
1050 if j < sublen then (
1051 if s.[i+j] = sub.[j] then loop2 (j+1)
1057 if r = -1 then loop (i+1) else r
1063 let rec replace_str s s1 s2 =
1064 let len = String.length s in
1065 let sublen = String.length s1 in
1066 let i = find s s1 in
1069 let s' = String.sub s 0 i in
1070 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1071 s' ^ s2 ^ replace_str s'' s1 s2
1074 let rec string_split sep str =
1075 let len = String.length str in
1076 let seplen = String.length sep in
1077 let i = find str sep in
1078 if i = -1 then [str]
1080 let s' = String.sub str 0 i in
1081 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1082 s' :: string_split sep s''
1085 let rec find_map f = function
1086 | [] -> raise Not_found
1090 | None -> find_map f xs
1093 let rec loop i = function
1095 | x :: xs -> f i x; loop (i+1) xs
1100 let rec loop i = function
1102 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1106 let name_of_argt = function
1107 | String n | OptString n | StringList n | Bool n | Int n -> n
1109 (* Check function names etc. for consistency. *)
1110 let check_functions () =
1111 let contains_uppercase str =
1112 let len = String.length str in
1114 if i >= len then false
1117 if c >= 'A' && c <= 'Z' then true
1124 (* Check function names. *)
1126 fun (name, _, _, _, _, _, _) ->
1127 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1128 failwithf "function name %s does not need 'guestfs' prefix" name;
1129 if contains_uppercase name then
1130 failwithf "function name %s should not contain uppercase chars" name;
1131 if String.contains name '-' then
1132 failwithf "function name %s should not contain '-', use '_' instead."
1136 (* Check function parameter/return names. *)
1138 fun (name, style, _, _, _, _, _) ->
1139 let check_arg_ret_name n =
1140 if contains_uppercase n then
1141 failwithf "%s param/ret %s should not contain uppercase chars"
1143 if String.contains n '-' || String.contains n '_' then
1144 failwithf "%s param/ret %s should not contain '-' or '_'"
1147 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
1150 (match fst style with
1152 | RInt n | RBool n | RConstString n | RString n
1153 | RStringList n | RPVList n | RVGList n | RLVList n ->
1154 check_arg_ret_name n
1156 check_arg_ret_name n;
1157 check_arg_ret_name m
1159 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1162 (* Check short descriptions. *)
1164 fun (name, _, _, _, _, shortdesc, _) ->
1165 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1166 failwithf "short description of %s should begin with lowercase." name;
1167 let c = shortdesc.[String.length shortdesc-1] in
1168 if c = '\n' || c = '.' then
1169 failwithf "short description of %s should not end with . or \\n." name
1172 (* Check long dscriptions. *)
1174 fun (name, _, _, _, _, _, longdesc) ->
1175 if longdesc.[String.length longdesc-1] = '\n' then
1176 failwithf "long description of %s should not end with \\n." name
1179 (* Check proc_nrs. *)
1181 fun (name, _, proc_nr, _, _, _, _) ->
1182 if proc_nr <= 0 then
1183 failwithf "daemon function %s should have proc_nr > 0" name
1187 fun (name, _, proc_nr, _, _, _, _) ->
1188 if proc_nr <> -1 then
1189 failwithf "non-daemon function %s should have proc_nr -1" name
1190 ) non_daemon_functions;
1193 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1196 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1197 let rec loop = function
1200 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1202 | (name1,nr1) :: (name2,nr2) :: _ ->
1203 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1208 (* 'pr' prints to the current output file. *)
1209 let chan = ref stdout
1210 let pr fs = ksprintf (output_string !chan) fs
1212 (* Generate a header block in a number of standard styles. *)
1213 type comment_style = CStyle | HashStyle | OCamlStyle
1214 type license = GPLv2 | LGPLv2
1216 let generate_header comment license =
1217 let c = match comment with
1218 | CStyle -> pr "/* "; " *"
1219 | HashStyle -> pr "# "; "#"
1220 | OCamlStyle -> pr "(* "; " *" in
1221 pr "libguestfs generated file\n";
1222 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1223 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1225 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1229 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1230 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1231 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1232 pr "%s (at your option) any later version.\n" c;
1234 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1235 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1236 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1237 pr "%s GNU General Public License for more details.\n" c;
1239 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1240 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1241 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1244 pr "%s This library is free software; you can redistribute it and/or\n" c;
1245 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1246 pr "%s License as published by the Free Software Foundation; either\n" c;
1247 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1249 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1250 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1251 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1252 pr "%s Lesser General Public License for more details.\n" c;
1254 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1255 pr "%s License along with this library; if not, write to the Free Software\n" c;
1256 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1259 | CStyle -> pr " */\n"
1261 | OCamlStyle -> pr " *)\n"
1265 (* Start of main code generation functions below this line. *)
1267 (* Generate the pod documentation for the C API. *)
1268 let rec generate_actions_pod () =
1270 fun (shortname, style, _, flags, _, _, longdesc) ->
1271 let name = "guestfs_" ^ shortname in
1272 pr "=head2 %s\n\n" name;
1274 generate_prototype ~extern:false ~handle:"handle" name style;
1276 pr "%s\n\n" longdesc;
1277 (match fst style with
1279 pr "This function returns 0 on success or -1 on error.\n\n"
1281 pr "On error this function returns -1.\n\n"
1283 pr "This function returns a C truth value on success or -1 on error.\n\n"
1285 pr "This function returns a string or NULL on error.
1286 The string is owned by the guest handle and must I<not> be freed.\n\n"
1288 pr "This function returns a string or NULL on error.
1289 I<The caller must free the returned string after use>.\n\n"
1291 pr "This function returns a NULL-terminated array of strings
1292 (like L<environ(3)>), or NULL if there was an error.
1293 I<The caller must free the strings and the array after use>.\n\n"
1295 pr "This function returns a C<struct guestfs_int_bool *>.
1296 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1298 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
1299 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1301 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
1302 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1304 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
1305 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1307 if List.mem ProtocolLimitWarning flags then
1308 pr "%s\n\n" protocol_limit_warning;
1309 if List.mem DangerWillRobinson flags then
1310 pr "%s\n\n" danger_will_robinson;
1311 ) all_functions_sorted
1313 and generate_structs_pod () =
1314 (* LVM structs documentation. *)
1317 pr "=head2 guestfs_lvm_%s\n" typ;
1319 pr " struct guestfs_lvm_%s {\n" typ;
1322 | name, `String -> pr " char *%s;\n" name
1324 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1325 pr " char %s[32];\n" name
1326 | name, `Bytes -> pr " uint64_t %s;\n" name
1327 | name, `Int -> pr " int64_t %s;\n" name
1328 | name, `OptPercent ->
1329 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1330 pr " float %s;\n" name
1333 pr " struct guestfs_lvm_%s_list {\n" typ;
1334 pr " uint32_t len; /* Number of elements in list. */\n";
1335 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1338 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1341 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1343 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1344 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1346 * We have to use an underscore instead of a dash because otherwise
1347 * rpcgen generates incorrect code.
1349 * This header is NOT exported to clients, but see also generate_structs_h.
1351 and generate_xdr () =
1352 generate_header CStyle LGPLv2;
1354 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1355 pr "typedef string str<>;\n";
1358 (* LVM internal structures. *)
1362 pr "struct guestfs_lvm_int_%s {\n" typ;
1364 | name, `String -> pr " string %s<>;\n" name
1365 | name, `UUID -> pr " opaque %s[32];\n" name
1366 | name, `Bytes -> pr " hyper %s;\n" name
1367 | name, `Int -> pr " hyper %s;\n" name
1368 | name, `OptPercent -> pr " float %s;\n" name
1372 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1374 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1377 fun (shortname, style, _, _, _, _, _) ->
1378 let name = "guestfs_" ^ shortname in
1380 (match snd style with
1383 pr "struct %s_args {\n" name;
1386 | String n -> pr " string %s<>;\n" n
1387 | OptString n -> pr " str *%s;\n" n
1388 | StringList n -> pr " str %s<>;\n" n
1389 | Bool n -> pr " bool %s;\n" n
1390 | Int n -> pr " int %s;\n" n
1394 (match fst style with
1397 pr "struct %s_ret {\n" name;
1401 pr "struct %s_ret {\n" name;
1405 failwithf "RConstString cannot be returned from a daemon function"
1407 pr "struct %s_ret {\n" name;
1408 pr " string %s<>;\n" n;
1411 pr "struct %s_ret {\n" name;
1412 pr " str %s<>;\n" n;
1415 pr "struct %s_ret {\n" name;
1420 pr "struct %s_ret {\n" name;
1421 pr " guestfs_lvm_int_pv_list %s;\n" n;
1424 pr "struct %s_ret {\n" name;
1425 pr " guestfs_lvm_int_vg_list %s;\n" n;
1428 pr "struct %s_ret {\n" name;
1429 pr " guestfs_lvm_int_lv_list %s;\n" n;
1434 (* Table of procedure numbers. *)
1435 pr "enum guestfs_procedure {\n";
1437 fun (shortname, _, proc_nr, _, _, _, _) ->
1438 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1440 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1444 (* Having to choose a maximum message size is annoying for several
1445 * reasons (it limits what we can do in the API), but it (a) makes
1446 * the protocol a lot simpler, and (b) provides a bound on the size
1447 * of the daemon which operates in limited memory space. For large
1448 * file transfers you should use FTP.
1450 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1453 (* Message header, etc. *)
1455 const GUESTFS_PROGRAM = 0x2000F5F5;
1456 const GUESTFS_PROTOCOL_VERSION = 1;
1458 enum guestfs_message_direction {
1459 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1460 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1463 enum guestfs_message_status {
1464 GUESTFS_STATUS_OK = 0,
1465 GUESTFS_STATUS_ERROR = 1
1468 const GUESTFS_ERROR_LEN = 256;
1470 struct guestfs_message_error {
1471 string error<GUESTFS_ERROR_LEN>; /* error message */
1474 struct guestfs_message_header {
1475 unsigned prog; /* GUESTFS_PROGRAM */
1476 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1477 guestfs_procedure proc; /* GUESTFS_PROC_x */
1478 guestfs_message_direction direction;
1479 unsigned serial; /* message serial number */
1480 guestfs_message_status status;
1484 (* Generate the guestfs-structs.h file. *)
1485 and generate_structs_h () =
1486 generate_header CStyle LGPLv2;
1488 (* This is a public exported header file containing various
1489 * structures. The structures are carefully written to have
1490 * exactly the same in-memory format as the XDR structures that
1491 * we use on the wire to the daemon. The reason for creating
1492 * copies of these structures here is just so we don't have to
1493 * export the whole of guestfs_protocol.h (which includes much
1494 * unrelated and XDR-dependent stuff that we don't want to be
1495 * public, or required by clients).
1497 * To reiterate, we will pass these structures to and from the
1498 * client with a simple assignment or memcpy, so the format
1499 * must be identical to what rpcgen / the RFC defines.
1502 (* guestfs_int_bool structure. *)
1503 pr "struct guestfs_int_bool {\n";
1509 (* LVM public structures. *)
1513 pr "struct guestfs_lvm_%s {\n" typ;
1516 | name, `String -> pr " char *%s;\n" name
1517 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1518 | name, `Bytes -> pr " uint64_t %s;\n" name
1519 | name, `Int -> pr " int64_t %s;\n" name
1520 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1524 pr "struct guestfs_lvm_%s_list {\n" typ;
1525 pr " uint32_t len;\n";
1526 pr " struct guestfs_lvm_%s *val;\n" typ;
1529 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1531 (* Generate the guestfs-actions.h file. *)
1532 and generate_actions_h () =
1533 generate_header CStyle LGPLv2;
1535 fun (shortname, style, _, _, _, _, _) ->
1536 let name = "guestfs_" ^ shortname in
1537 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1541 (* Generate the client-side dispatch stubs. *)
1542 and generate_client_actions () =
1543 generate_header CStyle LGPLv2;
1545 (* Client-side stubs for each function. *)
1547 fun (shortname, style, _, _, _, _, _) ->
1548 let name = "guestfs_" ^ shortname in
1550 (* Generate the return value struct. *)
1551 pr "struct %s_rv {\n" shortname;
1552 pr " int cb_done; /* flag to indicate callback was called */\n";
1553 pr " struct guestfs_message_header hdr;\n";
1554 pr " struct guestfs_message_error err;\n";
1555 (match fst style with
1558 failwithf "RConstString cannot be returned from a daemon function"
1560 | RBool _ | RString _ | RStringList _
1562 | RPVList _ | RVGList _ | RLVList _ ->
1563 pr " struct %s_ret ret;\n" name
1567 (* Generate the callback function. *)
1568 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1570 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1572 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1573 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1576 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1577 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1578 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1584 (match fst style with
1587 failwithf "RConstString cannot be returned from a daemon function"
1589 | RBool _ | RString _ | RStringList _
1591 | RPVList _ | RVGList _ | RLVList _ ->
1592 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1593 pr " error (g, \"%s: failed to parse reply\");\n" name;
1599 pr " rv->cb_done = 1;\n";
1600 pr " main_loop.main_loop_quit (g);\n";
1603 (* Generate the action stub. *)
1604 generate_prototype ~extern:false ~semicolon:false ~newline:true
1605 ~handle:"g" name style;
1608 match fst style with
1609 | RErr | RInt _ | RBool _ -> "-1"
1611 failwithf "RConstString cannot be returned from a daemon function"
1612 | RString _ | RStringList _ | RIntBool _
1613 | RPVList _ | RVGList _ | RLVList _ ->
1618 (match snd style with
1620 | _ -> pr " struct %s_args args;\n" name
1623 pr " struct %s_rv rv;\n" shortname;
1624 pr " int serial;\n";
1626 pr " if (g->state != READY) {\n";
1627 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1630 pr " return %s;\n" error_code;
1633 pr " memset (&rv, 0, sizeof rv);\n";
1636 (match snd style with
1638 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1639 (String.uppercase shortname)
1644 pr " args.%s = (char *) %s;\n" n n
1646 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1648 pr " args.%s.%s_val = (char **) %s;\n" n n n;
1649 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
1651 pr " args.%s = %s;\n" n n
1653 pr " args.%s = %s;\n" n n
1655 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1656 (String.uppercase shortname);
1657 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1660 pr " if (serial == -1)\n";
1661 pr " return %s;\n" error_code;
1664 pr " rv.cb_done = 0;\n";
1665 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1666 pr " g->reply_cb_internal_data = &rv;\n";
1667 pr " main_loop.main_loop_run (g);\n";
1668 pr " g->reply_cb_internal = NULL;\n";
1669 pr " g->reply_cb_internal_data = NULL;\n";
1670 pr " if (!rv.cb_done) {\n";
1671 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1672 pr " return %s;\n" error_code;
1676 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1677 (String.uppercase shortname);
1678 pr " return %s;\n" error_code;
1681 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1682 pr " error (g, \"%%s\", rv.err.error);\n";
1683 pr " return %s;\n" error_code;
1687 (match fst style with
1688 | RErr -> pr " return 0;\n"
1690 | RBool n -> pr " return rv.ret.%s;\n" n
1692 failwithf "RConstString cannot be returned from a daemon function"
1694 pr " return rv.ret.%s; /* caller will free */\n" n
1696 pr " /* caller will free this, but we need to add a NULL entry */\n";
1697 pr " rv.ret.%s.%s_val =" n n;
1698 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1699 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1701 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1702 pr " return rv.ret.%s.%s_val;\n" n n
1704 pr " /* caller with free this */\n";
1705 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1707 pr " /* caller will free this */\n";
1708 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1710 pr " /* caller will free this */\n";
1711 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1713 pr " /* caller will free this */\n";
1714 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1720 (* Generate daemon/actions.h. *)
1721 and generate_daemon_actions_h () =
1722 generate_header CStyle GPLv2;
1724 pr "#include \"../src/guestfs_protocol.h\"\n";
1728 fun (name, style, _, _, _, _, _) ->
1730 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1734 (* Generate the server-side stubs. *)
1735 and generate_daemon_actions () =
1736 generate_header CStyle GPLv2;
1738 pr "#define _GNU_SOURCE // for strchrnul\n";
1740 pr "#include <stdio.h>\n";
1741 pr "#include <stdlib.h>\n";
1742 pr "#include <string.h>\n";
1743 pr "#include <inttypes.h>\n";
1744 pr "#include <ctype.h>\n";
1745 pr "#include <rpc/types.h>\n";
1746 pr "#include <rpc/xdr.h>\n";
1748 pr "#include \"daemon.h\"\n";
1749 pr "#include \"../src/guestfs_protocol.h\"\n";
1750 pr "#include \"actions.h\"\n";
1754 fun (name, style, _, _, _, _, _) ->
1755 (* Generate server-side stubs. *)
1756 pr "static void %s_stub (XDR *xdr_in)\n" name;
1759 match fst style with
1760 | RErr | RInt _ -> pr " int r;\n"; "-1"
1761 | RBool _ -> pr " int r;\n"; "-1"
1763 failwithf "RConstString cannot be returned from a daemon function"
1764 | RString _ -> pr " char *r;\n"; "NULL"
1765 | RStringList _ -> pr " char **r;\n"; "NULL"
1766 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1767 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1768 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1769 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1771 (match snd style with
1774 pr " struct guestfs_%s_args args;\n" name;
1778 | OptString n -> pr " const char *%s;\n" n
1779 | StringList n -> pr " char **%s;\n" n
1780 | Bool n -> pr " int %s;\n" n
1781 | Int n -> pr " int %s;\n" n
1786 (match snd style with
1789 pr " memset (&args, 0, sizeof args);\n";
1791 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1792 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1797 | String n -> pr " %s = args.%s;\n" n n
1798 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1800 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
1801 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
1802 pr " %s = args.%s.%s_val;\n" n n n
1803 | Bool n -> pr " %s = args.%s;\n" n n
1804 | Int n -> pr " %s = args.%s;\n" n n
1809 pr " r = do_%s " name;
1810 generate_call_args style;
1813 pr " if (r == %s)\n" error_code;
1814 pr " /* do_%s has already called reply_with_error */\n" name;
1818 (match fst style with
1819 | RErr -> pr " reply (NULL, NULL);\n"
1821 pr " struct guestfs_%s_ret ret;\n" name;
1822 pr " ret.%s = r;\n" n;
1823 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1825 pr " struct guestfs_%s_ret ret;\n" name;
1826 pr " ret.%s = r;\n" n;
1827 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1829 failwithf "RConstString cannot be returned from a daemon function"
1831 pr " struct guestfs_%s_ret ret;\n" name;
1832 pr " ret.%s = r;\n" n;
1833 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1836 pr " struct guestfs_%s_ret ret;\n" name;
1837 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1838 pr " ret.%s.%s_val = r;\n" n n;
1839 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1840 pr " free_strings (r);\n"
1842 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1843 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1845 pr " struct guestfs_%s_ret ret;\n" name;
1846 pr " ret.%s = *r;\n" n;
1847 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1848 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
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;
1853 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1855 pr " struct guestfs_%s_ret ret;\n" name;
1856 pr " ret.%s = *r;\n" n;
1857 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1858 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1861 (* Free the args. *)
1862 (match snd style with
1867 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
1874 (* Dispatch function. *)
1875 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1877 pr " switch (proc_nr) {\n";
1880 fun (name, style, _, _, _, _, _) ->
1881 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1882 pr " %s_stub (xdr_in);\n" name;
1887 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1892 (* LVM columns and tokenization functions. *)
1893 (* XXX This generates crap code. We should rethink how we
1899 pr "static const char *lvm_%s_cols = \"%s\";\n"
1900 typ (String.concat "," (List.map fst cols));
1903 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1905 pr " char *tok, *p, *next;\n";
1909 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1912 pr " if (!str) {\n";
1913 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1916 pr " if (!*str || isspace (*str)) {\n";
1917 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1922 fun (name, coltype) ->
1923 pr " if (!tok) {\n";
1924 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1927 pr " p = strchrnul (tok, ',');\n";
1928 pr " if (*p) next = p+1; else next = NULL;\n";
1929 pr " *p = '\\0';\n";
1932 pr " r->%s = strdup (tok);\n" name;
1933 pr " if (r->%s == NULL) {\n" name;
1934 pr " perror (\"strdup\");\n";
1938 pr " for (i = j = 0; i < 32; ++j) {\n";
1939 pr " if (tok[j] == '\\0') {\n";
1940 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1942 pr " } else if (tok[j] != '-')\n";
1943 pr " r->%s[i++] = tok[j];\n" name;
1946 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1947 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1951 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1952 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1956 pr " if (tok[0] == '\\0')\n";
1957 pr " r->%s = -1;\n" name;
1958 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1959 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1963 pr " tok = next;\n";
1966 pr " if (tok != NULL) {\n";
1967 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1974 pr "guestfs_lvm_int_%s_list *\n" typ;
1975 pr "parse_command_line_%ss (void)\n" typ;
1977 pr " char *out, *err;\n";
1978 pr " char *p, *pend;\n";
1980 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1981 pr " void *newp;\n";
1983 pr " ret = malloc (sizeof *ret);\n";
1984 pr " if (!ret) {\n";
1985 pr " reply_with_perror (\"malloc\");\n";
1986 pr " return NULL;\n";
1989 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1990 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1992 pr " r = command (&out, &err,\n";
1993 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1994 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1995 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1996 pr " if (r == -1) {\n";
1997 pr " reply_with_error (\"%%s\", err);\n";
1998 pr " free (out);\n";
1999 pr " free (err);\n";
2000 pr " return NULL;\n";
2003 pr " free (err);\n";
2005 pr " /* Tokenize each line of the output. */\n";
2008 pr " while (p) {\n";
2009 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2010 pr " if (pend) {\n";
2011 pr " *pend = '\\0';\n";
2015 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2018 pr " if (!*p) { /* Empty line? Skip it. */\n";
2023 pr " /* Allocate some space to store this next entry. */\n";
2024 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2025 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2026 pr " if (newp == NULL) {\n";
2027 pr " reply_with_perror (\"realloc\");\n";
2028 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2029 pr " free (ret);\n";
2030 pr " free (out);\n";
2031 pr " return NULL;\n";
2033 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2035 pr " /* Tokenize the next entry. */\n";
2036 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2037 pr " if (r == -1) {\n";
2038 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2039 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2040 pr " free (ret);\n";
2041 pr " free (out);\n";
2042 pr " return NULL;\n";
2049 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2051 pr " free (out);\n";
2052 pr " return ret;\n";
2055 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2057 (* Generate the tests. *)
2058 and generate_tests () =
2059 generate_header CStyle GPLv2;
2066 #include <sys/types.h>
2069 #include \"guestfs.h\"
2071 static guestfs_h *g;
2072 static int suppress_error = 0;
2074 static void print_error (guestfs_h *g, void *data, const char *msg)
2076 if (!suppress_error)
2077 fprintf (stderr, \"%%s\\n\", msg);
2080 static void print_strings (char * const * const argv)
2084 for (argc = 0; argv[argc] != NULL; ++argc)
2085 printf (\"\\t%%s\\n\", argv[argc]);
2092 fun (name, _, _, _, tests, _, _) ->
2093 mapi (generate_one_test name) tests
2095 let test_names = List.concat test_names in
2096 let nr_tests = List.length test_names in
2099 int main (int argc, char *argv[])
2107 g = guestfs_create ();
2109 printf (\"guestfs_create FAILED\\n\");
2113 guestfs_set_error_handler (g, print_error, NULL);
2115 srcdir = getenv (\"srcdir\");
2116 if (!srcdir) srcdir = \".\";
2117 guestfs_set_path (g, srcdir);
2119 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2120 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2125 if (lseek (fd, %d, SEEK_SET) == -1) {
2131 if (write (fd, &c, 1) == -1) {
2137 if (close (fd) == -1) {
2142 if (guestfs_add_drive (g, buf) == -1) {
2143 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2147 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2148 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2153 if (lseek (fd, %d, SEEK_SET) == -1) {
2159 if (write (fd, &c, 1) == -1) {
2165 if (close (fd) == -1) {
2170 if (guestfs_add_drive (g, buf) == -1) {
2171 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2175 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2176 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2181 if (lseek (fd, %d, SEEK_SET) == -1) {
2187 if (write (fd, &c, 1) == -1) {
2193 if (close (fd) == -1) {
2198 if (guestfs_add_drive (g, buf) == -1) {
2199 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2203 if (guestfs_launch (g) == -1) {
2204 printf (\"guestfs_launch FAILED\\n\");
2207 if (guestfs_wait_ready (g) == -1) {
2208 printf (\"guestfs_wait_ready FAILED\\n\");
2212 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
2216 pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
2217 pr " if (%s () == -1) {\n" test_name;
2218 pr " printf (\"%s FAILED\\n\");\n" test_name;
2224 pr " guestfs_close (g);\n";
2225 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2226 pr " unlink (buf);\n";
2227 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2228 pr " unlink (buf);\n";
2229 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2230 pr " unlink (buf);\n";
2233 pr " if (failed > 0) {\n";
2234 pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
2243 and generate_one_test name i (init, test) =
2244 let test_name = sprintf "test_%s_%d" name i in
2246 pr "static int %s (void)\n" test_name;
2252 pr " /* InitEmpty for %s (%d) */\n" name i;
2253 List.iter (generate_test_command_call test_name)
2257 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2258 List.iter (generate_test_command_call test_name)
2261 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2262 ["mkfs"; "ext2"; "/dev/sda1"];
2263 ["mount"; "/dev/sda1"; "/"]]
2264 | InitBasicFSonLVM ->
2265 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2267 List.iter (generate_test_command_call test_name)
2270 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2271 ["pvcreate"; "/dev/sda1"];
2272 ["vgcreate"; "VG"; "/dev/sda1"];
2273 ["lvcreate"; "LV"; "VG"; "8"];
2274 ["mkfs"; "ext2"; "/dev/VG/LV"];
2275 ["mount"; "/dev/VG/LV"; "/"]]
2278 let get_seq_last = function
2280 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2283 let seq = List.rev seq in
2284 List.rev (List.tl seq), List.hd seq
2289 pr " /* TestRun for %s (%d) */\n" name i;
2290 List.iter (generate_test_command_call test_name) seq
2291 | TestOutput (seq, expected) ->
2292 pr " /* TestOutput for %s (%d) */\n" name i;
2293 let seq, last = get_seq_last seq in
2295 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2296 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2300 List.iter (generate_test_command_call test_name) seq;
2301 generate_test_command_call ~test test_name last
2302 | TestOutputList (seq, expected) ->
2303 pr " /* TestOutputList for %s (%d) */\n" name i;
2304 let seq, last = get_seq_last seq in
2308 pr " if (!r[%d]) {\n" i;
2309 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2310 pr " print_strings (r);\n";
2313 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2314 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2318 pr " if (r[%d] != NULL) {\n" (List.length expected);
2319 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2321 pr " print_strings (r);\n";
2325 List.iter (generate_test_command_call test_name) seq;
2326 generate_test_command_call ~test test_name last
2327 | TestOutputInt (seq, expected) ->
2328 pr " /* TestOutputInt for %s (%d) */\n" name i;
2329 let seq, last = get_seq_last seq in
2331 pr " if (r != %d) {\n" expected;
2332 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
2337 List.iter (generate_test_command_call test_name) seq;
2338 generate_test_command_call ~test test_name last
2339 | TestOutputTrue seq ->
2340 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2341 let seq, last = get_seq_last seq in
2344 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2349 List.iter (generate_test_command_call test_name) seq;
2350 generate_test_command_call ~test test_name last
2351 | TestOutputFalse seq ->
2352 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2353 let seq, last = get_seq_last seq in
2356 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2361 List.iter (generate_test_command_call test_name) seq;
2362 generate_test_command_call ~test test_name last
2363 | TestOutputLength (seq, expected) ->
2364 pr " /* TestOutputLength for %s (%d) */\n" name i;
2365 let seq, last = get_seq_last seq in
2368 pr " for (j = 0; j < %d; ++j)\n" expected;
2369 pr " if (r[j] == NULL) {\n";
2370 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2372 pr " print_strings (r);\n";
2375 pr " if (r[j] != NULL) {\n";
2376 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2378 pr " print_strings (r);\n";
2382 List.iter (generate_test_command_call test_name) seq;
2383 generate_test_command_call ~test test_name last
2384 | TestLastFail seq ->
2385 pr " /* TestLastFail for %s (%d) */\n" name i;
2386 let seq, last = get_seq_last seq in
2387 List.iter (generate_test_command_call test_name) seq;
2388 generate_test_command_call test_name ~expect_error:true last
2396 (* Generate the code to run a command, leaving the result in 'r'.
2397 * If you expect to get an error then you should set expect_error:true.
2399 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2401 | [] -> assert false
2403 (* Look up the command to find out what args/ret it has. *)
2406 let _, style, _, _, _, _, _ =
2407 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2410 failwithf "%s: in test, command %s was not found" test_name name in
2412 if List.length (snd style) <> List.length args then
2413 failwithf "%s: in test, wrong number of args given to %s"
2424 | StringList n, arg ->
2425 pr " char *%s[] = {\n" n;
2426 let strs = string_split " " arg in
2428 fun str -> pr " \"%s\",\n" (c_quote str)
2432 ) (List.combine (snd style) args);
2435 match fst style with
2436 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2437 | RConstString _ -> pr " const char *r;\n"; "NULL"
2438 | RString _ -> pr " char *r;\n"; "NULL"
2444 pr " struct guestfs_int_bool *r;\n";
2447 pr " struct guestfs_lvm_pv_list *r;\n";
2450 pr " struct guestfs_lvm_vg_list *r;\n";
2453 pr " struct guestfs_lvm_lv_list *r;\n";
2456 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2457 pr " r = guestfs_%s (g" name;
2459 (* Generate the parameters. *)
2462 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2463 | OptString _, arg ->
2464 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2465 | StringList n, _ ->
2469 try int_of_string arg
2470 with Failure "int_of_string" ->
2471 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2474 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2475 ) (List.combine (snd style) args);
2478 if not expect_error then
2479 pr " if (r == %s)\n" error_code
2481 pr " if (r != %s)\n" error_code;
2484 (* Insert the test code. *)
2490 (match fst style with
2491 | RErr | RInt _ | RBool _ | RConstString _ -> ()
2492 | RString _ -> pr " free (r);\n"
2494 pr " for (i = 0; r[i] != NULL; ++i)\n";
2495 pr " free (r[i]);\n";
2498 pr " guestfs_free_int_bool (r);\n"
2500 pr " guestfs_free_lvm_pv_list (r);\n"
2502 pr " guestfs_free_lvm_vg_list (r);\n"
2504 pr " guestfs_free_lvm_lv_list (r);\n"
2510 let str = replace_str str "\r" "\\r" in
2511 let str = replace_str str "\n" "\\n" in
2512 let str = replace_str str "\t" "\\t" in
2515 (* Generate a lot of different functions for guestfish. *)
2516 and generate_fish_cmds () =
2517 generate_header CStyle GPLv2;
2521 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2523 let all_functions_sorted =
2525 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2526 ) all_functions_sorted in
2528 pr "#include <stdio.h>\n";
2529 pr "#include <stdlib.h>\n";
2530 pr "#include <string.h>\n";
2531 pr "#include <inttypes.h>\n";
2533 pr "#include <guestfs.h>\n";
2534 pr "#include \"fish.h\"\n";
2537 (* list_commands function, which implements guestfish -h *)
2538 pr "void list_commands (void)\n";
2540 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2541 pr " list_builtin_commands ();\n";
2543 fun (name, _, _, flags, _, shortdesc, _) ->
2544 let name = replace_char name '_' '-' in
2545 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2547 ) all_functions_sorted;
2548 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2552 (* display_command function, which implements guestfish -h cmd *)
2553 pr "void display_command (const char *cmd)\n";
2556 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2557 let name2 = replace_char name '_' '-' in
2559 try find_map (function FishAlias n -> Some n | _ -> None) flags
2560 with Not_found -> name in
2561 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2563 match snd style with
2567 name2 (String.concat "> <" (List.map name_of_argt args)) in
2570 if List.mem ProtocolLimitWarning flags then
2571 ("\n\n" ^ protocol_limit_warning)
2574 (* For DangerWillRobinson commands, we should probably have
2575 * guestfish prompt before allowing you to use them (especially
2576 * in interactive mode). XXX
2580 if List.mem DangerWillRobinson flags then
2581 ("\n\n" ^ danger_will_robinson)
2584 let describe_alias =
2585 if name <> alias then
2586 sprintf "\n\nYou can use '%s' as an alias for this command." alias
2590 pr "strcasecmp (cmd, \"%s\") == 0" name;
2591 if name <> name2 then
2592 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2593 if name <> alias then
2594 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2596 pr " pod2text (\"%s - %s\", %S);\n"
2598 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
2601 pr " display_builtin_command (cmd);\n";
2605 (* print_{pv,vg,lv}_list functions *)
2609 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
2616 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
2618 pr " printf (\"%s: \");\n" name;
2619 pr " for (i = 0; i < 32; ++i)\n";
2620 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
2621 pr " printf (\"\\n\");\n"
2623 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
2625 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2626 | name, `OptPercent ->
2627 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
2628 typ name name typ name;
2629 pr " else printf (\"%s: \\n\");\n" name
2633 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
2638 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
2639 pr " print_%s (&%ss->val[i]);\n" typ typ;
2642 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2644 (* run_<action> actions *)
2646 fun (name, style, _, flags, _, _, _) ->
2647 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
2649 (match fst style with
2652 | RBool _ -> pr " int r;\n"
2653 | RConstString _ -> pr " const char *r;\n"
2654 | RString _ -> pr " char *r;\n"
2655 | RStringList _ -> pr " char **r;\n"
2656 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
2657 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
2658 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
2659 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
2664 | OptString n -> pr " const char *%s;\n" n
2665 | StringList n -> pr " char **%s;\n" n
2666 | Bool n -> pr " int %s;\n" n
2667 | Int n -> pr " int %s;\n" n
2670 (* Check and convert parameters. *)
2671 let argc_expected = List.length (snd style) in
2672 pr " if (argc != %d) {\n" argc_expected;
2673 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
2675 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
2681 | String name -> pr " %s = argv[%d];\n" name i
2683 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
2685 | StringList name ->
2686 pr " %s = parse_string_list (argv[%d]);\n" name i
2688 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
2690 pr " %s = atoi (argv[%d]);\n" name i
2693 (* Call C API function. *)
2695 try find_map (function FishAction n -> Some n | _ -> None) flags
2696 with Not_found -> sprintf "guestfs_%s" name in
2698 generate_call_args ~handle:"g" style;
2701 (* Check return value for errors and display command results. *)
2702 (match fst style with
2703 | RErr -> pr " return r;\n"
2705 pr " if (r == -1) return -1;\n";
2706 pr " if (r) printf (\"%%d\\n\", r);\n";
2709 pr " if (r == -1) return -1;\n";
2710 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
2713 pr " if (r == NULL) return -1;\n";
2714 pr " printf (\"%%s\\n\", r);\n";
2717 pr " if (r == NULL) return -1;\n";
2718 pr " printf (\"%%s\\n\", r);\n";
2722 pr " if (r == NULL) return -1;\n";
2723 pr " print_strings (r);\n";
2724 pr " free_strings (r);\n";
2727 pr " if (r == NULL) return -1;\n";
2728 pr " printf (\"%%d, %%s\\n\", r->i,\n";
2729 pr " r->b ? \"true\" : \"false\");\n";
2730 pr " guestfs_free_int_bool (r);\n";
2733 pr " if (r == NULL) return -1;\n";
2734 pr " print_pv_list (r);\n";
2735 pr " guestfs_free_lvm_pv_list (r);\n";
2738 pr " if (r == NULL) return -1;\n";
2739 pr " print_vg_list (r);\n";
2740 pr " guestfs_free_lvm_vg_list (r);\n";
2743 pr " if (r == NULL) return -1;\n";
2744 pr " print_lv_list (r);\n";
2745 pr " guestfs_free_lvm_lv_list (r);\n";
2752 (* run_action function *)
2753 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
2756 fun (name, _, _, flags, _, _, _) ->
2757 let name2 = replace_char name '_' '-' in
2759 try find_map (function FishAlias n -> Some n | _ -> None) flags
2760 with Not_found -> name in
2762 pr "strcasecmp (cmd, \"%s\") == 0" name;
2763 if name <> name2 then
2764 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2765 if name <> alias then
2766 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2768 pr " return run_%s (cmd, argc, argv);\n" name;
2772 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
2779 (* Generate the POD documentation for guestfish. *)
2780 and generate_fish_actions_pod () =
2781 let all_functions_sorted =
2783 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2784 ) all_functions_sorted in
2787 fun (name, style, _, flags, _, _, longdesc) ->
2788 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2789 let name = replace_char name '_' '-' in
2791 try find_map (function FishAlias n -> Some n | _ -> None) flags
2792 with Not_found -> name in
2794 pr "=head2 %s" name;
2795 if name <> alias then
2802 | String n -> pr " %s" n
2803 | OptString n -> pr " %s" n
2804 | StringList n -> pr " %s,..." n
2805 | Bool _ -> pr " true|false"
2806 | Int n -> pr " %s" n
2810 pr "%s\n\n" longdesc;
2812 if List.mem ProtocolLimitWarning flags then
2813 pr "%s\n\n" protocol_limit_warning;
2815 if List.mem DangerWillRobinson flags then
2816 pr "%s\n\n" danger_will_robinson
2817 ) all_functions_sorted
2819 (* Generate a C function prototype. *)
2820 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
2821 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
2823 ?handle name style =
2824 if extern then pr "extern ";
2825 if static then pr "static ";
2826 (match fst style with
2828 | RInt _ -> pr "int "
2829 | RBool _ -> pr "int "
2830 | RConstString _ -> pr "const char *"
2831 | RString _ -> pr "char *"
2832 | RStringList _ -> pr "char **"
2834 if not in_daemon then pr "struct guestfs_int_bool *"
2835 else pr "guestfs_%s_ret *" name
2837 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
2838 else pr "guestfs_lvm_int_pv_list *"
2840 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
2841 else pr "guestfs_lvm_int_vg_list *"
2843 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
2844 else pr "guestfs_lvm_int_lv_list *"
2846 pr "%s%s (" prefix name;
2847 if handle = None && List.length (snd style) = 0 then
2850 let comma = ref false in
2853 | Some handle -> pr "guestfs_h *%s" handle; comma := true
2857 if single_line then pr ", " else pr ",\n\t\t"
2863 | String n -> next (); pr "const char *%s" n
2864 | OptString n -> next (); pr "const char *%s" n
2865 | StringList n -> next (); pr "char * const* const %s" n
2866 | Bool n -> next (); pr "int %s" n
2867 | Int n -> next (); pr "int %s" n
2871 if semicolon then pr ";";
2872 if newline then pr "\n"
2874 (* Generate C call arguments, eg "(handle, foo, bar)" *)
2875 and generate_call_args ?handle style =
2877 let comma = ref false in
2880 | Some handle -> pr "%s" handle; comma := true
2884 if !comma then pr ", ";
2891 | Int n -> pr "%s" n
2895 (* Generate the OCaml bindings interface. *)
2896 and generate_ocaml_mli () =
2897 generate_header OCamlStyle LGPLv2;
2900 (** For API documentation you should refer to the C API
2901 in the guestfs(3) manual page. The OCaml API uses almost
2902 exactly the same calls. *)
2905 (** A [guestfs_h] handle. *)
2907 exception Error of string
2908 (** This exception is raised when there is an error. *)
2910 val create : unit -> t
2912 val close : t -> unit
2913 (** Handles are closed by the garbage collector when they become
2914 unreferenced, but callers can also call this in order to
2915 provide predictable cleanup. *)
2918 generate_ocaml_lvm_structure_decls ();
2922 fun (name, style, _, _, _, shortdesc, _) ->
2923 generate_ocaml_prototype name style;
2924 pr "(** %s *)\n" shortdesc;
2928 (* Generate the OCaml bindings implementation. *)
2929 and generate_ocaml_ml () =
2930 generate_header OCamlStyle LGPLv2;
2934 exception Error of string
2935 external create : unit -> t = \"ocaml_guestfs_create\"
2936 external close : t -> unit = \"ocaml_guestfs_close\"
2939 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
2943 generate_ocaml_lvm_structure_decls ();
2947 fun (name, style, _, _, _, shortdesc, _) ->
2948 generate_ocaml_prototype ~is_external:true name style;
2951 (* Generate the OCaml bindings C implementation. *)
2952 and generate_ocaml_c () =
2953 generate_header CStyle LGPLv2;
2955 pr "#include <stdio.h>\n";
2956 pr "#include <stdlib.h>\n";
2957 pr "#include <string.h>\n";
2959 pr "#include <caml/config.h>\n";
2960 pr "#include <caml/alloc.h>\n";
2961 pr "#include <caml/callback.h>\n";
2962 pr "#include <caml/fail.h>\n";
2963 pr "#include <caml/memory.h>\n";
2964 pr "#include <caml/mlvalues.h>\n";
2965 pr "#include <caml/signals.h>\n";
2967 pr "#include <guestfs.h>\n";
2969 pr "#include \"guestfs_c.h\"\n";
2972 (* LVM struct copy functions. *)
2975 let has_optpercent_col =
2976 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
2978 pr "static CAMLprim value\n";
2979 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
2981 pr " CAMLparam0 ();\n";
2982 if has_optpercent_col then
2983 pr " CAMLlocal3 (rv, v, v2);\n"
2985 pr " CAMLlocal2 (rv, v);\n";
2987 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
2992 pr " v = caml_copy_string (%s->%s);\n" typ name
2994 pr " v = caml_alloc_string (32);\n";
2995 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
2998 pr " v = caml_copy_int64 (%s->%s);\n" typ name
2999 | name, `OptPercent ->
3000 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3001 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3002 pr " v = caml_alloc (1, 0);\n";
3003 pr " Store_field (v, 0, v2);\n";
3004 pr " } else /* None */\n";
3005 pr " v = Val_int (0);\n";
3007 pr " Store_field (rv, %d, v);\n" i
3009 pr " CAMLreturn (rv);\n";
3013 pr "static CAMLprim value\n";
3014 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3017 pr " CAMLparam0 ();\n";
3018 pr " CAMLlocal2 (rv, v);\n";
3021 pr " if (%ss->len == 0)\n" typ;
3022 pr " CAMLreturn (Atom (0));\n";
3024 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3025 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3026 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3027 pr " caml_modify (&Field (rv, i), v);\n";
3029 pr " CAMLreturn (rv);\n";
3033 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3036 fun (name, style, _, _, _, _, _) ->
3038 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3040 pr "CAMLprim value\n";
3041 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3042 List.iter (pr ", value %s") (List.tl params);
3047 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3048 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3049 pr " CAMLxparam%d (%s);\n"
3050 (List.length rest) (String.concat ", " rest)
3052 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3054 pr " CAMLlocal1 (rv);\n";
3057 pr " guestfs_h *g = Guestfs_val (gv);\n";
3058 pr " if (g == NULL)\n";
3059 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3065 pr " const char *%s = String_val (%sv);\n" n n
3067 pr " const char *%s =\n" n;
3068 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3071 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3073 pr " int %s = Bool_val (%sv);\n" n n
3075 pr " int %s = Int_val (%sv);\n" n n
3078 match fst style with
3079 | RErr -> pr " int r;\n"; "-1"
3080 | RInt _ -> pr " int r;\n"; "-1"
3081 | RBool _ -> pr " int r;\n"; "-1"
3082 | RConstString _ -> pr " const char *r;\n"; "NULL"
3083 | RString _ -> pr " char *r;\n"; "NULL"
3089 pr " struct guestfs_int_bool *r;\n";
3092 pr " struct guestfs_lvm_pv_list *r;\n";
3095 pr " struct guestfs_lvm_vg_list *r;\n";
3098 pr " struct guestfs_lvm_lv_list *r;\n";
3102 pr " caml_enter_blocking_section ();\n";
3103 pr " r = guestfs_%s " name;
3104 generate_call_args ~handle:"g" style;
3106 pr " caml_leave_blocking_section ();\n";
3111 pr " ocaml_guestfs_free_strings (%s);\n" n;
3112 | String _ | OptString _ | Bool _ | Int _ -> ()
3115 pr " if (r == %s)\n" error_code;
3116 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3119 (match fst style with
3120 | RErr -> pr " rv = Val_unit;\n"
3121 | RInt _ -> pr " rv = Val_int (r);\n"
3122 | RBool _ -> pr " rv = Val_bool (r);\n"
3123 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3125 pr " rv = caml_copy_string (r);\n";
3128 pr " rv = caml_copy_string_array ((const char **) r);\n";
3129 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3132 pr " rv = caml_alloc (2, 0);\n";
3133 pr " Store_field (rv, 0, Val_int (r->i));\n";
3134 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3135 pr " guestfs_free_int_bool (r);\n";
3137 pr " rv = copy_lvm_pv_list (r);\n";
3138 pr " guestfs_free_lvm_pv_list (r);\n";
3140 pr " rv = copy_lvm_vg_list (r);\n";
3141 pr " guestfs_free_lvm_vg_list (r);\n";
3143 pr " rv = copy_lvm_lv_list (r);\n";
3144 pr " guestfs_free_lvm_lv_list (r);\n";
3147 pr " CAMLreturn (rv);\n";
3151 if List.length params > 5 then (
3152 pr "CAMLprim value\n";
3153 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3155 pr " return ocaml_guestfs_%s (argv[0]" name;
3156 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3163 and generate_ocaml_lvm_structure_decls () =
3166 pr "type lvm_%s = {\n" typ;
3169 | name, `String -> pr " %s : string;\n" name
3170 | name, `UUID -> pr " %s : string;\n" name
3171 | name, `Bytes -> pr " %s : int64;\n" name
3172 | name, `Int -> pr " %s : int64;\n" name
3173 | name, `OptPercent -> pr " %s : float option;\n" name
3177 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3179 and generate_ocaml_prototype ?(is_external = false) name style =
3180 if is_external then pr "external " else pr "val ";
3181 pr "%s : t -> " name;
3184 | String _ -> pr "string -> "
3185 | OptString _ -> pr "string option -> "
3186 | StringList _ -> pr "string array -> "
3187 | Bool _ -> pr "bool -> "
3188 | Int _ -> pr "int -> "
3190 (match fst style with
3191 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3192 | RInt _ -> pr "int"
3193 | RBool _ -> pr "bool"
3194 | RConstString _ -> pr "string"
3195 | RString _ -> pr "string"
3196 | RStringList _ -> pr "string array"
3197 | RIntBool _ -> pr "int * bool"
3198 | RPVList _ -> pr "lvm_pv array"
3199 | RVGList _ -> pr "lvm_vg array"
3200 | RLVList _ -> pr "lvm_lv array"
3202 if is_external then (
3204 if List.length (snd style) + 1 > 5 then
3205 pr "\"ocaml_guestfs_%s_byte\" " name;
3206 pr "\"ocaml_guestfs_%s\"" name
3210 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3211 and generate_perl_xs () =
3212 generate_header CStyle LGPLv2;
3215 #include \"EXTERN.h\"
3219 #include <guestfs.h>
3222 #define PRId64 \"lld\"
3226 my_newSVll(long long val) {
3227 #ifdef USE_64_BIT_ALL
3228 return newSViv(val);
3232 len = snprintf(buf, 100, \"%%\" PRId64, val);
3233 return newSVpv(buf, len);
3238 #define PRIu64 \"llu\"
3242 my_newSVull(unsigned long long val) {
3243 #ifdef USE_64_BIT_ALL
3244 return newSVuv(val);
3248 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3249 return newSVpv(buf, len);
3253 /* http://www.perlmonks.org/?node_id=680842 */
3255 XS_unpack_charPtrPtr (SV *arg) {
3260 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3261 croak (\"array reference expected\");
3264 av = (AV *)SvRV (arg);
3265 ret = (char **)malloc (av_len (av) + 1 + 1);
3267 for (i = 0; i <= av_len (av); i++) {
3268 SV **elem = av_fetch (av, i, 0);
3270 if (!elem || !*elem)
3271 croak (\"missing element in list\");
3273 ret[i] = SvPV_nolen (*elem);
3281 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3286 RETVAL = guestfs_create ();
3288 croak (\"could not create guestfs handle\");
3289 guestfs_set_error_handler (RETVAL, NULL, NULL);
3302 fun (name, style, _, _, _, _, _) ->
3303 (match fst style with
3304 | RErr -> pr "void\n"
3305 | RInt _ -> pr "SV *\n"
3306 | RBool _ -> pr "SV *\n"
3307 | RConstString _ -> pr "SV *\n"
3308 | RString _ -> pr "SV *\n"
3311 | RPVList _ | RVGList _ | RLVList _ ->
3312 pr "void\n" (* all lists returned implictly on the stack *)
3314 (* Call and arguments. *)
3316 generate_call_args ~handle:"g" style;
3318 pr " guestfs_h *g;\n";
3321 | String n -> pr " char *%s;\n" n
3322 | OptString n -> pr " char *%s;\n" n
3323 | StringList n -> pr " char **%s;\n" n
3324 | Bool n -> pr " int %s;\n" n
3325 | Int n -> pr " int %s;\n" n
3328 let do_cleanups () =
3335 | StringList n -> pr " free (%s);\n" n
3340 (match fst style with
3343 pr " if (guestfs_%s " name;
3344 generate_call_args ~handle:"g" style;
3347 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3354 pr " %s = guestfs_%s " n name;
3355 generate_call_args ~handle:"g" style;
3357 pr " if (%s == -1) {\n" n;
3359 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3361 pr " RETVAL = newSViv (%s);\n" n;
3366 pr " const char *%s;\n" n;
3368 pr " %s = guestfs_%s " n name;
3369 generate_call_args ~handle:"g" style;
3371 pr " if (%s == NULL) {\n" n;
3373 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3375 pr " RETVAL = newSVpv (%s, 0);\n" n;
3380 pr " char *%s;\n" n;
3382 pr " %s = guestfs_%s " n name;
3383 generate_call_args ~handle:"g" style;
3385 pr " if (%s == NULL) {\n" n;
3387 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3389 pr " RETVAL = newSVpv (%s, 0);\n" n;
3390 pr " free (%s);\n" n;
3395 pr " char **%s;\n" n;
3398 pr " %s = guestfs_%s " n name;
3399 generate_call_args ~handle:"g" style;
3401 pr " if (%s == NULL) {\n" n;
3403 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3405 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
3406 pr " EXTEND (SP, n);\n";
3407 pr " for (i = 0; i < n; ++i) {\n";
3408 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
3409 pr " free (%s[i]);\n" n;
3411 pr " free (%s);\n" n;
3414 pr " struct guestfs_int_bool *r;\n";
3416 pr " r = guestfs_%s " name;
3417 generate_call_args ~handle:"g" style;
3419 pr " if (r == NULL) {\n";
3421 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3423 pr " EXTEND (SP, 2);\n";
3424 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
3425 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
3426 pr " guestfs_free_int_bool (r);\n";
3428 generate_perl_lvm_code "pv" pv_cols name style n;
3430 generate_perl_lvm_code "vg" vg_cols name style n;
3432 generate_perl_lvm_code "lv" lv_cols name style n;
3440 and generate_perl_lvm_code typ cols name style n =
3442 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
3446 pr " %s = guestfs_%s " n name;
3447 generate_call_args ~handle:"g" style;
3449 pr " if (%s == NULL)\n" n;
3450 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3451 pr " EXTEND (SP, %s->len);\n" n;
3452 pr " for (i = 0; i < %s->len; ++i) {\n" n;
3453 pr " hv = newHV ();\n";
3457 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
3458 name (String.length name) n name
3460 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
3461 name (String.length name) n name
3463 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
3464 name (String.length name) n name
3466 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
3467 name (String.length name) n name
3468 | name, `OptPercent ->
3469 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
3470 name (String.length name) n name
3472 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
3474 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
3476 (* Generate Sys/Guestfs.pm. *)
3477 and generate_perl_pm () =
3478 generate_header HashStyle LGPLv2;
3485 Sys::Guestfs - Perl bindings for libguestfs
3491 my $h = Sys::Guestfs->new ();
3492 $h->add_drive ('guest.img');
3495 $h->mount ('/dev/sda1', '/');
3496 $h->touch ('/hello');
3501 The C<Sys::Guestfs> module provides a Perl XS binding to the
3502 libguestfs API for examining and modifying virtual machine
3505 Amongst the things this is good for: making batch configuration
3506 changes to guests, getting disk used/free statistics (see also:
3507 virt-df), migrating between virtualization systems (see also:
3508 virt-p2v), performing partial backups, performing partial guest
3509 clones, cloning guests and changing registry/UUID/hostname info, and
3512 Libguestfs uses Linux kernel and qemu code, and can access any type of
3513 guest filesystem that Linux and qemu can, including but not limited
3514 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
3515 schemes, qcow, qcow2, vmdk.
3517 Libguestfs provides ways to enumerate guest storage (eg. partitions,
3518 LVs, what filesystem is in each LV, etc.). It can also run commands
3519 in the context of the guest. Also you can access filesystems over FTP.
3523 All errors turn into calls to C<croak> (see L<Carp(3)>).
3531 package Sys::Guestfs;
3537 XSLoader::load ('Sys::Guestfs');
3539 =item $h = Sys::Guestfs->new ();
3541 Create a new guestfs handle.
3547 my $class = ref ($proto) || $proto;
3549 my $self = Sys::Guestfs::_create ();
3550 bless $self, $class;
3556 (* Actions. We only need to print documentation for these as
3557 * they are pulled in from the XS code automatically.
3560 fun (name, style, _, flags, _, _, longdesc) ->
3561 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
3563 generate_perl_prototype name style;
3565 pr "%s\n\n" longdesc;
3566 if List.mem ProtocolLimitWarning flags then
3567 pr "%s\n\n" protocol_limit_warning;
3568 if List.mem DangerWillRobinson flags then
3569 pr "%s\n\n" danger_will_robinson
3570 ) all_functions_sorted;
3582 Copyright (C) 2009 Red Hat Inc.
3586 Please see the file COPYING.LIB for the full license.
3590 L<guestfs(3)>, L<guestfish(1)>.
3595 and generate_perl_prototype name style =
3596 (match fst style with
3601 | RString n -> pr "$%s = " n
3602 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
3606 | RLVList n -> pr "@%s = " n
3609 let comma = ref false in
3612 if !comma then pr ", ";
3615 | String n | OptString n | Bool n | Int n ->
3622 (* Generate Python C module. *)
3623 and generate_python_c () =
3624 generate_header CStyle LGPLv2;
3633 #include \"guestfs.h\"
3641 get_handle (PyObject *obj)
3644 assert (obj != Py_None);
3645 return ((Pyguestfs_Object *) obj)->g;
3649 put_handle (guestfs_h *g)
3653 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
3656 /* This list should be freed (but not the strings) after use. */
3657 static const char **
3658 get_string_list (PyObject *obj)
3665 if (!PyList_Check (obj)) {
3666 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
3670 len = PyList_Size (obj);
3671 r = malloc (sizeof (char *) * (len+1));
3673 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
3677 for (i = 0; i < len; ++i)
3678 r[i] = PyString_AsString (PyList_GetItem (obj, i));
3685 put_string_list (char * const * const argv)
3690 for (argc = 0; argv[argc] != NULL; ++argc)
3693 list = PyList_New (argc);
3694 for (i = 0; i < argc; ++i)
3695 PyList_SetItem (list, i, PyString_FromString (argv[i]));
3701 free_strings (char **argv)
3705 for (argc = 0; argv[argc] != NULL; ++argc)
3711 py_guestfs_create (PyObject *self, PyObject *args)
3715 g = guestfs_create ();
3717 PyErr_SetString (PyExc_RuntimeError,
3718 \"guestfs.create: failed to allocate handle\");
3721 guestfs_set_error_handler (g, NULL, NULL);
3722 return put_handle (g);
3726 py_guestfs_close (PyObject *self, PyObject *args)
3731 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
3733 g = get_handle (py_g);
3737 Py_INCREF (Py_None);
3743 (* LVM structures, turned into Python dictionaries. *)
3746 pr "static PyObject *\n";
3747 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3749 pr " PyObject *dict;\n";
3751 pr " dict = PyDict_New ();\n";
3755 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3756 pr " PyString_FromString (%s->%s));\n"
3759 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3760 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
3763 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3764 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
3767 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3768 pr " PyLong_FromLongLong (%s->%s));\n"
3770 | name, `OptPercent ->
3771 pr " if (%s->%s >= 0)\n" typ name;
3772 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3773 pr " PyFloat_FromDouble ((double) %s->%s));\n"
3776 pr " Py_INCREF (Py_None);\n";
3777 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
3780 pr " return dict;\n";
3784 pr "static PyObject *\n";
3785 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
3787 pr " PyObject *list;\n";
3790 pr " list = PyList_New (%ss->len);\n" typ;
3791 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3792 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
3793 pr " return list;\n";
3796 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3798 (* Python wrapper functions. *)
3800 fun (name, style, _, _, _, _, _) ->
3801 pr "static PyObject *\n";
3802 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
3805 pr " PyObject *py_g;\n";
3806 pr " guestfs_h *g;\n";
3807 pr " PyObject *py_r;\n";
3810 match fst style with
3811 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3812 | RConstString _ -> pr " const char *r;\n"; "NULL"
3813 | RString _ -> pr " char *r;\n"; "NULL"
3814 | RStringList _ -> pr " char **r;\n"; "NULL"
3815 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
3816 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3817 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3818 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" in
3822 | String n -> pr " const char *%s;\n" n
3823 | OptString n -> pr " const char *%s;\n" n
3825 pr " PyObject *py_%s;\n" n;
3826 pr " const char **%s;\n" n
3827 | Bool n -> pr " int %s;\n" n
3828 | Int n -> pr " int %s;\n" n
3833 (* Convert the parameters. *)
3834 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
3837 | String _ -> pr "s"
3838 | OptString _ -> pr "z"
3839 | StringList _ -> pr "O"
3840 | Bool _ -> pr "i" (* XXX Python has booleans? *)
3843 pr ":guestfs_%s\",\n" name;
3847 | String n -> pr ", &%s" n
3848 | OptString n -> pr ", &%s" n
3849 | StringList n -> pr ", &py_%s" n
3850 | Bool n -> pr ", &%s" n
3851 | Int n -> pr ", &%s" n
3855 pr " return NULL;\n";
3857 pr " g = get_handle (py_g);\n";
3860 | String _ | OptString _ | Bool _ | Int _ -> ()
3862 pr " %s = get_string_list (py_%s);\n" n n;
3863 pr " if (!%s) return NULL;\n" n
3868 pr " r = guestfs_%s " name;
3869 generate_call_args ~handle:"g" style;
3874 | String _ | OptString _ | Bool _ | Int _ -> ()
3876 pr " free (%s);\n" n
3879 pr " if (r == %s) {\n" error_code;
3880 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
3881 pr " return NULL;\n";
3885 (match fst style with
3887 pr " Py_INCREF (Py_None);\n";
3888 pr " py_r = Py_None;\n"
3890 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
3891 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
3893 pr " py_r = PyString_FromString (r);\n";
3896 pr " py_r = put_string_list (r);\n";
3897 pr " free_strings (r);\n"
3899 pr " py_r = PyTuple_New (2);\n";
3900 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
3901 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
3902 pr " guestfs_free_int_bool (r);\n"
3904 pr " py_r = put_lvm_pv_list (r);\n";
3905 pr " guestfs_free_lvm_pv_list (r);\n"
3907 pr " py_r = put_lvm_vg_list (r);\n";
3908 pr " guestfs_free_lvm_vg_list (r);\n"
3910 pr " py_r = put_lvm_lv_list (r);\n";
3911 pr " guestfs_free_lvm_lv_list (r);\n"
3914 pr " return py_r;\n";
3919 (* Table of functions. *)
3920 pr "static PyMethodDef methods[] = {\n";
3921 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
3922 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
3924 fun (name, _, _, _, _, _, _) ->
3925 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
3928 pr " { NULL, NULL, 0, NULL }\n";
3932 (* Init function. *)
3935 initlibguestfsmod (void)
3937 static int initialized = 0;
3939 if (initialized) return;
3940 Py_InitModule ((char *) \"libguestfsmod\", methods);
3945 (* Generate Python module. *)
3946 and generate_python_py () =
3947 generate_header HashStyle LGPLv2;
3949 pr "import libguestfsmod\n";
3951 pr "class guestfs:\n";
3952 pr " def __init__ (self):\n";
3953 pr " self._o = libguestfsmod.create ()\n";
3955 pr " def __del__ (self):\n";
3956 pr " libguestfsmod.close (self._o)\n";
3960 fun (name, style, _, _, _, _, _) ->
3962 generate_call_args ~handle:"self" style;
3964 pr " return libguestfsmod.%s " name;
3965 generate_call_args ~handle:"self._o" style;
3970 let output_to filename =
3971 let filename_new = filename ^ ".new" in
3972 chan := open_out filename_new;
3976 Unix.rename filename_new filename;
3977 printf "written %s\n%!" filename;
3985 if not (Sys.file_exists "configure.ac") then (
3987 You are probably running this from the wrong directory.
3988 Run it from the top source directory using the command
3994 let close = output_to "src/guestfs_protocol.x" in
3998 let close = output_to "src/guestfs-structs.h" in
3999 generate_structs_h ();
4002 let close = output_to "src/guestfs-actions.h" in
4003 generate_actions_h ();
4006 let close = output_to "src/guestfs-actions.c" in
4007 generate_client_actions ();
4010 let close = output_to "daemon/actions.h" in
4011 generate_daemon_actions_h ();
4014 let close = output_to "daemon/stubs.c" in
4015 generate_daemon_actions ();
4018 let close = output_to "tests.c" in
4022 let close = output_to "fish/cmds.c" in
4023 generate_fish_cmds ();
4026 let close = output_to "guestfs-structs.pod" in
4027 generate_structs_pod ();
4030 let close = output_to "guestfs-actions.pod" in
4031 generate_actions_pod ();
4034 let close = output_to "guestfish-actions.pod" in
4035 generate_fish_actions_pod ();
4038 let close = output_to "ocaml/guestfs.mli" in
4039 generate_ocaml_mli ();
4042 let close = output_to "ocaml/guestfs.ml" in
4043 generate_ocaml_ml ();
4046 let close = output_to "ocaml/guestfs_c_actions.c" in
4047 generate_ocaml_c ();
4050 let close = output_to "perl/Guestfs.xs" in
4051 generate_perl_xs ();
4054 let close = output_to "perl/lib/Sys/Guestfs.pm" in
4055 generate_perl_pm ();
4058 let close = output_to "python/guestfs-py.c" in
4059 generate_python_c ();
4062 let close = output_to "python/guestfs.py" in
4063 generate_python_py ();