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. To add a new action there are only two
22 * files you need to change, this one to describe the interface, and
23 * daemon/<somefile>.c to write the implementation.
25 * After editing this file, run it (./src/generator.ml) to regenerate
26 * all the output files.
28 * IMPORTANT: This script should NOT print any warnings. If it prints
29 * warnings, you should treat them as errors.
30 * [Need to add -warn-error to ocaml command line]
37 type style = ret * args
39 (* "RErr" as a return value means an int used as a simple error
40 * indication, ie. 0 or -1.
43 (* "RInt" as a return value means an int which is -1 for error
44 * or any value >= 0 on success.
47 (* "RBool" is a bool return value which can be true/false or
51 (* "RConstString" is a string that refers to a constant value.
52 * Try to avoid using this. In particular you cannot use this
53 * for values returned from the daemon, because there is no
54 * thread-safe way to return them in the C API.
56 | RConstString of string
57 (* "RString" and "RStringList" are caller-frees. *)
59 | RStringList of string
60 (* Some limited tuples are possible: *)
61 | RIntBool of string * string
62 (* LVM PVs, VGs and LVs. *)
66 and args = argt list (* Function parameters, guestfs handle is implicit. *)
68 (* Note in future we should allow a "variable args" parameter as
69 * the final parameter, to allow commands like
70 * chmod mode file [file(s)...]
71 * This is not implemented yet, but many commands (such as chmod)
72 * are currently defined with the argument order keeping this future
73 * possibility in mind.
76 | String of string (* const char *name, cannot be NULL *)
77 | OptString of string (* const char *name, may be NULL *)
78 | Bool of string (* boolean *)
79 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
82 | ProtocolLimitWarning (* display warning about protocol size limits *)
83 | FishAlias of string (* provide an alias for this cmd in guestfish *)
84 | FishAction of string (* call this function in guestfish *)
85 | NotInFish (* do not export via guestfish *)
87 (* Note about long descriptions: When referring to another
88 * action, use the format C<guestfs_other> (ie. the full name of
89 * the C function). This will be replaced as appropriate in other
92 * Apart from that, long descriptions are just perldoc paragraphs.
95 let non_daemon_functions = [
96 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
97 "launch the qemu subprocess",
99 Internally libguestfs is implemented by running a virtual machine
102 You should call this after configuring the handle
103 (eg. adding drives) but before performing any actions.");
105 ("wait_ready", (RErr, []), -1, [NotInFish],
106 "wait until the qemu subprocess launches",
108 Internally libguestfs is implemented by running a virtual machine
111 You should call this after C<guestfs_launch> to wait for the launch
114 ("kill_subprocess", (RErr, []), -1, [],
115 "kill the qemu subprocess",
117 This kills the qemu subprocess. You should never need to call this.");
119 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
120 "add an image to examine or modify",
122 This function adds a virtual machine disk image C<filename> to the
123 guest. The first time you call this function, the disk appears as IDE
124 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
127 You don't necessarily need to be root when using libguestfs. However
128 you obviously do need sufficient permissions to access the filename
129 for whatever operations you want to perform (ie. read access if you
130 just want to read the image or write access if you want to modify the
133 This is equivalent to the qemu parameter C<-drive file=filename>.");
135 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
136 "add a CD-ROM disk image to examine",
138 This function adds a virtual CD-ROM disk image to the guest.
140 This is equivalent to the qemu parameter C<-cdrom filename>.");
142 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
143 "add qemu parameters",
145 This can be used to add arbitrary qemu command line parameters
146 of the form C<-param value>. Actually it's not quite arbitrary - we
147 prevent you from setting some parameters which would interfere with
148 parameters that we use.
150 The first character of C<param> string must be a C<-> (dash).
152 C<value> can be NULL.");
154 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
155 "set the search path",
157 Set the path that libguestfs searches for kernel and initrd.img.
159 The default is C<$libdir/guestfs> unless overridden by setting
160 C<LIBGUESTFS_PATH> environment variable.
162 The string C<path> is stashed in the libguestfs handle, so the caller
163 must make sure it remains valid for the lifetime of the handle.
165 Setting C<path> to C<NULL> restores the default path.");
167 ("get_path", (RConstString "path", []), -1, [],
168 "get the search path",
170 Return the current search path.
172 This is always non-NULL. If it wasn't set already, then this will
173 return the default path.");
175 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
178 If C<autosync> is true, this enables autosync. Libguestfs will make a
179 best effort attempt to run C<guestfs_sync> when the handle is closed
180 (also if the program exits without closing handles).");
182 ("get_autosync", (RBool "autosync", []), -1, [],
185 Get the autosync flag.");
187 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
190 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
192 Verbose messages are disabled unless the environment variable
193 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
195 ("get_verbose", (RBool "verbose", []), -1, [],
198 This returns the verbose messages flag.")
201 let daemon_functions = [
202 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
203 "mount a guest disk at a position in the filesystem",
205 Mount a guest disk at a position in the filesystem. Block devices
206 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
207 the guest. If those block devices contain partitions, they will have
208 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
211 The rules are the same as for L<mount(2)>: A filesystem must
212 first be mounted on C</> before others can be mounted. Other
213 filesystems can only be mounted on directories which already
216 The mounted filesystem is writable, if we have sufficient permissions
217 on the underlying device.
219 The filesystem options C<sync> and C<noatime> are set with this
220 call, in order to improve reliability.");
222 ("sync", (RErr, []), 2, [],
223 "sync disks, writes are flushed through to the disk image",
225 This syncs the disk, so that any writes are flushed through to the
226 underlying disk image.
228 You should always call this if you have modified a disk image, before
229 closing the handle.");
231 ("touch", (RErr, [String "path"]), 3, [],
232 "update file timestamps or create a new file",
234 Touch acts like the L<touch(1)> command. It can be used to
235 update the timestamps on a file, or, if the file does not exist,
236 to create a new zero-length file.");
238 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
239 "list the contents of a file",
241 Return the contents of the file named C<path>.
243 Note that this function cannot correctly handle binary files
244 (specifically, files containing C<\\0> character which is treated
245 as end of string). For those you need to use the C<guestfs_read_file>
246 function which has a more complex interface.");
248 ("ll", (RString "listing", [String "directory"]), 5, [],
249 "list the files in a directory (long format)",
251 List the files in C<directory> (relative to the root directory,
252 there is no cwd) in the format of 'ls -la'.
254 This command is mostly useful for interactive sessions. It
255 is I<not> intended that you try to parse the output string.");
257 ("ls", (RStringList "listing", [String "directory"]), 6, [],
258 "list the files in a directory",
260 List the files in C<directory> (relative to the root directory,
261 there is no cwd). The '.' and '..' entries are not returned, but
262 hidden files are shown.
264 This command is mostly useful for interactive sessions. Programs
265 should probably use C<guestfs_readdir> instead.");
267 ("list_devices", (RStringList "devices", []), 7, [],
268 "list the block devices",
270 List all the block devices.
272 The full block device names are returned, eg. C</dev/sda>");
274 ("list_partitions", (RStringList "partitions", []), 8, [],
275 "list the partitions",
277 List all the partitions detected on all block devices.
279 The full partition device names are returned, eg. C</dev/sda1>
281 This does not return logical volumes. For that you will need to
282 call C<guestfs_lvs>.");
284 ("pvs", (RStringList "physvols", []), 9, [],
285 "list the LVM physical volumes (PVs)",
287 List all the physical volumes detected. This is the equivalent
288 of the L<pvs(8)> command.
290 This returns a list of just the device names that contain
291 PVs (eg. C</dev/sda2>).
293 See also C<guestfs_pvs_full>.");
295 ("vgs", (RStringList "volgroups", []), 10, [],
296 "list the LVM volume groups (VGs)",
298 List all the volumes groups detected. This is the equivalent
299 of the L<vgs(8)> command.
301 This returns a list of just the volume group names that were
302 detected (eg. C<VolGroup00>).
304 See also C<guestfs_vgs_full>.");
306 ("lvs", (RStringList "logvols", []), 11, [],
307 "list the LVM logical volumes (LVs)",
309 List all the logical volumes detected. This is the equivalent
310 of the L<lvs(8)> command.
312 This returns a list of the logical volume device names
313 (eg. C</dev/VolGroup00/LogVol00>).
315 See also C<guestfs_lvs_full>.");
317 ("pvs_full", (RPVList "physvols", []), 12, [],
318 "list the LVM physical volumes (PVs)",
320 List all the physical volumes detected. This is the equivalent
321 of the L<pvs(8)> command. The \"full\" version includes all fields.");
323 ("vgs_full", (RVGList "volgroups", []), 13, [],
324 "list the LVM volume groups (VGs)",
326 List all the volumes groups detected. This is the equivalent
327 of the L<vgs(8)> command. The \"full\" version includes all fields.");
329 ("lvs_full", (RLVList "logvols", []), 14, [],
330 "list the LVM logical volumes (LVs)",
332 List all the logical volumes detected. This is the equivalent
333 of the L<lvs(8)> command. The \"full\" version includes all fields.");
335 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
336 "read file as lines",
338 Return the contents of the file named C<path>.
340 The file contents are returned as a list of lines. Trailing
341 C<LF> and C<CRLF> character sequences are I<not> returned.
343 Note that this function cannot correctly handle binary files
344 (specifically, files containing C<\\0> character which is treated
345 as end of line). For those you need to use the C<guestfs_read_file>
346 function which has a more complex interface.");
348 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
349 "create a new Augeas handle",
351 Create a new Augeas handle for editing configuration files.
352 If there was any previous Augeas handle associated with this
353 guestfs session, then it is closed.
355 You must call this before using any other C<guestfs_aug_*>
358 C<root> is the filesystem root. C<root> must not be NULL,
361 The flags are the same as the flags defined in
362 E<lt>augeas.hE<gt>, the logical I<or> of the following
367 =item C<AUG_SAVE_BACKUP> = 1
369 Keep the original file with a C<.augsave> extension.
371 =item C<AUG_SAVE_NEWFILE> = 2
373 Save changes into a file with extension C<.augnew>, and
374 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
376 =item C<AUG_TYPE_CHECK> = 4
378 Typecheck lenses (can be expensive).
380 =item C<AUG_NO_STDINC> = 8
382 Do not use standard load path for modules.
384 =item C<AUG_SAVE_NOOP> = 16
386 Make save a no-op, just record what would have been changed.
388 =item C<AUG_NO_LOAD> = 32
390 Do not load the tree in C<guestfs_aug_init>.
394 To close the handle, you can call C<guestfs_aug_close>.
396 To find out more about Augeas, see L<http://augeas.net/>.");
398 ("aug_close", (RErr, []), 26, [],
399 "close the current Augeas handle",
401 Close the current Augeas handle and free up any resources
402 used by it. After calling this, you have to call
403 C<guestfs_aug_init> again before you can use any other
406 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
407 "define an Augeas variable",
409 Defines an Augeas variable C<name> whose value is the result
410 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
413 On success this returns the number of nodes in C<expr>, or
414 C<0> if C<expr> evaluates to something which is not a nodeset.");
416 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
417 "define an Augeas node",
419 Defines a variable C<name> whose value is the result of
422 If C<expr> evaluates to an empty nodeset, a node is created,
423 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
424 C<name> will be the nodeset containing that single node.
426 On success this returns a pair containing the
427 number of nodes in the nodeset, and a boolean flag
428 if a node was created.");
430 ("aug_get", (RString "val", [String "path"]), 19, [],
431 "look up the value of an Augeas path",
433 Look up the value associated with C<path>. If C<path>
434 matches exactly one node, the C<value> is returned.");
436 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
437 "set Augeas path to value",
439 Set the value associated with C<path> to C<value>.");
441 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
442 "insert a sibling Augeas node",
444 Create a new sibling C<label> for C<path>, inserting it into
445 the tree before or after C<path> (depending on the boolean
448 C<path> must match exactly one existing node in the tree, and
449 C<label> must be a label, ie. not contain C</>, C<*> or end
450 with a bracketed index C<[N]>.");
452 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
453 "remove an Augeas path",
455 Remove C<path> and all of its children.
457 On success this returns the number of entries which were removed.");
459 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
462 Move the node C<src> to C<dest>. C<src> must match exactly
463 one node. C<dest> is overwritten if it exists.");
465 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
466 "return Augeas nodes which match path",
468 Returns a list of paths which match the path expression C<path>.
469 The returned paths are sufficiently qualified so that they match
470 exactly one node in the current tree.");
472 ("aug_save", (RErr, []), 25, [],
473 "write all pending Augeas changes to disk",
475 This writes all pending changes to disk.
477 The flags which were passed to C<guestfs_aug_init> affect exactly
478 how files are saved.");
480 ("aug_load", (RErr, []), 27, [],
481 "load files into the tree",
483 Load files into the tree.
485 See C<aug_load> in the Augeas documentation for the full gory
488 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
489 "list Augeas nodes under a path",
491 This is just a shortcut for listing C<guestfs_aug_match>
492 C<path/*> and sorting the resulting nodes into alphabetical order.");
494 ("rm", (RErr, [String "path"]), 29, [],
497 Remove the single file C<path>.");
499 ("rmdir", (RErr, [String "path"]), 30, [],
500 "remove a directory",
502 Remove the single directory C<path>.");
504 ("rm_rf", (RErr, [String "path"]), 31, [],
505 "remove a file or directory recursively",
507 Remove the file or directory C<path>, recursively removing the
508 contents if its a directory. This is like the C<rm -rf> shell
511 ("mkdir", (RErr, [String "path"]), 32, [],
512 "create a directory",
514 Create a directory named C<path>.");
516 ("mkdir_p", (RErr, [String "path"]), 33, [],
517 "create a directory and parents",
519 Create a directory named C<path>, creating any parent directories
520 as necessary. This is like the C<mkdir -p> shell command.");
522 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
525 Change the mode (permissions) of C<path> to C<mode>. Only
526 numeric modes are supported.");
528 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
529 "change file owner and group",
531 Change the file owner to C<owner> and group to C<group>.
533 Only numeric uid and gid are supported. If you want to use
534 names, you will need to locate and parse the password file
535 yourself (Augeas support makes this relatively easy).");
538 let all_functions = non_daemon_functions @ daemon_functions
540 (* In some places we want the functions to be displayed sorted
541 * alphabetically, so this is useful:
543 let all_functions_sorted =
544 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
546 (* Column names and types from LVM PVs/VGs/LVs. *)
555 "pv_attr", `String (* XXX *);
557 "pv_pe_alloc_count", `Int;
560 "pv_mda_count", `Int;
561 "pv_mda_free", `Bytes;
563 "pv_mda_size", `Bytes;
570 "vg_attr", `String (* XXX *);
574 "vg_extent_size", `Bytes;
575 "vg_extent_count", `Int;
576 "vg_free_count", `Int;
584 "vg_mda_count", `Int;
585 "vg_mda_free", `Bytes;
587 "vg_mda_size", `Bytes;
593 "lv_attr", `String (* XXX *);
596 "lv_kernel_major", `Int;
597 "lv_kernel_minor", `Int;
601 "snap_percent", `OptPercent;
602 "copy_percent", `OptPercent;
605 "mirror_log", `String;
610 * Note we don't want to use any external OCaml libraries which
611 * makes this a bit harder than it should be.
613 let failwithf fs = ksprintf failwith fs
615 let replace_char s c1 c2 =
616 let s2 = String.copy s in
618 for i = 0 to String.length s2 - 1 do
619 if String.unsafe_get s2 i = c1 then (
620 String.unsafe_set s2 i c2;
624 if not !r then s else s2
627 let len = String.length s in
628 let sublen = String.length sub in
630 if i <= len-sublen then (
633 if s.[i+j] = sub.[j] then loop2 (j+1)
639 if r = -1 then loop (i+1) else r
645 let rec replace_str s s1 s2 =
646 let len = String.length s in
647 let sublen = String.length s1 in
651 let s' = String.sub s 0 i in
652 let s'' = String.sub s (i+sublen) (len-i-sublen) in
653 s' ^ s2 ^ replace_str s'' s1 s2
656 let rec find_map f = function
657 | [] -> raise Not_found
661 | None -> find_map f xs
664 let rec loop i = function
666 | x :: xs -> f i x; loop (i+1) xs
670 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
672 (* Check function names etc. for consistency. *)
673 let check_functions () =
674 let contains_uppercase str =
675 let len = String.length str in
677 if i >= len then false
680 if c >= 'A' && c <= 'Z' then true
687 (* Check function names. *)
689 fun (name, _, _, _, _, _) ->
690 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
691 failwithf "function name %s does not need 'guestfs' prefix" name;
692 if contains_uppercase name then
693 failwithf "function name %s should not contain uppercase chars" name;
694 if String.contains name '-' then
695 failwithf "function name %s should not contain '-', use '_' instead."
699 (* Check function parameter/return names. *)
701 fun (name, style, _, _, _, _) ->
702 let check_arg_ret_name n =
703 if contains_uppercase n then
704 failwithf "%s param/ret %s should not contain uppercase chars"
706 if String.contains n '-' || String.contains n '_' then
707 failwithf "%s param/ret %s should not contain '-' or '_'"
710 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
713 (match fst style with
715 | RInt n | RBool n | RConstString n | RString n
716 | RStringList n | RPVList n | RVGList n | RLVList n ->
719 check_arg_ret_name n;
722 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
725 (* Check long dscriptions. *)
727 fun (name, _, _, _, _, longdesc) ->
728 if longdesc.[String.length longdesc-1] = '\n' then
729 failwithf "long description of %s should not end with \\n." name
732 (* Check proc_nrs. *)
734 fun (name, _, proc_nr, _, _, _) ->
736 failwithf "daemon function %s should have proc_nr > 0" name
740 fun (name, _, proc_nr, _, _, _) ->
741 if proc_nr <> -1 then
742 failwithf "non-daemon function %s should have proc_nr -1" name
743 ) non_daemon_functions;
746 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
749 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
750 let rec loop = function
753 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
755 | (name1,nr1) :: (name2,nr2) :: _ ->
756 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
761 (* 'pr' prints to the current output file. *)
762 let chan = ref stdout
763 let pr fs = ksprintf (output_string !chan) fs
765 (* Generate a header block in a number of standard styles. *)
766 type comment_style = CStyle | HashStyle | OCamlStyle
767 type license = GPLv2 | LGPLv2
769 let generate_header comment license =
770 let c = match comment with
771 | CStyle -> pr "/* "; " *"
772 | HashStyle -> pr "# "; "#"
773 | OCamlStyle -> pr "(* "; " *" in
774 pr "libguestfs generated file\n";
775 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
776 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
778 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
782 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
783 pr "%s it under the terms of the GNU General Public License as published by\n" c;
784 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
785 pr "%s (at your option) any later version.\n" c;
787 pr "%s This program is distributed in the hope that it will be useful,\n" c;
788 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
789 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
790 pr "%s GNU General Public License for more details.\n" c;
792 pr "%s You should have received a copy of the GNU General Public License along\n" c;
793 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
794 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
797 pr "%s This library is free software; you can redistribute it and/or\n" c;
798 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
799 pr "%s License as published by the Free Software Foundation; either\n" c;
800 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
802 pr "%s This library is distributed in the hope that it will be useful,\n" c;
803 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
804 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
805 pr "%s Lesser General Public License for more details.\n" c;
807 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
808 pr "%s License along with this library; if not, write to the Free Software\n" c;
809 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
812 | CStyle -> pr " */\n"
814 | OCamlStyle -> pr " *)\n"
818 (* Start of main code generation functions below this line. *)
820 (* Generate the pod documentation for the C API. *)
821 let rec generate_actions_pod () =
823 fun (shortname, style, _, flags, _, longdesc) ->
824 let name = "guestfs_" ^ shortname in
825 pr "=head2 %s\n\n" name;
827 generate_prototype ~extern:false ~handle:"handle" name style;
829 pr "%s\n\n" longdesc;
830 (match fst style with
832 pr "This function returns 0 on success or -1 on error.\n\n"
834 pr "On error this function returns -1.\n\n"
836 pr "This function returns a C truth value on success or -1 on error.\n\n"
838 pr "This function returns a string or NULL on error.
839 The string is owned by the guest handle and must I<not> be freed.\n\n"
841 pr "This function returns a string or NULL on error.
842 I<The caller must free the returned string after use>.\n\n"
844 pr "This function returns a NULL-terminated array of strings
845 (like L<environ(3)>), or NULL if there was an error.
846 I<The caller must free the strings and the array after use>.\n\n"
848 pr "This function returns a C<struct guestfs_int_bool *>.
849 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
851 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
852 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
854 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
855 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
857 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
858 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
860 if List.mem ProtocolLimitWarning flags then
861 pr "Because of the message protocol, there is a transfer limit
862 of somewhere between 2MB and 4MB. To transfer large files you should use
864 ) all_functions_sorted
866 and generate_structs_pod () =
867 (* LVM structs documentation. *)
870 pr "=head2 guestfs_lvm_%s\n" typ;
872 pr " struct guestfs_lvm_%s {\n" typ;
875 | name, `String -> pr " char *%s;\n" name
877 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
878 pr " char %s[32];\n" name
879 | name, `Bytes -> pr " uint64_t %s;\n" name
880 | name, `Int -> pr " int64_t %s;\n" name
881 | name, `OptPercent ->
882 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
883 pr " float %s;\n" name
886 pr " struct guestfs_lvm_%s_list {\n" typ;
887 pr " uint32_t len; /* Number of elements in list. */\n";
888 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
891 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
894 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
896 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
897 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
899 * We have to use an underscore instead of a dash because otherwise
900 * rpcgen generates incorrect code.
902 * This header is NOT exported to clients, but see also generate_structs_h.
904 and generate_xdr () =
905 generate_header CStyle LGPLv2;
907 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
908 pr "typedef string str<>;\n";
911 (* LVM internal structures. *)
915 pr "struct guestfs_lvm_int_%s {\n" typ;
917 | name, `String -> pr " string %s<>;\n" name
918 | name, `UUID -> pr " opaque %s[32];\n" name
919 | name, `Bytes -> pr " hyper %s;\n" name
920 | name, `Int -> pr " hyper %s;\n" name
921 | name, `OptPercent -> pr " float %s;\n" name
925 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
927 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
930 fun(shortname, style, _, _, _, _) ->
931 let name = "guestfs_" ^ shortname in
933 (match snd style with
936 pr "struct %s_args {\n" name;
939 | String n -> pr " string %s<>;\n" n
940 | OptString n -> pr " str *%s;\n" n
941 | Bool n -> pr " bool %s;\n" n
942 | Int n -> pr " int %s;\n" n
946 (match fst style with
949 pr "struct %s_ret {\n" name;
953 pr "struct %s_ret {\n" name;
957 failwithf "RConstString cannot be returned from a daemon function"
959 pr "struct %s_ret {\n" name;
960 pr " string %s<>;\n" n;
963 pr "struct %s_ret {\n" name;
967 pr "struct %s_ret {\n" name;
972 pr "struct %s_ret {\n" name;
973 pr " guestfs_lvm_int_pv_list %s;\n" n;
976 pr "struct %s_ret {\n" name;
977 pr " guestfs_lvm_int_vg_list %s;\n" n;
980 pr "struct %s_ret {\n" name;
981 pr " guestfs_lvm_int_lv_list %s;\n" n;
986 (* Table of procedure numbers. *)
987 pr "enum guestfs_procedure {\n";
989 fun (shortname, _, proc_nr, _, _, _) ->
990 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
992 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
996 (* Having to choose a maximum message size is annoying for several
997 * reasons (it limits what we can do in the API), but it (a) makes
998 * the protocol a lot simpler, and (b) provides a bound on the size
999 * of the daemon which operates in limited memory space. For large
1000 * file transfers you should use FTP.
1002 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1005 (* Message header, etc. *)
1007 const GUESTFS_PROGRAM = 0x2000F5F5;
1008 const GUESTFS_PROTOCOL_VERSION = 1;
1010 enum guestfs_message_direction {
1011 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1012 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1015 enum guestfs_message_status {
1016 GUESTFS_STATUS_OK = 0,
1017 GUESTFS_STATUS_ERROR = 1
1020 const GUESTFS_ERROR_LEN = 256;
1022 struct guestfs_message_error {
1023 string error<GUESTFS_ERROR_LEN>; /* error message */
1026 struct guestfs_message_header {
1027 unsigned prog; /* GUESTFS_PROGRAM */
1028 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1029 guestfs_procedure proc; /* GUESTFS_PROC_x */
1030 guestfs_message_direction direction;
1031 unsigned serial; /* message serial number */
1032 guestfs_message_status status;
1036 (* Generate the guestfs-structs.h file. *)
1037 and generate_structs_h () =
1038 generate_header CStyle LGPLv2;
1040 (* This is a public exported header file containing various
1041 * structures. The structures are carefully written to have
1042 * exactly the same in-memory format as the XDR structures that
1043 * we use on the wire to the daemon. The reason for creating
1044 * copies of these structures here is just so we don't have to
1045 * export the whole of guestfs_protocol.h (which includes much
1046 * unrelated and XDR-dependent stuff that we don't want to be
1047 * public, or required by clients).
1049 * To reiterate, we will pass these structures to and from the
1050 * client with a simple assignment or memcpy, so the format
1051 * must be identical to what rpcgen / the RFC defines.
1054 (* guestfs_int_bool structure. *)
1055 pr "struct guestfs_int_bool {\n";
1061 (* LVM public structures. *)
1065 pr "struct guestfs_lvm_%s {\n" typ;
1068 | name, `String -> pr " char *%s;\n" name
1069 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1070 | name, `Bytes -> pr " uint64_t %s;\n" name
1071 | name, `Int -> pr " int64_t %s;\n" name
1072 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1076 pr "struct guestfs_lvm_%s_list {\n" typ;
1077 pr " uint32_t len;\n";
1078 pr " struct guestfs_lvm_%s *val;\n" typ;
1081 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1083 (* Generate the guestfs-actions.h file. *)
1084 and generate_actions_h () =
1085 generate_header CStyle LGPLv2;
1087 fun (shortname, style, _, _, _, _) ->
1088 let name = "guestfs_" ^ shortname in
1089 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1093 (* Generate the client-side dispatch stubs. *)
1094 and generate_client_actions () =
1095 generate_header CStyle LGPLv2;
1097 (* Client-side stubs for each function. *)
1099 fun (shortname, style, _, _, _, _) ->
1100 let name = "guestfs_" ^ shortname in
1102 (* Generate the return value struct. *)
1103 pr "struct %s_rv {\n" shortname;
1104 pr " int cb_done; /* flag to indicate callback was called */\n";
1105 pr " struct guestfs_message_header hdr;\n";
1106 pr " struct guestfs_message_error err;\n";
1107 (match fst style with
1110 failwithf "RConstString cannot be returned from a daemon function"
1112 | RBool _ | RString _ | RStringList _
1114 | RPVList _ | RVGList _ | RLVList _ ->
1115 pr " struct %s_ret ret;\n" name
1119 (* Generate the callback function. *)
1120 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1122 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1124 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1125 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1128 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1129 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1130 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1136 (match fst style with
1139 failwithf "RConstString cannot be returned from a daemon function"
1141 | RBool _ | RString _ | RStringList _
1143 | RPVList _ | RVGList _ | RLVList _ ->
1144 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1145 pr " error (g, \"%s: failed to parse reply\");\n" name;
1151 pr " rv->cb_done = 1;\n";
1152 pr " main_loop.main_loop_quit (g);\n";
1155 (* Generate the action stub. *)
1156 generate_prototype ~extern:false ~semicolon:false ~newline:true
1157 ~handle:"g" name style;
1160 match fst style with
1161 | RErr | RInt _ | RBool _ -> "-1"
1163 failwithf "RConstString cannot be returned from a daemon function"
1164 | RString _ | RStringList _ | RIntBool _
1165 | RPVList _ | RVGList _ | RLVList _ ->
1170 (match snd style with
1172 | _ -> pr " struct %s_args args;\n" name
1175 pr " struct %s_rv rv;\n" shortname;
1176 pr " int serial;\n";
1178 pr " if (g->state != READY) {\n";
1179 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1182 pr " return %s;\n" error_code;
1185 pr " memset (&rv, 0, sizeof rv);\n";
1188 (match snd style with
1190 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1191 (String.uppercase shortname)
1196 pr " args.%s = (char *) %s;\n" n n
1198 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1200 pr " args.%s = %s;\n" n n
1202 pr " args.%s = %s;\n" n n
1204 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1205 (String.uppercase shortname);
1206 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1209 pr " if (serial == -1)\n";
1210 pr " return %s;\n" error_code;
1213 pr " rv.cb_done = 0;\n";
1214 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1215 pr " g->reply_cb_internal_data = &rv;\n";
1216 pr " main_loop.main_loop_run (g);\n";
1217 pr " g->reply_cb_internal = NULL;\n";
1218 pr " g->reply_cb_internal_data = NULL;\n";
1219 pr " if (!rv.cb_done) {\n";
1220 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1221 pr " return %s;\n" error_code;
1225 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1226 (String.uppercase shortname);
1227 pr " return %s;\n" error_code;
1230 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1231 pr " error (g, \"%%s\", rv.err.error);\n";
1232 pr " return %s;\n" error_code;
1236 (match fst style with
1237 | RErr -> pr " return 0;\n"
1239 | RBool n -> pr " return rv.ret.%s;\n" n
1241 failwithf "RConstString cannot be returned from a daemon function"
1243 pr " return rv.ret.%s; /* caller will free */\n" n
1245 pr " /* caller will free this, but we need to add a NULL entry */\n";
1246 pr " rv.ret.%s.%s_val =" n n;
1247 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1248 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1250 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1251 pr " return rv.ret.%s.%s_val;\n" n n
1253 pr " /* caller with free this */\n";
1254 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1256 pr " /* caller will free this */\n";
1257 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1259 pr " /* caller will free this */\n";
1260 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1262 pr " /* caller will free this */\n";
1263 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1269 (* Generate daemon/actions.h. *)
1270 and generate_daemon_actions_h () =
1271 generate_header CStyle GPLv2;
1273 pr "#include \"../src/guestfs_protocol.h\"\n";
1277 fun (name, style, _, _, _, _) ->
1279 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1283 (* Generate the server-side stubs. *)
1284 and generate_daemon_actions () =
1285 generate_header CStyle GPLv2;
1287 pr "#define _GNU_SOURCE // for strchrnul\n";
1289 pr "#include <stdio.h>\n";
1290 pr "#include <stdlib.h>\n";
1291 pr "#include <string.h>\n";
1292 pr "#include <inttypes.h>\n";
1293 pr "#include <ctype.h>\n";
1294 pr "#include <rpc/types.h>\n";
1295 pr "#include <rpc/xdr.h>\n";
1297 pr "#include \"daemon.h\"\n";
1298 pr "#include \"../src/guestfs_protocol.h\"\n";
1299 pr "#include \"actions.h\"\n";
1303 fun (name, style, _, _, _, _) ->
1304 (* Generate server-side stubs. *)
1305 pr "static void %s_stub (XDR *xdr_in)\n" name;
1308 match fst style with
1309 | RErr | RInt _ -> pr " int r;\n"; "-1"
1310 | RBool _ -> pr " int r;\n"; "-1"
1312 failwithf "RConstString cannot be returned from a daemon function"
1313 | RString _ -> pr " char *r;\n"; "NULL"
1314 | RStringList _ -> pr " char **r;\n"; "NULL"
1315 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1316 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1317 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1318 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1320 (match snd style with
1323 pr " struct guestfs_%s_args args;\n" name;
1327 | OptString n -> pr " const char *%s;\n" n
1328 | Bool n -> pr " int %s;\n" n
1329 | Int n -> pr " int %s;\n" n
1334 (match snd style with
1337 pr " memset (&args, 0, sizeof args);\n";
1339 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1340 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1345 | String n -> pr " %s = args.%s;\n" n n
1346 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1347 | Bool n -> pr " %s = args.%s;\n" n n
1348 | Int n -> pr " %s = args.%s;\n" n n
1353 pr " r = do_%s " name;
1354 generate_call_args style;
1357 pr " if (r == %s)\n" error_code;
1358 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1362 (match fst style with
1363 | RErr -> pr " reply (NULL, NULL);\n"
1365 pr " struct guestfs_%s_ret ret;\n" name;
1366 pr " ret.%s = r;\n" n;
1367 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1369 pr " struct guestfs_%s_ret ret;\n" name;
1370 pr " ret.%s = r;\n" n;
1371 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1373 failwithf "RConstString cannot be returned from a daemon function"
1375 pr " struct guestfs_%s_ret ret;\n" name;
1376 pr " ret.%s = r;\n" n;
1377 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1380 pr " struct guestfs_%s_ret ret;\n" name;
1381 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1382 pr " ret.%s.%s_val = r;\n" n n;
1383 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1384 pr " free_strings (r);\n"
1386 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1387 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1389 pr " struct guestfs_%s_ret ret;\n" name;
1390 pr " ret.%s = *r;\n" n;
1391 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1392 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1394 pr " struct guestfs_%s_ret ret;\n" name;
1395 pr " ret.%s = *r;\n" n;
1396 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1397 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1399 pr " struct guestfs_%s_ret ret;\n" name;
1400 pr " ret.%s = *r;\n" n;
1401 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1402 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1408 (* Dispatch function. *)
1409 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1411 pr " switch (proc_nr) {\n";
1414 fun (name, style, _, _, _, _) ->
1415 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1416 pr " %s_stub (xdr_in);\n" name;
1421 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1426 (* LVM columns and tokenization functions. *)
1427 (* XXX This generates crap code. We should rethink how we
1433 pr "static const char *lvm_%s_cols = \"%s\";\n"
1434 typ (String.concat "," (List.map fst cols));
1437 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1439 pr " char *tok, *p, *next;\n";
1443 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1446 pr " if (!str) {\n";
1447 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1450 pr " if (!*str || isspace (*str)) {\n";
1451 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1456 fun (name, coltype) ->
1457 pr " if (!tok) {\n";
1458 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1461 pr " p = strchrnul (tok, ',');\n";
1462 pr " if (*p) next = p+1; else next = NULL;\n";
1463 pr " *p = '\\0';\n";
1466 pr " r->%s = strdup (tok);\n" name;
1467 pr " if (r->%s == NULL) {\n" name;
1468 pr " perror (\"strdup\");\n";
1472 pr " for (i = j = 0; i < 32; ++j) {\n";
1473 pr " if (tok[j] == '\\0') {\n";
1474 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1476 pr " } else if (tok[j] != '-')\n";
1477 pr " r->%s[i++] = tok[j];\n" name;
1480 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1481 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1485 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1486 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1490 pr " if (tok[0] == '\\0')\n";
1491 pr " r->%s = -1;\n" name;
1492 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1493 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1497 pr " tok = next;\n";
1500 pr " if (tok != NULL) {\n";
1501 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1508 pr "guestfs_lvm_int_%s_list *\n" typ;
1509 pr "parse_command_line_%ss (void)\n" typ;
1511 pr " char *out, *err;\n";
1512 pr " char *p, *pend;\n";
1514 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1515 pr " void *newp;\n";
1517 pr " ret = malloc (sizeof *ret);\n";
1518 pr " if (!ret) {\n";
1519 pr " reply_with_perror (\"malloc\");\n";
1520 pr " return NULL;\n";
1523 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1524 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1526 pr " r = command (&out, &err,\n";
1527 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1528 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1529 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1530 pr " if (r == -1) {\n";
1531 pr " reply_with_error (\"%%s\", err);\n";
1532 pr " free (out);\n";
1533 pr " free (err);\n";
1534 pr " return NULL;\n";
1537 pr " free (err);\n";
1539 pr " /* Tokenize each line of the output. */\n";
1542 pr " while (p) {\n";
1543 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1544 pr " if (pend) {\n";
1545 pr " *pend = '\\0';\n";
1549 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1552 pr " if (!*p) { /* Empty line? Skip it. */\n";
1557 pr " /* Allocate some space to store this next entry. */\n";
1558 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1559 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1560 pr " if (newp == NULL) {\n";
1561 pr " reply_with_perror (\"realloc\");\n";
1562 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1563 pr " free (ret);\n";
1564 pr " free (out);\n";
1565 pr " return NULL;\n";
1567 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1569 pr " /* Tokenize the next entry. */\n";
1570 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1571 pr " if (r == -1) {\n";
1572 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1573 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1574 pr " free (ret);\n";
1575 pr " free (out);\n";
1576 pr " return NULL;\n";
1583 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1585 pr " free (out);\n";
1586 pr " return ret;\n";
1589 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1591 (* Generate a lot of different functions for guestfish. *)
1592 and generate_fish_cmds () =
1593 generate_header CStyle GPLv2;
1597 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1599 let all_functions_sorted =
1601 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1602 ) all_functions_sorted in
1604 pr "#include <stdio.h>\n";
1605 pr "#include <stdlib.h>\n";
1606 pr "#include <string.h>\n";
1607 pr "#include <inttypes.h>\n";
1609 pr "#include <guestfs.h>\n";
1610 pr "#include \"fish.h\"\n";
1613 (* list_commands function, which implements guestfish -h *)
1614 pr "void list_commands (void)\n";
1616 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1617 pr " list_builtin_commands ();\n";
1619 fun (name, _, _, flags, shortdesc, _) ->
1620 let name = replace_char name '_' '-' in
1621 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1623 ) all_functions_sorted;
1624 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1628 (* display_command function, which implements guestfish -h cmd *)
1629 pr "void display_command (const char *cmd)\n";
1632 fun (name, style, _, flags, shortdesc, longdesc) ->
1633 let name2 = replace_char name '_' '-' in
1635 try find_map (function FishAlias n -> Some n | _ -> None) flags
1636 with Not_found -> name in
1637 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1639 match snd style with
1643 name2 (String.concat "> <" (List.map name_of_argt args)) in
1646 if List.mem ProtocolLimitWarning flags then
1647 "\n\nBecause of the message protocol, there is a transfer limit
1648 of somewhere between 2MB and 4MB. To transfer large files you should use
1652 let describe_alias =
1653 if name <> alias then
1654 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1658 pr "strcasecmp (cmd, \"%s\") == 0" name;
1659 if name <> name2 then
1660 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1661 if name <> alias then
1662 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1664 pr " pod2text (\"%s - %s\", %S);\n"
1666 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1669 pr " display_builtin_command (cmd);\n";
1673 (* print_{pv,vg,lv}_list functions *)
1677 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1684 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1686 pr " printf (\"%s: \");\n" name;
1687 pr " for (i = 0; i < 32; ++i)\n";
1688 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1689 pr " printf (\"\\n\");\n"
1691 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1693 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1694 | name, `OptPercent ->
1695 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1696 typ name name typ name;
1697 pr " else printf (\"%s: \\n\");\n" name
1701 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1706 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1707 pr " print_%s (&%ss->val[i]);\n" typ typ;
1710 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1712 (* run_<action> actions *)
1714 fun (name, style, _, flags, _, _) ->
1715 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1717 (match fst style with
1720 | RBool _ -> pr " int r;\n"
1721 | RConstString _ -> pr " const char *r;\n"
1722 | RString _ -> pr " char *r;\n"
1723 | RStringList _ -> pr " char **r;\n"
1724 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1725 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1726 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1727 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1731 | String n -> pr " const char *%s;\n" n
1732 | OptString n -> pr " const char *%s;\n" n
1733 | Bool n -> pr " int %s;\n" n
1734 | Int n -> pr " int %s;\n" n
1737 (* Check and convert parameters. *)
1738 let argc_expected = List.length (snd style) in
1739 pr " if (argc != %d) {\n" argc_expected;
1740 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1742 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1748 | String name -> pr " %s = argv[%d];\n" name i
1750 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1753 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1755 pr " %s = atoi (argv[%d]);\n" name i
1758 (* Call C API function. *)
1760 try find_map (function FishAction n -> Some n | _ -> None) flags
1761 with Not_found -> sprintf "guestfs_%s" name in
1763 generate_call_args ~handle:"g" style;
1766 (* Check return value for errors and display command results. *)
1767 (match fst style with
1768 | RErr -> pr " return r;\n"
1770 pr " if (r == -1) return -1;\n";
1771 pr " if (r) printf (\"%%d\\n\", r);\n";
1774 pr " if (r == -1) return -1;\n";
1775 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1778 pr " if (r == NULL) return -1;\n";
1779 pr " printf (\"%%s\\n\", r);\n";
1782 pr " if (r == NULL) return -1;\n";
1783 pr " printf (\"%%s\\n\", r);\n";
1787 pr " if (r == NULL) return -1;\n";
1788 pr " print_strings (r);\n";
1789 pr " free_strings (r);\n";
1792 pr " if (r == NULL) return -1;\n";
1793 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1794 pr " r->b ? \"true\" : \"false\");\n";
1795 pr " guestfs_free_int_bool (r);\n";
1798 pr " if (r == NULL) return -1;\n";
1799 pr " print_pv_list (r);\n";
1800 pr " guestfs_free_lvm_pv_list (r);\n";
1803 pr " if (r == NULL) return -1;\n";
1804 pr " print_vg_list (r);\n";
1805 pr " guestfs_free_lvm_vg_list (r);\n";
1808 pr " if (r == NULL) return -1;\n";
1809 pr " print_lv_list (r);\n";
1810 pr " guestfs_free_lvm_lv_list (r);\n";
1817 (* run_action function *)
1818 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1821 fun (name, _, _, flags, _, _) ->
1822 let name2 = replace_char name '_' '-' in
1824 try find_map (function FishAlias n -> Some n | _ -> None) flags
1825 with Not_found -> name in
1827 pr "strcasecmp (cmd, \"%s\") == 0" name;
1828 if name <> name2 then
1829 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1830 if name <> alias then
1831 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1833 pr " return run_%s (cmd, argc, argv);\n" name;
1837 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1844 (* Generate the POD documentation for guestfish. *)
1845 and generate_fish_actions_pod () =
1846 let all_functions_sorted =
1848 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1849 ) all_functions_sorted in
1852 fun (name, style, _, flags, _, longdesc) ->
1853 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1854 let name = replace_char name '_' '-' in
1856 try find_map (function FishAlias n -> Some n | _ -> None) flags
1857 with Not_found -> name in
1859 pr "=head2 %s" name;
1860 if name <> alias then
1867 | String n -> pr " %s" n
1868 | OptString n -> pr " %s" n
1869 | Bool _ -> pr " true|false"
1870 | Int n -> pr " %s" n
1874 pr "%s\n\n" longdesc
1875 ) all_functions_sorted
1877 (* Generate a C function prototype. *)
1878 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1879 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1881 ?handle name style =
1882 if extern then pr "extern ";
1883 if static then pr "static ";
1884 (match fst style with
1886 | RInt _ -> pr "int "
1887 | RBool _ -> pr "int "
1888 | RConstString _ -> pr "const char *"
1889 | RString _ -> pr "char *"
1890 | RStringList _ -> pr "char **"
1892 if not in_daemon then pr "struct guestfs_int_bool *"
1893 else pr "guestfs_%s_ret *" name
1895 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1896 else pr "guestfs_lvm_int_pv_list *"
1898 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1899 else pr "guestfs_lvm_int_vg_list *"
1901 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1902 else pr "guestfs_lvm_int_lv_list *"
1904 pr "%s%s (" prefix name;
1905 if handle = None && List.length (snd style) = 0 then
1908 let comma = ref false in
1911 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1915 if single_line then pr ", " else pr ",\n\t\t"
1921 | String n -> next (); pr "const char *%s" n
1922 | OptString n -> next (); pr "const char *%s" n
1923 | Bool n -> next (); pr "int %s" n
1924 | Int n -> next (); pr "int %s" n
1928 if semicolon then pr ";";
1929 if newline then pr "\n"
1931 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1932 and generate_call_args ?handle style =
1934 let comma = ref false in
1937 | Some handle -> pr "%s" handle; comma := true
1941 if !comma then pr ", ";
1944 | String n -> pr "%s" n
1945 | OptString n -> pr "%s" n
1946 | Bool n -> pr "%s" n
1947 | Int n -> pr "%s" n
1951 (* Generate the OCaml bindings interface. *)
1952 and generate_ocaml_mli () =
1953 generate_header OCamlStyle LGPLv2;
1956 (** For API documentation you should refer to the C API
1957 in the guestfs(3) manual page. The OCaml API uses almost
1958 exactly the same calls. *)
1961 (** A [guestfs_h] handle. *)
1963 exception Error of string
1964 (** This exception is raised when there is an error. *)
1966 val create : unit -> t
1968 val close : t -> unit
1969 (** Handles are closed by the garbage collector when they become
1970 unreferenced, but callers can also call this in order to
1971 provide predictable cleanup. *)
1974 generate_ocaml_lvm_structure_decls ();
1978 fun (name, style, _, _, shortdesc, _) ->
1979 generate_ocaml_prototype name style;
1980 pr "(** %s *)\n" shortdesc;
1984 (* Generate the OCaml bindings implementation. *)
1985 and generate_ocaml_ml () =
1986 generate_header OCamlStyle LGPLv2;
1990 exception Error of string
1991 external create : unit -> t = \"ocaml_guestfs_create\"
1992 external close : t -> unit = \"ocaml_guestfs_close\"
1995 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1999 generate_ocaml_lvm_structure_decls ();
2003 fun (name, style, _, _, shortdesc, _) ->
2004 generate_ocaml_prototype ~is_external:true name style;
2007 (* Generate the OCaml bindings C implementation. *)
2008 and generate_ocaml_c () =
2009 generate_header CStyle LGPLv2;
2011 pr "#include <stdio.h>\n";
2012 pr "#include <stdlib.h>\n";
2013 pr "#include <string.h>\n";
2015 pr "#include <caml/config.h>\n";
2016 pr "#include <caml/alloc.h>\n";
2017 pr "#include <caml/callback.h>\n";
2018 pr "#include <caml/fail.h>\n";
2019 pr "#include <caml/memory.h>\n";
2020 pr "#include <caml/mlvalues.h>\n";
2021 pr "#include <caml/signals.h>\n";
2023 pr "#include <guestfs.h>\n";
2025 pr "#include \"guestfs_c.h\"\n";
2028 (* LVM struct copy functions. *)
2031 let has_optpercent_col =
2032 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
2034 pr "static CAMLprim value\n";
2035 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
2037 pr " CAMLparam0 ();\n";
2038 if has_optpercent_col then
2039 pr " CAMLlocal3 (rv, v, v2);\n"
2041 pr " CAMLlocal2 (rv, v);\n";
2043 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
2048 pr " v = caml_copy_string (%s->%s);\n" typ name
2050 pr " v = caml_alloc_string (32);\n";
2051 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
2054 pr " v = caml_copy_int64 (%s->%s);\n" typ name
2055 | name, `OptPercent ->
2056 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
2057 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
2058 pr " v = caml_alloc (1, 0);\n";
2059 pr " Store_field (v, 0, v2);\n";
2060 pr " } else /* None */\n";
2061 pr " v = Val_int (0);\n";
2063 pr " Store_field (rv, %d, v);\n" i
2065 pr " CAMLreturn (rv);\n";
2069 pr "static CAMLprim value\n";
2070 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
2073 pr " CAMLparam0 ();\n";
2074 pr " CAMLlocal2 (rv, v);\n";
2077 pr " if (%ss->len == 0)\n" typ;
2078 pr " CAMLreturn (Atom (0));\n";
2080 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
2081 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
2082 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
2083 pr " caml_modify (&Field (rv, i), v);\n";
2085 pr " CAMLreturn (rv);\n";
2089 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2092 fun (name, style, _, _, _, _) ->
2093 pr "CAMLprim value\n";
2094 pr "ocaml_guestfs_%s (value gv" name;
2096 fun arg -> pr ", value %sv" (name_of_argt arg)
2100 pr " CAMLparam%d (gv" (1 + (List.length (snd style)));
2102 fun arg -> pr ", %sv" (name_of_argt arg)
2105 pr " CAMLlocal1 (rv);\n";
2108 pr " guestfs_h *g = Guestfs_val (gv);\n";
2109 pr " if (g == NULL)\n";
2110 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2116 pr " const char *%s = String_val (%sv);\n" n n
2118 pr " const char *%s =\n" n;
2119 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2122 pr " int %s = Bool_val (%sv);\n" n n
2124 pr " int %s = Int_val (%sv);\n" n n
2127 match fst style with
2128 | RErr -> pr " int r;\n"; "-1"
2129 | RInt _ -> pr " int r;\n"; "-1"
2130 | RBool _ -> pr " int r;\n"; "-1"
2131 | RConstString _ -> pr " const char *r;\n"; "NULL"
2132 | RString _ -> pr " char *r;\n"; "NULL"
2138 pr " struct guestfs_int_bool *r;\n";
2141 pr " struct guestfs_lvm_pv_list *r;\n";
2144 pr " struct guestfs_lvm_vg_list *r;\n";
2147 pr " struct guestfs_lvm_lv_list *r;\n";
2151 pr " caml_enter_blocking_section ();\n";
2152 pr " r = guestfs_%s " name;
2153 generate_call_args ~handle:"g" style;
2155 pr " caml_leave_blocking_section ();\n";
2156 pr " if (r == %s)\n" error_code;
2157 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2160 (match fst style with
2161 | RErr -> pr " rv = Val_unit;\n"
2162 | RInt _ -> pr " rv = Val_int (r);\n"
2163 | RBool _ -> pr " rv = Val_bool (r);\n"
2164 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2166 pr " rv = caml_copy_string (r);\n";
2169 pr " rv = caml_copy_string_array ((const char **) r);\n";
2170 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2173 pr " rv = caml_alloc (2, 0);\n";
2174 pr " Store_field (rv, 0, Val_int (r->i));\n";
2175 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2176 pr " guestfs_free_int_bool (r);\n";
2178 pr " rv = copy_lvm_pv_list (r);\n";
2179 pr " guestfs_free_lvm_pv_list (r);\n";
2181 pr " rv = copy_lvm_vg_list (r);\n";
2182 pr " guestfs_free_lvm_vg_list (r);\n";
2184 pr " rv = copy_lvm_lv_list (r);\n";
2185 pr " guestfs_free_lvm_lv_list (r);\n";
2188 pr " CAMLreturn (rv);\n";
2193 and generate_ocaml_lvm_structure_decls () =
2196 pr "type lvm_%s = {\n" typ;
2199 | name, `String -> pr " %s : string;\n" name
2200 | name, `UUID -> pr " %s : string;\n" name
2201 | name, `Bytes -> pr " %s : int64;\n" name
2202 | name, `Int -> pr " %s : int64;\n" name
2203 | name, `OptPercent -> pr " %s : float option;\n" name
2207 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2209 and generate_ocaml_prototype ?(is_external = false) name style =
2210 if is_external then pr "external " else pr "val ";
2211 pr "%s : t -> " name;
2214 | String _ -> pr "string -> "
2215 | OptString _ -> pr "string option -> "
2216 | Bool _ -> pr "bool -> "
2217 | Int _ -> pr "int -> "
2219 (match fst style with
2220 | RErr -> pr "unit" (* all errors are turned into exceptions *)
2221 | RInt _ -> pr "int"
2222 | RBool _ -> pr "bool"
2223 | RConstString _ -> pr "string"
2224 | RString _ -> pr "string"
2225 | RStringList _ -> pr "string array"
2226 | RIntBool _ -> pr "int * bool"
2227 | RPVList _ -> pr "lvm_pv array"
2228 | RVGList _ -> pr "lvm_vg array"
2229 | RLVList _ -> pr "lvm_lv array"
2231 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2234 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2235 and generate_perl_xs () =
2236 generate_header CStyle LGPLv2;
2239 #include \"EXTERN.h\"
2243 #include <guestfs.h>
2246 #define PRId64 \"lld\"
2250 my_newSVll(long long val) {
2251 #ifdef USE_64_BIT_ALL
2252 return newSViv(val);
2256 len = snprintf(buf, 100, \"%%\" PRId64, val);
2257 return newSVpv(buf, len);
2262 #define PRIu64 \"llu\"
2266 my_newSVull(unsigned long long val) {
2267 #ifdef USE_64_BIT_ALL
2268 return newSVuv(val);
2272 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2273 return newSVpv(buf, len);
2277 /* XXX Not thread-safe, and in general not safe if the caller is
2278 * issuing multiple requests in parallel (on different guestfs
2279 * handles). We should use the guestfs_h handle passed to the
2280 * error handle to distinguish these cases.
2282 static char *last_error = NULL;
2285 error_handler (guestfs_h *g,
2289 if (last_error != NULL) free (last_error);
2290 last_error = strdup (msg);
2293 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2298 RETVAL = guestfs_create ();
2300 croak (\"could not create guestfs handle\");
2301 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2314 fun (name, style, _, _, _, _) ->
2315 (match fst style with
2316 | RErr -> pr "void\n"
2317 | RInt _ -> pr "SV *\n"
2318 | RBool _ -> pr "SV *\n"
2319 | RConstString _ -> pr "SV *\n"
2320 | RString _ -> pr "SV *\n"
2323 | RPVList _ | RVGList _ | RLVList _ ->
2324 pr "void\n" (* all lists returned implictly on the stack *)
2326 (* Call and arguments. *)
2328 generate_call_args ~handle:"g" style;
2330 pr " guestfs_h *g;\n";
2333 | String n -> pr " char *%s;\n" n
2334 | OptString n -> pr " char *%s;\n" n
2335 | Bool n -> pr " int %s;\n" n
2336 | Int n -> pr " int %s;\n" n
2339 (match fst style with
2342 pr " if (guestfs_%s " name;
2343 generate_call_args ~handle:"g" style;
2345 pr " croak (\"%s: %%s\", last_error);\n" name
2351 pr " %s = guestfs_%s " n name;
2352 generate_call_args ~handle:"g" style;
2354 pr " if (%s == -1)\n" n;
2355 pr " croak (\"%s: %%s\", last_error);\n" name;
2356 pr " RETVAL = newSViv (%s);\n" n;
2361 pr " const char *%s;\n" n;
2363 pr " %s = guestfs_%s " n name;
2364 generate_call_args ~handle:"g" style;
2366 pr " if (%s == NULL)\n" n;
2367 pr " croak (\"%s: %%s\", last_error);\n" name;
2368 pr " RETVAL = newSVpv (%s, 0);\n" n;
2373 pr " char *%s;\n" n;
2375 pr " %s = guestfs_%s " n name;
2376 generate_call_args ~handle:"g" style;
2378 pr " if (%s == NULL)\n" n;
2379 pr " croak (\"%s: %%s\", last_error);\n" name;
2380 pr " RETVAL = newSVpv (%s, 0);\n" n;
2381 pr " free (%s);\n" n;
2386 pr " char **%s;\n" n;
2389 pr " %s = guestfs_%s " n name;
2390 generate_call_args ~handle:"g" style;
2392 pr " if (%s == NULL)\n" n;
2393 pr " croak (\"%s: %%s\", last_error);\n" name;
2394 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2395 pr " EXTEND (SP, n);\n";
2396 pr " for (i = 0; i < n; ++i) {\n";
2397 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2398 pr " free (%s[i]);\n" n;
2400 pr " free (%s);\n" n;
2403 pr " struct guestfs_int_bool *r;\n";
2405 pr " r = guestfs_%s " name;
2406 generate_call_args ~handle:"g" style;
2408 pr " if (r == NULL)\n";
2409 pr " croak (\"%s: %%s\", last_error);\n" name;
2410 pr " EXTEND (SP, 2);\n";
2411 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2412 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2413 pr " guestfs_free_int_bool (r);\n";
2415 generate_perl_lvm_code "pv" pv_cols name style n;
2417 generate_perl_lvm_code "vg" vg_cols name style n;
2419 generate_perl_lvm_code "lv" lv_cols name style n;
2424 and generate_perl_lvm_code typ cols name style n =
2426 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2430 pr " %s = guestfs_%s " n name;
2431 generate_call_args ~handle:"g" style;
2433 pr " if (%s == NULL)\n" n;
2434 pr " croak (\"%s: %%s\", last_error);\n" name;
2435 pr " EXTEND (SP, %s->len);\n" n;
2436 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2437 pr " hv = newHV ();\n";
2441 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2442 name (String.length name) n name
2444 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2445 name (String.length name) n name
2447 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2448 name (String.length name) n name
2450 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2451 name (String.length name) n name
2452 | name, `OptPercent ->
2453 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2454 name (String.length name) n name
2456 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2458 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2460 (* Generate Sys/Guestfs.pm. *)
2461 and generate_perl_pm () =
2462 generate_header HashStyle LGPLv2;
2469 Sys::Guestfs - Perl bindings for libguestfs
2475 my $h = Sys::Guestfs->new ();
2476 $h->add_drive ('guest.img');
2479 $h->mount ('/dev/sda1', '/');
2480 $h->touch ('/hello');
2485 The C<Sys::Guestfs> module provides a Perl XS binding to the
2486 libguestfs API for examining and modifying virtual machine
2489 Amongst the things this is good for: making batch configuration
2490 changes to guests, getting disk used/free statistics (see also:
2491 virt-df), migrating between virtualization systems (see also:
2492 virt-p2v), performing partial backups, performing partial guest
2493 clones, cloning guests and changing registry/UUID/hostname info, and
2496 Libguestfs uses Linux kernel and qemu code, and can access any type of
2497 guest filesystem that Linux and qemu can, including but not limited
2498 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2499 schemes, qcow, qcow2, vmdk.
2501 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2502 LVs, what filesystem is in each LV, etc.). It can also run commands
2503 in the context of the guest. Also you can access filesystems over FTP.
2507 All errors turn into calls to C<croak> (see L<Carp(3)>).
2515 package Sys::Guestfs;
2521 XSLoader::load ('Sys::Guestfs');
2523 =item $h = Sys::Guestfs->new ();
2525 Create a new guestfs handle.
2531 my $class = ref ($proto) || $proto;
2533 my $self = Sys::Guestfs::_create ();
2534 bless $self, $class;
2540 (* Actions. We only need to print documentation for these as
2541 * they are pulled in from the XS code automatically.
2544 fun (name, style, _, flags, _, longdesc) ->
2545 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2547 generate_perl_prototype name style;
2549 pr "%s\n\n" longdesc;
2550 if List.mem ProtocolLimitWarning flags then
2551 pr "Because of the message protocol, there is a transfer limit
2552 of somewhere between 2MB and 4MB. To transfer large files you should use
2554 ) all_functions_sorted;
2566 Copyright (C) 2009 Red Hat Inc.
2570 Please see the file COPYING.LIB for the full license.
2574 L<guestfs(3)>, L<guestfish(1)>.
2579 and generate_perl_prototype name style =
2580 (match fst style with
2585 | RString n -> pr "$%s = " n
2586 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2590 | RLVList n -> pr "@%s = " n
2593 let comma = ref false in
2596 if !comma then pr ", ";
2598 pr "%s" (name_of_argt arg)
2602 let output_to filename =
2603 let filename_new = filename ^ ".new" in
2604 chan := open_out filename_new;
2608 Unix.rename filename_new filename;
2609 printf "written %s\n%!" filename;
2617 if not (Sys.file_exists "configure.ac") then (
2619 You are probably running this from the wrong directory.
2620 Run it from the top source directory using the command
2626 let close = output_to "src/guestfs_protocol.x" in
2630 let close = output_to "src/guestfs-structs.h" in
2631 generate_structs_h ();
2634 let close = output_to "src/guestfs-actions.h" in
2635 generate_actions_h ();
2638 let close = output_to "src/guestfs-actions.c" in
2639 generate_client_actions ();
2642 let close = output_to "daemon/actions.h" in
2643 generate_daemon_actions_h ();
2646 let close = output_to "daemon/stubs.c" in
2647 generate_daemon_actions ();
2650 let close = output_to "fish/cmds.c" in
2651 generate_fish_cmds ();
2654 let close = output_to "guestfs-structs.pod" in
2655 generate_structs_pod ();
2658 let close = output_to "guestfs-actions.pod" in
2659 generate_actions_pod ();
2662 let close = output_to "guestfish-actions.pod" in
2663 generate_fish_actions_pod ();
2666 let close = output_to "ocaml/guestfs.mli" in
2667 generate_ocaml_mli ();
2670 let close = output_to "ocaml/guestfs.ml" in
2671 generate_ocaml_ml ();
2674 let close = output_to "ocaml/guestfs_c_actions.c" in
2675 generate_ocaml_c ();
2678 let close = output_to "perl/Guestfs.xs" in
2679 generate_perl_xs ();
2682 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2683 generate_perl_pm ();