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 (* "Err" 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 | String of string (* const char *name, cannot be NULL *)
69 | OptString of string (* const char *name, may be NULL *)
70 | Bool of string (* boolean *)
71 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
74 | ProtocolLimitWarning (* display warning about protocol size limits *)
75 | FishAlias of string (* provide an alias for this cmd in guestfish *)
76 | FishAction of string (* call this function in guestfish *)
77 | NotInFish (* do not export via guestfish *)
79 (* Note about long descriptions: When referring to another
80 * action, use the format C<guestfs_other> (ie. the full name of
81 * the C function). This will be replaced as appropriate in other
84 * Apart from that, long descriptions are just perldoc paragraphs.
87 let non_daemon_functions = [
88 ("launch", (Err, []), -1, [FishAlias "run"; FishAction "launch"],
89 "launch the qemu subprocess",
91 Internally libguestfs is implemented by running a virtual machine
94 You should call this after configuring the handle
95 (eg. adding drives) but before performing any actions.");
97 ("wait_ready", (Err, []), -1, [NotInFish],
98 "wait until the qemu subprocess launches",
100 Internally libguestfs is implemented by running a virtual machine
103 You should call this after C<guestfs_launch> to wait for the launch
106 ("kill_subprocess", (Err, []), -1, [],
107 "kill the qemu subprocess",
109 This kills the qemu subprocess. You should never need to call this.");
111 ("add_drive", (Err, [String "filename"]), -1, [FishAlias "add"],
112 "add an image to examine or modify",
114 This function adds a virtual machine disk image C<filename> to the
115 guest. The first time you call this function, the disk appears as IDE
116 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
119 You don't necessarily need to be root when using libguestfs. However
120 you obviously do need sufficient permissions to access the filename
121 for whatever operations you want to perform (ie. read access if you
122 just want to read the image or write access if you want to modify the
125 This is equivalent to the qemu parameter C<-drive file=filename>.");
127 ("add_cdrom", (Err, [String "filename"]), -1, [FishAlias "cdrom"],
128 "add a CD-ROM disk image to examine",
130 This function adds a virtual CD-ROM disk image to the guest.
132 This is equivalent to the qemu parameter C<-cdrom filename>.");
134 ("config", (Err, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
135 "add qemu parameters",
137 This can be used to add arbitrary qemu command line parameters
138 of the form C<-param value>. Actually it's not quite arbitrary - we
139 prevent you from setting some parameters which would interfere with
140 parameters that we use.
142 The first character of C<param> string must be a C<-> (dash).
144 C<value> can be NULL.");
146 ("set_path", (Err, [String "path"]), -1, [FishAlias "path"],
147 "set the search path",
149 Set the path that libguestfs searches for kernel and initrd.img.
151 The default is C<$libdir/guestfs> unless overridden by setting
152 C<LIBGUESTFS_PATH> environment variable.
154 The string C<path> is stashed in the libguestfs handle, so the caller
155 must make sure it remains valid for the lifetime of the handle.
157 Setting C<path> to C<NULL> restores the default path.");
159 ("get_path", (RConstString "path", []), -1, [],
160 "get the search path",
162 Return the current search path.
164 This is always non-NULL. If it wasn't set already, then this will
165 return the default path.");
167 ("set_autosync", (Err, [Bool "autosync"]), -1, [FishAlias "autosync"],
170 If C<autosync> is true, this enables autosync. Libguestfs will make a
171 best effort attempt to run C<guestfs_sync> when the handle is closed
172 (also if the program exits without closing handles).");
174 ("get_autosync", (RBool "autosync", []), -1, [],
177 Get the autosync flag.");
179 ("set_verbose", (Err, [Bool "verbose"]), -1, [FishAlias "verbose"],
182 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
184 Verbose messages are disabled unless the environment variable
185 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
187 ("get_verbose", (RBool "verbose", []), -1, [],
190 This returns the verbose messages flag.")
193 let daemon_functions = [
194 ("mount", (Err, [String "device"; String "mountpoint"]), 1, [],
195 "mount a guest disk at a position in the filesystem",
197 Mount a guest disk at a position in the filesystem. Block devices
198 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
199 the guest. If those block devices contain partitions, they will have
200 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
203 The rules are the same as for L<mount(2)>: A filesystem must
204 first be mounted on C</> before others can be mounted. Other
205 filesystems can only be mounted on directories which already
208 The mounted filesystem is writable, if we have sufficient permissions
209 on the underlying device.
211 The filesystem options C<sync> and C<noatime> are set with this
212 call, in order to improve reliability.");
214 ("sync", (Err, []), 2, [],
215 "sync disks, writes are flushed through to the disk image",
217 This syncs the disk, so that any writes are flushed through to the
218 underlying disk image.
220 You should always call this if you have modified a disk image, before
221 closing the handle.");
223 ("touch", (Err, [String "path"]), 3, [],
224 "update file timestamps or create a new file",
226 Touch acts like the L<touch(1)> command. It can be used to
227 update the timestamps on a file, or, if the file does not exist,
228 to create a new zero-length file.");
230 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
231 "list the contents of a file",
233 Return the contents of the file named C<path>.
235 Note that this function cannot correctly handle binary files
236 (specifically, files containing C<\\0> character which is treated
237 as end of string). For those you need to use the C<guestfs_read_file>
238 function which has a more complex interface.");
240 ("ll", (RString "listing", [String "directory"]), 5, [],
241 "list the files in a directory (long format)",
243 List the files in C<directory> (relative to the root directory,
244 there is no cwd) in the format of 'ls -la'.
246 This command is mostly useful for interactive sessions. It
247 is I<not> intended that you try to parse the output string.");
249 ("ls", (RStringList "listing", [String "directory"]), 6, [],
250 "list the files in a directory",
252 List the files in C<directory> (relative to the root directory,
253 there is no cwd). The '.' and '..' entries are not returned, but
254 hidden files are shown.
256 This command is mostly useful for interactive sessions. Programs
257 should probably use C<guestfs_readdir> instead.");
259 ("list_devices", (RStringList "devices", []), 7, [],
260 "list the block devices",
262 List all the block devices.
264 The full block device names are returned, eg. C</dev/sda>");
266 ("list_partitions", (RStringList "partitions", []), 8, [],
267 "list the partitions",
269 List all the partitions detected on all block devices.
271 The full partition device names are returned, eg. C</dev/sda1>
273 This does not return logical volumes. For that you will need to
274 call C<guestfs_lvs>.");
276 ("pvs", (RStringList "physvols", []), 9, [],
277 "list the LVM physical volumes (PVs)",
279 List all the physical volumes detected. This is the equivalent
280 of the L<pvs(8)> command.
282 This returns a list of just the device names that contain
283 PVs (eg. C</dev/sda2>).
285 See also C<guestfs_pvs_full>.");
287 ("vgs", (RStringList "volgroups", []), 10, [],
288 "list the LVM volume groups (VGs)",
290 List all the volumes groups detected. This is the equivalent
291 of the L<vgs(8)> command.
293 This returns a list of just the volume group names that were
294 detected (eg. C<VolGroup00>).
296 See also C<guestfs_vgs_full>.");
298 ("lvs", (RStringList "logvols", []), 11, [],
299 "list the LVM logical volumes (LVs)",
301 List all the logical volumes detected. This is the equivalent
302 of the L<lvs(8)> command.
304 This returns a list of the logical volume device names
305 (eg. C</dev/VolGroup00/LogVol00>).
307 See also C<guestfs_lvs_full>.");
309 ("pvs_full", (RPVList "physvols", []), 12, [],
310 "list the LVM physical volumes (PVs)",
312 List all the physical volumes detected. This is the equivalent
313 of the L<pvs(8)> command. The \"full\" version includes all fields.");
315 ("vgs_full", (RVGList "volgroups", []), 13, [],
316 "list the LVM volume groups (VGs)",
318 List all the volumes groups detected. This is the equivalent
319 of the L<vgs(8)> command. The \"full\" version includes all fields.");
321 ("lvs_full", (RLVList "logvols", []), 14, [],
322 "list the LVM logical volumes (LVs)",
324 List all the logical volumes detected. This is the equivalent
325 of the L<lvs(8)> command. The \"full\" version includes all fields.");
327 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
328 "read file as lines",
330 Return the contents of the file named C<path>.
332 The file contents are returned as a list of lines. Trailing
333 C<LF> and C<CRLF> character sequences are I<not> returned.
335 Note that this function cannot correctly handle binary files
336 (specifically, files containing C<\\0> character which is treated
337 as end of line). For those you need to use the C<guestfs_read_file>
338 function which has a more complex interface.");
340 ("aug_init", (Err, [String "root"; Int "flags"]), 16, [],
341 "create a new Augeas handle",
343 Create a new Augeas handle for editing configuration files.
344 If there was any previous Augeas handle associated with this
345 guestfs session, then it is closed.
347 You must call this before using any other C<guestfs_aug_*>
350 C<root> is the filesystem root. C<root> must not be NULL,
353 The flags are the same as the flags defined in
354 E<lt>augeas.hE<gt>, the logical I<or> of the following
359 =item C<AUG_SAVE_BACKUP> = 1
361 Keep the original file with a C<.augsave> extension.
363 =item C<AUG_SAVE_NEWFILE> = 2
365 Save changes into a file with extension C<.augnew>, and
366 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
368 =item C<AUG_TYPE_CHECK> = 4
370 Typecheck lenses (can be expensive).
372 =item C<AUG_NO_STDINC> = 8
374 Do not use standard load path for modules.
376 =item C<AUG_SAVE_NOOP> = 16
378 Make save a no-op, just record what would have been changed.
380 =item C<AUG_NO_LOAD> = 32
382 Do not load the tree in C<guestfs_aug_init>.
386 To close the handle, you can call C<guestfs_aug_close>.
388 To find out more about Augeas, see L<http://augeas.net/>.");
390 ("aug_close", (Err, []), 26, [],
391 "close the current Augeas handle",
393 Close the current Augeas handle and free up any resources
394 used by it. After calling this, you have to call
395 C<guestfs_aug_init> again before you can use any other
398 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
399 "define an Augeas variable",
401 Defines an Augeas variable C<name> whose value is the result
402 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
405 On success this returns the number of nodes in C<expr>, or
406 C<0> if C<expr> evaluates to something which is not a nodeset.");
408 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
409 "define an Augeas node",
411 Defines a variable C<name> whose value is the result of
414 If C<expr> evaluates to an empty nodeset, a node is created,
415 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
416 C<name> will be the nodeset containing that single node.
418 On success this returns a pair containing the
419 number of nodes in the nodeset, and a boolean flag
420 if a node was created.");
422 ("aug_get", (RString "val", [String "path"]), 19, [],
423 "look up the value of an Augeas path",
425 Look up the value associated with C<path>. If C<path>
426 matches exactly one node, the C<value> is returned.");
428 ("aug_set", (Err, [String "path"; String "val"]), 20, [],
429 "set Augeas path to value",
431 Set the value associated with C<path> to C<value>.");
433 ("aug_insert", (Err, [String "path"; String "label"; Bool "before"]), 21, [],
434 "insert a sibling Augeas node",
436 Create a new sibling C<label> for C<path>, inserting it into
437 the tree before or after C<path> (depending on the boolean
440 C<path> must match exactly one existing node in the tree, and
441 C<label> must be a label, ie. not contain C</>, C<*> or end
442 with a bracketed index C<[N]>.");
444 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
445 "remove an Augeas path",
447 Remove C<path> and all of its children.
449 On success this returns the number of entries which were removed.");
451 ("aug_mv", (Err, [String "src"; String "dest"]), 23, [],
454 Move the node C<src> to C<dest>. C<src> must match exactly
455 one node. C<dest> is overwritten if it exists.");
457 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
458 "return Augeas nodes which match path",
460 Returns a list of paths which match the path expression C<path>.
461 The returned paths are sufficiently qualified so that they match
462 exactly one node in the current tree.");
464 ("aug_save", (Err, []), 25, [],
465 "write all pending Augeas changes to disk",
467 This writes all pending changes to disk.
469 The flags which were passed to C<guestfs_aug_init> affect exactly
470 how files are saved.");
472 ("aug_load", (Err, []), 27, [],
473 "load files into the tree",
475 Load files into the tree.
477 See C<aug_load> in the Augeas documentation for the full gory
480 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
481 "list Augeas nodes under a path",
483 This is just a shortcut for listing C<guestfs_aug_match>
484 C<path/*> and sorting the resulting nodes into alphabetical order.");
488 let all_functions = non_daemon_functions @ daemon_functions
490 (* In some places we want the functions to be displayed sorted
491 * alphabetically, so this is useful:
493 let all_functions_sorted =
494 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
496 (* Column names and types from LVM PVs/VGs/LVs. *)
505 "pv_attr", `String (* XXX *);
507 "pv_pe_alloc_count", `Int;
510 "pv_mda_count", `Int;
511 "pv_mda_free", `Bytes;
513 "pv_mda_size", `Bytes;
520 "vg_attr", `String (* XXX *);
524 "vg_extent_size", `Bytes;
525 "vg_extent_count", `Int;
526 "vg_free_count", `Int;
534 "vg_mda_count", `Int;
535 "vg_mda_free", `Bytes;
537 "vg_mda_size", `Bytes;
543 "lv_attr", `String (* XXX *);
546 "lv_kernel_major", `Int;
547 "lv_kernel_minor", `Int;
551 "snap_percent", `OptPercent;
552 "copy_percent", `OptPercent;
555 "mirror_log", `String;
560 * Note we don't want to use any external OCaml libraries which
561 * makes this a bit harder than it should be.
563 let failwithf fs = ksprintf failwith fs
565 let replace_char s c1 c2 =
566 let s2 = String.copy s in
568 for i = 0 to String.length s2 - 1 do
569 if String.unsafe_get s2 i = c1 then (
570 String.unsafe_set s2 i c2;
574 if not !r then s else s2
577 let len = String.length s in
578 let sublen = String.length sub in
580 if i <= len-sublen then (
583 if s.[i+j] = sub.[j] then loop2 (j+1)
589 if r = -1 then loop (i+1) else r
595 let rec replace_str s s1 s2 =
596 let len = String.length s in
597 let sublen = String.length s1 in
601 let s' = String.sub s 0 i in
602 let s'' = String.sub s (i+sublen) (len-i-sublen) in
603 s' ^ s2 ^ replace_str s'' s1 s2
606 let rec find_map f = function
607 | [] -> raise Not_found
611 | None -> find_map f xs
614 let rec loop i = function
616 | x :: xs -> f i x; loop (i+1) xs
620 (* 'pr' prints to the current output file. *)
621 let chan = ref stdout
622 let pr fs = ksprintf (output_string !chan) fs
624 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
626 (* Check function names etc. for consistency. *)
627 let check_functions () =
628 let contains_uppercase str =
629 let len = String.length str in
631 if i >= len then false
634 if c >= 'A' && c <= 'Z' then true
641 (* Check function names. *)
643 fun (name, _, _, _, _, _) ->
644 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
645 failwithf "function name %s does not need 'guestfs' prefix" name;
646 if contains_uppercase name then
647 failwithf "function name %s should not contain uppercase chars" name;
648 if String.contains name '-' then
649 failwithf "function name %s should not contain '-', use '_' instead."
653 (* Check function parameter/return names. *)
655 fun (name, style, _, _, _, _) ->
656 let check_arg_ret_name n =
657 if contains_uppercase n then
658 failwithf "%s param/ret %s should not contain uppercase chars"
660 if String.contains n '-' || String.contains n '_' then
661 failwithf "%s param/ret %s should not contain '-' or '_'"
664 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
667 (match fst style with
669 | RInt n | RBool n | RConstString n | RString n
670 | RStringList n | RPVList n | RVGList n | RLVList n ->
673 check_arg_ret_name n;
676 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
679 (* Check long dscriptions. *)
681 fun (name, _, _, _, _, longdesc) ->
682 if longdesc.[String.length longdesc-1] = '\n' then
683 failwithf "long description of %s should not end with \\n." name
686 (* Check proc_nrs. *)
688 fun (name, _, proc_nr, _, _, _) ->
690 failwithf "daemon function %s should have proc_nr > 0" name
694 fun (name, _, proc_nr, _, _, _) ->
695 if proc_nr <> -1 then
696 failwithf "non-daemon function %s should have proc_nr -1" name
697 ) non_daemon_functions;
700 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
703 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
704 let rec loop = function
707 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
709 | (name1,nr1) :: (name2,nr2) :: _ ->
710 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
715 type comment_style = CStyle | HashStyle | OCamlStyle
716 type license = GPLv2 | LGPLv2
718 (* Generate a header block in a number of standard styles. *)
719 let rec generate_header comment license =
720 let c = match comment with
721 | CStyle -> pr "/* "; " *"
722 | HashStyle -> pr "# "; "#"
723 | OCamlStyle -> pr "(* "; " *" in
724 pr "libguestfs generated file\n";
725 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
726 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
728 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
732 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
733 pr "%s it under the terms of the GNU General Public License as published by\n" c;
734 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
735 pr "%s (at your option) any later version.\n" c;
737 pr "%s This program is distributed in the hope that it will be useful,\n" c;
738 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
739 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
740 pr "%s GNU General Public License for more details.\n" c;
742 pr "%s You should have received a copy of the GNU General Public License along\n" c;
743 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
744 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
747 pr "%s This library is free software; you can redistribute it and/or\n" c;
748 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
749 pr "%s License as published by the Free Software Foundation; either\n" c;
750 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
752 pr "%s This library is distributed in the hope that it will be useful,\n" c;
753 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
754 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
755 pr "%s Lesser General Public License for more details.\n" c;
757 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
758 pr "%s License along with this library; if not, write to the Free Software\n" c;
759 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
762 | CStyle -> pr " */\n"
764 | OCamlStyle -> pr " *)\n"
768 (* Generate the pod documentation for the C API. *)
769 and generate_actions_pod () =
771 fun (shortname, style, _, flags, _, longdesc) ->
772 let name = "guestfs_" ^ shortname in
773 pr "=head2 %s\n\n" name;
775 generate_prototype ~extern:false ~handle:"handle" name style;
777 pr "%s\n\n" longdesc;
778 (match fst style with
780 pr "This function returns 0 on success or -1 on error.\n\n"
782 pr "On error this function returns -1.\n\n"
784 pr "This function returns a C truth value on success or -1 on error.\n\n"
786 pr "This function returns a string or NULL on error.
787 The string is owned by the guest handle and must I<not> be freed.\n\n"
789 pr "This function returns a string or NULL on error.
790 I<The caller must free the returned string after use>.\n\n"
792 pr "This function returns a NULL-terminated array of strings
793 (like L<environ(3)>), or NULL if there was an error.
794 I<The caller must free the strings and the array after use>.\n\n"
796 pr "This function returns a C<struct guestfs_int_bool *>.
797 I<The caller must call C<guestfs_free_int_bool> after use.>.\n\n"
799 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
800 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
802 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
803 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
805 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
806 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
808 if List.mem ProtocolLimitWarning flags then
809 pr "Because of the message protocol, there is a transfer limit
810 of somewhere between 2MB and 4MB. To transfer large files you should use
812 ) all_functions_sorted
814 and generate_structs_pod () =
815 (* LVM structs documentation. *)
818 pr "=head2 guestfs_lvm_%s\n" typ;
820 pr " struct guestfs_lvm_%s {\n" typ;
823 | name, `String -> pr " char *%s;\n" name
825 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
826 pr " char %s[32];\n" name
827 | name, `Bytes -> pr " uint64_t %s;\n" name
828 | name, `Int -> pr " int64_t %s;\n" name
829 | name, `OptPercent ->
830 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
831 pr " float %s;\n" name
834 pr " struct guestfs_lvm_%s_list {\n" typ;
835 pr " uint32_t len; /* Number of elements in list. */\n";
836 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
839 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
842 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
844 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
845 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
846 * have to use an underscore instead of a dash because otherwise
847 * rpcgen generates incorrect code.
849 * This header is NOT exported to clients, but see also generate_structs_h.
851 and generate_xdr () =
852 generate_header CStyle LGPLv2;
854 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
855 pr "typedef string str<>;\n";
858 (* LVM internal structures. *)
862 pr "struct guestfs_lvm_int_%s {\n" typ;
864 | name, `String -> pr " string %s<>;\n" name
865 | name, `UUID -> pr " opaque %s[32];\n" name
866 | name, `Bytes -> pr " hyper %s;\n" name
867 | name, `Int -> pr " hyper %s;\n" name
868 | name, `OptPercent -> pr " float %s;\n" name
872 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
874 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
877 fun(shortname, style, _, _, _, _) ->
878 let name = "guestfs_" ^ shortname in
880 (match snd style with
883 pr "struct %s_args {\n" name;
886 | String n -> pr " string %s<>;\n" n
887 | OptString n -> pr " str *%s;\n" n
888 | Bool n -> pr " bool %s;\n" n
889 | Int n -> pr " int %s;\n" n
893 (match fst style with
896 pr "struct %s_ret {\n" name;
900 pr "struct %s_ret {\n" name;
904 failwithf "RConstString cannot be returned from a daemon function"
906 pr "struct %s_ret {\n" name;
907 pr " string %s<>;\n" n;
910 pr "struct %s_ret {\n" name;
914 pr "struct %s_ret {\n" name;
919 pr "struct %s_ret {\n" name;
920 pr " guestfs_lvm_int_pv_list %s;\n" n;
923 pr "struct %s_ret {\n" name;
924 pr " guestfs_lvm_int_vg_list %s;\n" n;
927 pr "struct %s_ret {\n" name;
928 pr " guestfs_lvm_int_lv_list %s;\n" n;
933 (* Table of procedure numbers. *)
934 pr "enum guestfs_procedure {\n";
936 fun (shortname, _, proc_nr, _, _, _) ->
937 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
939 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
943 (* Having to choose a maximum message size is annoying for several
944 * reasons (it limits what we can do in the API), but it (a) makes
945 * the protocol a lot simpler, and (b) provides a bound on the size
946 * of the daemon which operates in limited memory space. For large
947 * file transfers you should use FTP.
949 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
952 (* Message header, etc. *)
954 const GUESTFS_PROGRAM = 0x2000F5F5;
955 const GUESTFS_PROTOCOL_VERSION = 1;
957 enum guestfs_message_direction {
958 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
959 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
962 enum guestfs_message_status {
963 GUESTFS_STATUS_OK = 0,
964 GUESTFS_STATUS_ERROR = 1
967 const GUESTFS_ERROR_LEN = 256;
969 struct guestfs_message_error {
970 string error<GUESTFS_ERROR_LEN>; /* error message */
973 struct guestfs_message_header {
974 unsigned prog; /* GUESTFS_PROGRAM */
975 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
976 guestfs_procedure proc; /* GUESTFS_PROC_x */
977 guestfs_message_direction direction;
978 unsigned serial; /* message serial number */
979 guestfs_message_status status;
983 (* Generate the guestfs-structs.h file. *)
984 and generate_structs_h () =
985 generate_header CStyle LGPLv2;
987 (* This is a public exported header file containing various
988 * structures. The structures are carefully written to have
989 * exactly the same in-memory format as the XDR structures that
990 * we use on the wire to the daemon. The reason for creating
991 * copies of these structures here is just so we don't have to
992 * export the whole of guestfs_protocol.h (which includes much
993 * unrelated and XDR-dependent stuff that we don't want to be
994 * public, or required by clients).
996 * To reiterate, we will pass these structures to and from the
997 * client with a simple assignment or memcpy, so the format
998 * must be identical to what rpcgen / the RFC defines.
1001 (* guestfs_int_bool structure. *)
1002 pr "struct guestfs_int_bool {\n";
1008 (* LVM public structures. *)
1012 pr "struct guestfs_lvm_%s {\n" typ;
1015 | name, `String -> pr " char *%s;\n" name
1016 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1017 | name, `Bytes -> pr " uint64_t %s;\n" name
1018 | name, `Int -> pr " int64_t %s;\n" name
1019 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1023 pr "struct guestfs_lvm_%s_list {\n" typ;
1024 pr " uint32_t len;\n";
1025 pr " struct guestfs_lvm_%s *val;\n" typ;
1028 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1030 (* Generate the guestfs-actions.h file. *)
1031 and generate_actions_h () =
1032 generate_header CStyle LGPLv2;
1034 fun (shortname, style, _, _, _, _) ->
1035 let name = "guestfs_" ^ shortname in
1036 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1040 (* Generate the client-side dispatch stubs. *)
1041 and generate_client_actions () =
1042 generate_header CStyle LGPLv2;
1044 (* Client-side stubs for each function. *)
1046 fun (shortname, style, _, _, _, _) ->
1047 let name = "guestfs_" ^ shortname in
1049 (* Generate the return value struct. *)
1050 pr "struct %s_rv {\n" shortname;
1051 pr " int cb_done; /* flag to indicate callback was called */\n";
1052 pr " struct guestfs_message_header hdr;\n";
1053 pr " struct guestfs_message_error err;\n";
1054 (match fst style with
1057 failwithf "RConstString cannot be returned from a daemon function"
1059 | RBool _ | RString _ | RStringList _
1061 | RPVList _ | RVGList _ | RLVList _ ->
1062 pr " struct %s_ret ret;\n" name
1066 (* Generate the callback function. *)
1067 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1069 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1071 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1072 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1075 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1076 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1077 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1083 (match fst style with
1086 failwithf "RConstString cannot be returned from a daemon function"
1088 | RBool _ | RString _ | RStringList _
1090 | RPVList _ | RVGList _ | RLVList _ ->
1091 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1092 pr " error (g, \"%s: failed to parse reply\");\n" name;
1098 pr " rv->cb_done = 1;\n";
1099 pr " main_loop.main_loop_quit (g);\n";
1102 (* Generate the action stub. *)
1103 generate_prototype ~extern:false ~semicolon:false ~newline:true
1104 ~handle:"g" name style;
1107 match fst style with
1108 | Err | RInt _ | RBool _ -> "-1"
1110 failwithf "RConstString cannot be returned from a daemon function"
1111 | RString _ | RStringList _ | RIntBool _
1112 | RPVList _ | RVGList _ | RLVList _ ->
1117 (match snd style with
1119 | _ -> pr " struct %s_args args;\n" name
1122 pr " struct %s_rv rv;\n" shortname;
1123 pr " int serial;\n";
1125 pr " if (g->state != READY) {\n";
1126 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1129 pr " return %s;\n" error_code;
1132 pr " memset (&rv, 0, sizeof rv);\n";
1135 (match snd style with
1137 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1138 (String.uppercase shortname)
1143 pr " args.%s = (char *) %s;\n" n n
1145 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1147 pr " args.%s = %s;\n" n n
1149 pr " args.%s = %s;\n" n n
1151 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1152 (String.uppercase shortname);
1153 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1156 pr " if (serial == -1)\n";
1157 pr " return %s;\n" error_code;
1160 pr " rv.cb_done = 0;\n";
1161 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1162 pr " g->reply_cb_internal_data = &rv;\n";
1163 pr " main_loop.main_loop_run (g);\n";
1164 pr " g->reply_cb_internal = NULL;\n";
1165 pr " g->reply_cb_internal_data = NULL;\n";
1166 pr " if (!rv.cb_done) {\n";
1167 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1168 pr " return %s;\n" error_code;
1172 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1173 (String.uppercase shortname);
1174 pr " return %s;\n" error_code;
1177 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1178 pr " error (g, \"%%s\", rv.err.error);\n";
1179 pr " return %s;\n" error_code;
1183 (match fst style with
1184 | Err -> pr " return 0;\n"
1186 | RBool n -> pr " return rv.ret.%s;\n" n
1188 failwithf "RConstString cannot be returned from a daemon function"
1190 pr " return rv.ret.%s; /* caller will free */\n" n
1192 pr " /* caller will free this, but we need to add a NULL entry */\n";
1193 pr " rv.ret.%s.%s_val =" n n;
1194 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1195 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1197 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1198 pr " return rv.ret.%s.%s_val;\n" n n
1200 pr " /* caller with free this */\n";
1201 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1203 pr " /* caller will free this */\n";
1204 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1206 pr " /* caller will free this */\n";
1207 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1209 pr " /* caller will free this */\n";
1210 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1216 (* Generate daemon/actions.h. *)
1217 and generate_daemon_actions_h () =
1218 generate_header CStyle GPLv2;
1220 pr "#include \"../src/guestfs_protocol.h\"\n";
1224 fun (name, style, _, _, _, _) ->
1226 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1230 (* Generate the server-side stubs. *)
1231 and generate_daemon_actions () =
1232 generate_header CStyle GPLv2;
1234 pr "#define _GNU_SOURCE // for strchrnul\n";
1236 pr "#include <stdio.h>\n";
1237 pr "#include <stdlib.h>\n";
1238 pr "#include <string.h>\n";
1239 pr "#include <inttypes.h>\n";
1240 pr "#include <ctype.h>\n";
1241 pr "#include <rpc/types.h>\n";
1242 pr "#include <rpc/xdr.h>\n";
1244 pr "#include \"daemon.h\"\n";
1245 pr "#include \"../src/guestfs_protocol.h\"\n";
1246 pr "#include \"actions.h\"\n";
1250 fun (name, style, _, _, _, _) ->
1251 (* Generate server-side stubs. *)
1252 pr "static void %s_stub (XDR *xdr_in)\n" name;
1255 match fst style with
1256 | Err | RInt _ -> pr " int r;\n"; "-1"
1257 | RBool _ -> pr " int r;\n"; "-1"
1259 failwithf "RConstString cannot be returned from a daemon function"
1260 | RString _ -> pr " char *r;\n"; "NULL"
1261 | RStringList _ -> pr " char **r;\n"; "NULL"
1262 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1263 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1264 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1265 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1267 (match snd style with
1270 pr " struct guestfs_%s_args args;\n" name;
1274 | OptString n -> pr " const char *%s;\n" n
1275 | Bool n -> pr " int %s;\n" n
1276 | Int n -> pr " int %s;\n" n
1281 (match snd style with
1284 pr " memset (&args, 0, sizeof args);\n";
1286 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1287 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1292 | String n -> pr " %s = args.%s;\n" n n
1293 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1294 | Bool n -> pr " %s = args.%s;\n" n n
1295 | Int n -> pr " %s = args.%s;\n" n n
1300 pr " r = do_%s " name;
1301 generate_call_args style;
1304 pr " if (r == %s)\n" error_code;
1305 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1309 (match fst style with
1310 | Err -> pr " reply (NULL, NULL);\n"
1312 pr " struct guestfs_%s_ret ret;\n" name;
1313 pr " ret.%s = r;\n" n;
1314 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1316 pr " struct guestfs_%s_ret ret;\n" name;
1317 pr " ret.%s = r;\n" n;
1318 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1320 failwithf "RConstString cannot be returned from a daemon function"
1322 pr " struct guestfs_%s_ret ret;\n" name;
1323 pr " ret.%s = r;\n" n;
1324 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1327 pr " struct guestfs_%s_ret ret;\n" name;
1328 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1329 pr " ret.%s.%s_val = r;\n" n n;
1330 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1331 pr " free_strings (r);\n"
1333 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1334 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1336 pr " struct guestfs_%s_ret ret;\n" name;
1337 pr " ret.%s = *r;\n" n;
1338 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1339 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1341 pr " struct guestfs_%s_ret ret;\n" name;
1342 pr " ret.%s = *r;\n" n;
1343 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1344 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1346 pr " struct guestfs_%s_ret ret;\n" name;
1347 pr " ret.%s = *r;\n" n;
1348 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1349 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1355 (* Dispatch function. *)
1356 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1358 pr " switch (proc_nr) {\n";
1361 fun (name, style, _, _, _, _) ->
1362 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1363 pr " %s_stub (xdr_in);\n" name;
1368 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1373 (* LVM columns and tokenization functions. *)
1374 (* XXX This generates crap code. We should rethink how we
1380 pr "static const char *lvm_%s_cols = \"%s\";\n"
1381 typ (String.concat "," (List.map fst cols));
1384 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1386 pr " char *tok, *p, *next;\n";
1390 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1393 pr " if (!str) {\n";
1394 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1397 pr " if (!*str || isspace (*str)) {\n";
1398 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1403 fun (name, coltype) ->
1404 pr " if (!tok) {\n";
1405 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1408 pr " p = strchrnul (tok, ',');\n";
1409 pr " if (*p) next = p+1; else next = NULL;\n";
1410 pr " *p = '\\0';\n";
1413 pr " r->%s = strdup (tok);\n" name;
1414 pr " if (r->%s == NULL) {\n" name;
1415 pr " perror (\"strdup\");\n";
1419 pr " for (i = j = 0; i < 32; ++j) {\n";
1420 pr " if (tok[j] == '\\0') {\n";
1421 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1423 pr " } else if (tok[j] != '-')\n";
1424 pr " r->%s[i++] = tok[j];\n" name;
1427 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1428 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1432 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1433 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1437 pr " if (tok[0] == '\\0')\n";
1438 pr " r->%s = -1;\n" name;
1439 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1440 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1444 pr " tok = next;\n";
1447 pr " if (tok != NULL) {\n";
1448 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1455 pr "guestfs_lvm_int_%s_list *\n" typ;
1456 pr "parse_command_line_%ss (void)\n" typ;
1458 pr " char *out, *err;\n";
1459 pr " char *p, *pend;\n";
1461 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1462 pr " void *newp;\n";
1464 pr " ret = malloc (sizeof *ret);\n";
1465 pr " if (!ret) {\n";
1466 pr " reply_with_perror (\"malloc\");\n";
1467 pr " return NULL;\n";
1470 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1471 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1473 pr " r = command (&out, &err,\n";
1474 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1475 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1476 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1477 pr " if (r == -1) {\n";
1478 pr " reply_with_error (\"%%s\", err);\n";
1479 pr " free (out);\n";
1480 pr " free (err);\n";
1481 pr " return NULL;\n";
1484 pr " free (err);\n";
1486 pr " /* Tokenize each line of the output. */\n";
1489 pr " while (p) {\n";
1490 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1491 pr " if (pend) {\n";
1492 pr " *pend = '\\0';\n";
1496 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1499 pr " if (!*p) { /* Empty line? Skip it. */\n";
1504 pr " /* Allocate some space to store this next entry. */\n";
1505 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1506 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1507 pr " if (newp == NULL) {\n";
1508 pr " reply_with_perror (\"realloc\");\n";
1509 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1510 pr " free (ret);\n";
1511 pr " free (out);\n";
1512 pr " return NULL;\n";
1514 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1516 pr " /* Tokenize the next entry. */\n";
1517 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1518 pr " if (r == -1) {\n";
1519 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1520 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1521 pr " free (ret);\n";
1522 pr " free (out);\n";
1523 pr " return NULL;\n";
1530 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1532 pr " free (out);\n";
1533 pr " return ret;\n";
1536 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1538 (* Generate a lot of different functions for guestfish. *)
1539 and generate_fish_cmds () =
1540 generate_header CStyle GPLv2;
1544 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1546 let all_functions_sorted =
1548 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1549 ) all_functions_sorted in
1551 pr "#include <stdio.h>\n";
1552 pr "#include <stdlib.h>\n";
1553 pr "#include <string.h>\n";
1554 pr "#include <inttypes.h>\n";
1556 pr "#include <guestfs.h>\n";
1557 pr "#include \"fish.h\"\n";
1560 (* list_commands function, which implements guestfish -h *)
1561 pr "void list_commands (void)\n";
1563 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1564 pr " list_builtin_commands ();\n";
1566 fun (name, _, _, flags, shortdesc, _) ->
1567 let name = replace_char name '_' '-' in
1568 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1570 ) all_functions_sorted;
1571 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1575 (* display_command function, which implements guestfish -h cmd *)
1576 pr "void display_command (const char *cmd)\n";
1579 fun (name, style, _, flags, shortdesc, longdesc) ->
1580 let name2 = replace_char name '_' '-' in
1582 try find_map (function FishAlias n -> Some n | _ -> None) flags
1583 with Not_found -> name in
1584 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1586 match snd style with
1590 name2 (String.concat "> <" (List.map name_of_argt args)) in
1593 if List.mem ProtocolLimitWarning flags then
1594 "\n\nBecause of the message protocol, there is a transfer limit
1595 of somewhere between 2MB and 4MB. To transfer large files you should use
1599 let describe_alias =
1600 if name <> alias then
1601 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1605 pr "strcasecmp (cmd, \"%s\") == 0" name;
1606 if name <> name2 then
1607 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1608 if name <> alias then
1609 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1611 pr " pod2text (\"%s - %s\", %S);\n"
1613 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1616 pr " display_builtin_command (cmd);\n";
1620 (* print_{pv,vg,lv}_list functions *)
1624 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1631 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1633 pr " printf (\"%s: \");\n" name;
1634 pr " for (i = 0; i < 32; ++i)\n";
1635 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1636 pr " printf (\"\\n\");\n"
1638 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1640 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1641 | name, `OptPercent ->
1642 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1643 typ name name typ name;
1644 pr " else printf (\"%s: \\n\");\n" name
1648 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1653 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1654 pr " print_%s (&%ss->val[i]);\n" typ typ;
1657 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1659 (* run_<action> actions *)
1661 fun (name, style, _, flags, _, _) ->
1662 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1664 (match fst style with
1667 | RBool _ -> pr " int r;\n"
1668 | RConstString _ -> pr " const char *r;\n"
1669 | RString _ -> pr " char *r;\n"
1670 | RStringList _ -> pr " char **r;\n"
1671 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1672 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1673 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1674 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1678 | String n -> pr " const char *%s;\n" n
1679 | OptString n -> pr " const char *%s;\n" n
1680 | Bool n -> pr " int %s;\n" n
1681 | Int n -> pr " int %s;\n" n
1684 (* Check and convert parameters. *)
1685 let argc_expected = List.length (snd style) in
1686 pr " if (argc != %d) {\n" argc_expected;
1687 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1689 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1695 | String name -> pr " %s = argv[%d];\n" name i
1697 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1700 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1702 pr " %s = atoi (argv[%d]);\n" name i
1705 (* Call C API function. *)
1707 try find_map (function FishAction n -> Some n | _ -> None) flags
1708 with Not_found -> sprintf "guestfs_%s" name in
1710 generate_call_args ~handle:"g" style;
1713 (* Check return value for errors and display command results. *)
1714 (match fst style with
1715 | Err -> pr " return r;\n"
1717 pr " if (r == -1) return -1;\n";
1718 pr " if (r) printf (\"%%d\\n\", r);\n";
1721 pr " if (r == -1) return -1;\n";
1722 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1725 pr " if (r == NULL) return -1;\n";
1726 pr " printf (\"%%s\\n\", r);\n";
1729 pr " if (r == NULL) return -1;\n";
1730 pr " printf (\"%%s\\n\", r);\n";
1734 pr " if (r == NULL) return -1;\n";
1735 pr " print_strings (r);\n";
1736 pr " free_strings (r);\n";
1739 pr " if (r == NULL) return -1;\n";
1740 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1741 pr " r->b ? \"true\" : \"false\");\n";
1742 pr " guestfs_free_int_bool (r);\n";
1745 pr " if (r == NULL) return -1;\n";
1746 pr " print_pv_list (r);\n";
1747 pr " guestfs_free_lvm_pv_list (r);\n";
1750 pr " if (r == NULL) return -1;\n";
1751 pr " print_vg_list (r);\n";
1752 pr " guestfs_free_lvm_vg_list (r);\n";
1755 pr " if (r == NULL) return -1;\n";
1756 pr " print_lv_list (r);\n";
1757 pr " guestfs_free_lvm_lv_list (r);\n";
1764 (* run_action function *)
1765 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1768 fun (name, _, _, flags, _, _) ->
1769 let name2 = replace_char name '_' '-' in
1771 try find_map (function FishAlias n -> Some n | _ -> None) flags
1772 with Not_found -> name in
1774 pr "strcasecmp (cmd, \"%s\") == 0" name;
1775 if name <> name2 then
1776 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1777 if name <> alias then
1778 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1780 pr " return run_%s (cmd, argc, argv);\n" name;
1784 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1791 (* Generate the POD documentation for guestfish. *)
1792 and generate_fish_actions_pod () =
1793 let all_functions_sorted =
1795 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1796 ) all_functions_sorted in
1799 fun (name, style, _, flags, _, longdesc) ->
1800 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1801 let name = replace_char name '_' '-' in
1803 try find_map (function FishAlias n -> Some n | _ -> None) flags
1804 with Not_found -> name in
1806 pr "=head2 %s" name;
1807 if name <> alias then
1814 | String n -> pr " %s" n
1815 | OptString n -> pr " %s" n
1816 | Bool _ -> pr " true|false"
1817 | Int n -> pr " %s" n
1821 pr "%s\n\n" longdesc
1822 ) all_functions_sorted
1824 (* Generate a C function prototype. *)
1825 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1826 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1828 ?handle name style =
1829 if extern then pr "extern ";
1830 if static then pr "static ";
1831 (match fst style with
1833 | RInt _ -> pr "int "
1834 | RBool _ -> pr "int "
1835 | RConstString _ -> pr "const char *"
1836 | RString _ -> pr "char *"
1837 | RStringList _ -> pr "char **"
1839 if not in_daemon then pr "struct guestfs_int_bool *"
1840 else pr "guestfs_%s_ret *" name
1842 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1843 else pr "guestfs_lvm_int_pv_list *"
1845 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1846 else pr "guestfs_lvm_int_vg_list *"
1848 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1849 else pr "guestfs_lvm_int_lv_list *"
1851 pr "%s%s (" prefix name;
1852 if handle = None && List.length (snd style) = 0 then
1855 let comma = ref false in
1858 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1862 if single_line then pr ", " else pr ",\n\t\t"
1868 | String n -> next (); pr "const char *%s" n
1869 | OptString n -> next (); pr "const char *%s" n
1870 | Bool n -> next (); pr "int %s" n
1871 | Int n -> next (); pr "int %s" n
1875 if semicolon then pr ";";
1876 if newline then pr "\n"
1878 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1879 and generate_call_args ?handle style =
1881 let comma = ref false in
1884 | Some handle -> pr "%s" handle; comma := true
1888 if !comma then pr ", ";
1891 | String n -> pr "%s" n
1892 | OptString n -> pr "%s" n
1893 | Bool n -> pr "%s" n
1894 | Int n -> pr "%s" n
1898 (* Generate the OCaml bindings interface. *)
1899 and generate_ocaml_mli () =
1900 generate_header OCamlStyle LGPLv2;
1903 (** For API documentation you should refer to the C API
1904 in the guestfs(3) manual page. The OCaml API uses almost
1905 exactly the same calls. *)
1908 (** A [guestfs_h] handle. *)
1910 exception Error of string
1911 (** This exception is raised when there is an error. *)
1913 val create : unit -> t
1915 val close : t -> unit
1916 (** Handles are closed by the garbage collector when they become
1917 unreferenced, but callers can also call this in order to
1918 provide predictable cleanup. *)
1921 generate_ocaml_lvm_structure_decls ();
1925 fun (name, style, _, _, shortdesc, _) ->
1926 generate_ocaml_prototype name style;
1927 pr "(** %s *)\n" shortdesc;
1931 (* Generate the OCaml bindings implementation. *)
1932 and generate_ocaml_ml () =
1933 generate_header OCamlStyle LGPLv2;
1937 exception Error of string
1938 external create : unit -> t = \"ocaml_guestfs_create\"
1939 external close : t -> unit = \"ocaml_guestfs_close\"
1942 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1946 generate_ocaml_lvm_structure_decls ();
1950 fun (name, style, _, _, shortdesc, _) ->
1951 generate_ocaml_prototype ~is_external:true name style;
1954 (* Generate the OCaml bindings C implementation. *)
1955 and generate_ocaml_c () =
1956 generate_header CStyle LGPLv2;
1958 pr "#include <stdio.h>\n";
1959 pr "#include <stdlib.h>\n";
1960 pr "#include <string.h>\n";
1962 pr "#include <caml/config.h>\n";
1963 pr "#include <caml/alloc.h>\n";
1964 pr "#include <caml/callback.h>\n";
1965 pr "#include <caml/fail.h>\n";
1966 pr "#include <caml/memory.h>\n";
1967 pr "#include <caml/mlvalues.h>\n";
1968 pr "#include <caml/signals.h>\n";
1970 pr "#include <guestfs.h>\n";
1972 pr "#include \"guestfs_c.h\"\n";
1975 (* LVM struct copy functions. *)
1978 let has_optpercent_col =
1979 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1981 pr "static CAMLprim value\n";
1982 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1984 pr " CAMLparam0 ();\n";
1985 if has_optpercent_col then
1986 pr " CAMLlocal3 (rv, v, v2);\n"
1988 pr " CAMLlocal2 (rv, v);\n";
1990 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1995 pr " v = caml_copy_string (%s->%s);\n" typ name
1997 pr " v = caml_alloc_string (32);\n";
1998 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
2001 pr " v = caml_copy_int64 (%s->%s);\n" typ name
2002 | name, `OptPercent ->
2003 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
2004 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
2005 pr " v = caml_alloc (1, 0);\n";
2006 pr " Store_field (v, 0, v2);\n";
2007 pr " } else /* None */\n";
2008 pr " v = Val_int (0);\n";
2010 pr " Store_field (rv, %d, v);\n" i
2012 pr " CAMLreturn (rv);\n";
2016 pr "static CAMLprim value\n";
2017 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
2020 pr " CAMLparam0 ();\n";
2021 pr " CAMLlocal2 (rv, v);\n";
2024 pr " if (%ss->len == 0)\n" typ;
2025 pr " CAMLreturn (Atom (0));\n";
2027 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
2028 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
2029 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
2030 pr " caml_modify (&Field (rv, i), v);\n";
2032 pr " CAMLreturn (rv);\n";
2036 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2039 fun (name, style, _, _, _, _) ->
2040 pr "CAMLprim value\n";
2041 pr "ocaml_guestfs_%s (value gv" name;
2043 fun arg -> pr ", value %sv" (name_of_argt arg)
2047 pr " CAMLparam%d (gv" (1 + (List.length (snd style)));
2049 fun arg -> pr ", %sv" (name_of_argt arg)
2052 pr " CAMLlocal1 (rv);\n";
2055 pr " guestfs_h *g = Guestfs_val (gv);\n";
2056 pr " if (g == NULL)\n";
2057 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2063 pr " const char *%s = String_val (%sv);\n" n n
2065 pr " const char *%s =\n" n;
2066 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2069 pr " int %s = Bool_val (%sv);\n" n n
2071 pr " int %s = Int_val (%sv);\n" n n
2074 match fst style with
2075 | Err -> pr " int r;\n"; "-1"
2076 | RInt _ -> pr " int r;\n"; "-1"
2077 | RBool _ -> pr " int r;\n"; "-1"
2078 | RConstString _ -> pr " const char *r;\n"; "NULL"
2079 | RString _ -> pr " char *r;\n"; "NULL"
2085 pr " struct guestfs_int_bool *r;\n";
2088 pr " struct guestfs_lvm_pv_list *r;\n";
2091 pr " struct guestfs_lvm_vg_list *r;\n";
2094 pr " struct guestfs_lvm_lv_list *r;\n";
2098 pr " caml_enter_blocking_section ();\n";
2099 pr " r = guestfs_%s " name;
2100 generate_call_args ~handle:"g" style;
2102 pr " caml_leave_blocking_section ();\n";
2103 pr " if (r == %s)\n" error_code;
2104 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2107 (match fst style with
2108 | Err -> pr " rv = Val_unit;\n"
2109 | RInt _ -> pr " rv = Val_int (r);\n"
2110 | RBool _ -> pr " rv = Val_bool (r);\n"
2111 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2113 pr " rv = caml_copy_string (r);\n";
2116 pr " rv = caml_copy_string_array ((const char **) r);\n";
2117 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2120 pr " rv = caml_alloc (2, 0);\n";
2121 pr " Store_field (rv, 0, Val_int (r->i));\n";
2122 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2123 pr " guestfs_free_int_bool (r);\n";
2125 pr " rv = copy_lvm_pv_list (r);\n";
2126 pr " guestfs_free_lvm_pv_list (r);\n";
2128 pr " rv = copy_lvm_vg_list (r);\n";
2129 pr " guestfs_free_lvm_vg_list (r);\n";
2131 pr " rv = copy_lvm_lv_list (r);\n";
2132 pr " guestfs_free_lvm_lv_list (r);\n";
2135 pr " CAMLreturn (rv);\n";
2140 and generate_ocaml_lvm_structure_decls () =
2143 pr "type lvm_%s = {\n" typ;
2146 | name, `String -> pr " %s : string;\n" name
2147 | name, `UUID -> pr " %s : string;\n" name
2148 | name, `Bytes -> pr " %s : int64;\n" name
2149 | name, `Int -> pr " %s : int64;\n" name
2150 | name, `OptPercent -> pr " %s : float option;\n" name
2154 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2156 and generate_ocaml_prototype ?(is_external = false) name style =
2157 if is_external then pr "external " else pr "val ";
2158 pr "%s : t -> " name;
2161 | String _ -> pr "string -> "
2162 | OptString _ -> pr "string option -> "
2163 | Bool _ -> pr "bool -> "
2164 | Int _ -> pr "int -> "
2166 (match fst style with
2167 | Err -> pr "unit" (* all errors are turned into exceptions *)
2168 | RInt _ -> pr "int"
2169 | RBool _ -> pr "bool"
2170 | RConstString _ -> pr "string"
2171 | RString _ -> pr "string"
2172 | RStringList _ -> pr "string array"
2173 | RIntBool _ -> pr "int * bool"
2174 | RPVList _ -> pr "lvm_pv array"
2175 | RVGList _ -> pr "lvm_vg array"
2176 | RLVList _ -> pr "lvm_lv array"
2178 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2181 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2182 and generate_perl_xs () =
2183 generate_header CStyle LGPLv2;
2186 #include \"EXTERN.h\"
2190 #include <guestfs.h>
2193 #define PRId64 \"lld\"
2197 my_newSVll(long long val) {
2198 #ifdef USE_64_BIT_ALL
2199 return newSViv(val);
2203 len = snprintf(buf, 100, \"%%\" PRId64, val);
2204 return newSVpv(buf, len);
2209 #define PRIu64 \"llu\"
2213 my_newSVull(unsigned long long val) {
2214 #ifdef USE_64_BIT_ALL
2215 return newSVuv(val);
2219 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2220 return newSVpv(buf, len);
2224 /* XXX Not thread-safe, and in general not safe if the caller is
2225 * issuing multiple requests in parallel (on different guestfs
2226 * handles). We should use the guestfs_h handle passed to the
2227 * error handle to distinguish these cases.
2229 static char *last_error = NULL;
2232 error_handler (guestfs_h *g,
2236 if (last_error != NULL) free (last_error);
2237 last_error = strdup (msg);
2240 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2245 RETVAL = guestfs_create ();
2247 croak (\"could not create guestfs handle\");
2248 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2261 fun (name, style, _, _, _, _) ->
2262 (match fst style with
2263 | Err -> pr "void\n"
2264 | RInt _ -> pr "SV *\n"
2265 | RBool _ -> pr "SV *\n"
2266 | RConstString _ -> pr "SV *\n"
2267 | RString _ -> pr "SV *\n"
2270 | RPVList _ | RVGList _ | RLVList _ ->
2271 pr "void\n" (* all lists returned implictly on the stack *)
2273 (* Call and arguments. *)
2275 generate_call_args ~handle:"g" style;
2277 pr " guestfs_h *g;\n";
2280 | String n -> pr " char *%s;\n" n
2281 | OptString n -> pr " char *%s;\n" n
2282 | Bool n -> pr " int %s;\n" n
2283 | Int n -> pr " int %s;\n" n
2286 (match fst style with
2289 pr " if (guestfs_%s " name;
2290 generate_call_args ~handle:"g" style;
2292 pr " croak (\"%s: %%s\", last_error);\n" name
2298 pr " %s = guestfs_%s " n name;
2299 generate_call_args ~handle:"g" style;
2301 pr " if (%s == -1)\n" n;
2302 pr " croak (\"%s: %%s\", last_error);\n" name;
2303 pr " RETVAL = newSViv (%s);\n" n;
2308 pr " const char *%s;\n" n;
2310 pr " %s = guestfs_%s " n name;
2311 generate_call_args ~handle:"g" style;
2313 pr " if (%s == NULL)\n" n;
2314 pr " croak (\"%s: %%s\", last_error);\n" name;
2315 pr " RETVAL = newSVpv (%s, 0);\n" n;
2320 pr " char *%s;\n" n;
2322 pr " %s = guestfs_%s " n name;
2323 generate_call_args ~handle:"g" style;
2325 pr " if (%s == NULL)\n" n;
2326 pr " croak (\"%s: %%s\", last_error);\n" name;
2327 pr " RETVAL = newSVpv (%s, 0);\n" n;
2328 pr " free (%s);\n" n;
2333 pr " char **%s;\n" n;
2336 pr " %s = guestfs_%s " n name;
2337 generate_call_args ~handle:"g" style;
2339 pr " if (%s == NULL)\n" n;
2340 pr " croak (\"%s: %%s\", last_error);\n" name;
2341 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2342 pr " EXTEND (SP, n);\n";
2343 pr " for (i = 0; i < n; ++i) {\n";
2344 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2345 pr " free (%s[i]);\n" n;
2347 pr " free (%s);\n" n;
2350 pr " struct guestfs_int_bool *r;\n";
2352 pr " r = guestfs_%s " name;
2353 generate_call_args ~handle:"g" style;
2355 pr " if (r == NULL)\n";
2356 pr " croak (\"%s: %%s\", last_error);\n" name;
2357 pr " EXTEND (SP, 2);\n";
2358 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2359 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2360 pr " guestfs_free_int_bool (r);\n";
2362 generate_perl_lvm_code "pv" pv_cols name style n;
2364 generate_perl_lvm_code "vg" vg_cols name style n;
2366 generate_perl_lvm_code "lv" lv_cols name style n;
2371 and generate_perl_lvm_code typ cols name style n =
2373 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2377 pr " %s = guestfs_%s " n name;
2378 generate_call_args ~handle:"g" style;
2380 pr " if (%s == NULL)\n" n;
2381 pr " croak (\"%s: %%s\", last_error);\n" name;
2382 pr " EXTEND (SP, %s->len);\n" n;
2383 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2384 pr " hv = newHV ();\n";
2388 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2389 name (String.length name) n name
2391 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2392 name (String.length name) n name
2394 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2395 name (String.length name) n name
2397 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2398 name (String.length name) n name
2399 | name, `OptPercent ->
2400 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2401 name (String.length name) n name
2403 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2405 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2407 (* Generate Sys/Guestfs.pm. *)
2408 and generate_perl_pm () =
2409 generate_header HashStyle LGPLv2;
2416 Sys::Guestfs - Perl bindings for libguestfs
2422 my $h = Sys::Guestfs->new ();
2423 $h->add_drive ('guest.img');
2426 $h->mount ('/dev/sda1', '/');
2427 $h->touch ('/hello');
2432 The C<Sys::Guestfs> module provides a Perl XS binding to the
2433 libguestfs API for examining and modifying virtual machine
2436 Amongst the things this is good for: making batch configuration
2437 changes to guests, getting disk used/free statistics (see also:
2438 virt-df), migrating between virtualization systems (see also:
2439 virt-p2v), performing partial backups, performing partial guest
2440 clones, cloning guests and changing registry/UUID/hostname info, and
2443 Libguestfs uses Linux kernel and qemu code, and can access any type of
2444 guest filesystem that Linux and qemu can, including but not limited
2445 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2446 schemes, qcow, qcow2, vmdk.
2448 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2449 LVs, what filesystem is in each LV, etc.). It can also run commands
2450 in the context of the guest. Also you can access filesystems over FTP.
2454 All errors turn into calls to C<croak> (see L<Carp(3)>).
2462 package Sys::Guestfs;
2468 XSLoader::load ('Sys::Guestfs');
2470 =item $h = Sys::Guestfs->new ();
2472 Create a new guestfs handle.
2478 my $class = ref ($proto) || $proto;
2480 my $self = Sys::Guestfs::_create ();
2481 bless $self, $class;
2487 (* Actions. We only need to print documentation for these as
2488 * they are pulled in from the XS code automatically.
2491 fun (name, style, _, flags, _, longdesc) ->
2492 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2494 generate_perl_prototype name style;
2496 pr "%s\n\n" longdesc;
2497 if List.mem ProtocolLimitWarning flags then
2498 pr "Because of the message protocol, there is a transfer limit
2499 of somewhere between 2MB and 4MB. To transfer large files you should use
2501 ) all_functions_sorted;
2513 Copyright (C) 2009 Red Hat Inc.
2517 Please see the file COPYING.LIB for the full license.
2521 L<guestfs(3)>, L<guestfish(1)>.
2526 and generate_perl_prototype name style =
2527 (match fst style with
2532 | RString n -> pr "$%s = " n
2533 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2537 | RLVList n -> pr "@%s = " n
2540 let comma = ref false in
2543 if !comma then pr ", ";
2545 pr "%s" (name_of_argt arg)
2549 let output_to filename =
2550 let filename_new = filename ^ ".new" in
2551 chan := open_out filename_new;
2555 Unix.rename filename_new filename;
2556 printf "written %s\n%!" filename;
2564 let close = output_to "src/guestfs_protocol.x" in
2568 let close = output_to "src/guestfs-structs.h" in
2569 generate_structs_h ();
2572 let close = output_to "src/guestfs-actions.h" in
2573 generate_actions_h ();
2576 let close = output_to "src/guestfs-actions.c" in
2577 generate_client_actions ();
2580 let close = output_to "daemon/actions.h" in
2581 generate_daemon_actions_h ();
2584 let close = output_to "daemon/stubs.c" in
2585 generate_daemon_actions ();
2588 let close = output_to "fish/cmds.c" in
2589 generate_fish_cmds ();
2592 let close = output_to "guestfs-structs.pod" in
2593 generate_structs_pod ();
2596 let close = output_to "guestfs-actions.pod" in
2597 generate_actions_pod ();
2600 let close = output_to "guestfish-actions.pod" in
2601 generate_fish_actions_pod ();
2604 let close = output_to "ocaml/guestfs.mli" in
2605 generate_ocaml_mli ();
2608 let close = output_to "ocaml/guestfs.ml" in
2609 generate_ocaml_ml ();
2612 let close = output_to "ocaml/guestfs_c_actions.c" in
2613 generate_ocaml_c ();
2616 let close = output_to "perl/Guestfs.xs" in
2617 generate_perl_xs ();
2620 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2621 generate_perl_pm ();