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 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
622 (* Check function names etc. for consistency. *)
623 let check_functions () =
624 let contains_uppercase str =
625 let len = String.length str in
627 if i >= len then false
630 if c >= 'A' && c <= 'Z' then true
637 (* Check function names. *)
639 fun (name, _, _, _, _, _) ->
640 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
641 failwithf "function name %s does not need 'guestfs' prefix" name;
642 if contains_uppercase name then
643 failwithf "function name %s should not contain uppercase chars" name;
644 if String.contains name '-' then
645 failwithf "function name %s should not contain '-', use '_' instead."
649 (* Check function parameter/return names. *)
651 fun (name, style, _, _, _, _) ->
652 let check_arg_ret_name n =
653 if contains_uppercase n then
654 failwithf "%s param/ret %s should not contain uppercase chars"
656 if String.contains n '-' || String.contains n '_' then
657 failwithf "%s param/ret %s should not contain '-' or '_'"
660 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
663 (match fst style with
665 | RInt n | RBool n | RConstString n | RString n
666 | RStringList n | RPVList n | RVGList n | RLVList n ->
669 check_arg_ret_name n;
672 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
675 (* Check long dscriptions. *)
677 fun (name, _, _, _, _, longdesc) ->
678 if longdesc.[String.length longdesc-1] = '\n' then
679 failwithf "long description of %s should not end with \\n." name
682 (* Check proc_nrs. *)
684 fun (name, _, proc_nr, _, _, _) ->
686 failwithf "daemon function %s should have proc_nr > 0" name
690 fun (name, _, proc_nr, _, _, _) ->
691 if proc_nr <> -1 then
692 failwithf "non-daemon function %s should have proc_nr -1" name
693 ) non_daemon_functions;
696 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
699 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
700 let rec loop = function
703 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
705 | (name1,nr1) :: (name2,nr2) :: _ ->
706 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
711 (* 'pr' prints to the current output file. *)
712 let chan = ref stdout
713 let pr fs = ksprintf (output_string !chan) fs
715 (* Generate a header block in a number of standard styles. *)
716 type comment_style = CStyle | HashStyle | OCamlStyle
717 type license = GPLv2 | LGPLv2
719 let 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 (* Start of main code generation functions below this line. *)
770 (* Generate the pod documentation for the C API. *)
771 let rec generate_actions_pod () =
773 fun (shortname, style, _, flags, _, longdesc) ->
774 let name = "guestfs_" ^ shortname in
775 pr "=head2 %s\n\n" name;
777 generate_prototype ~extern:false ~handle:"handle" name style;
779 pr "%s\n\n" longdesc;
780 (match fst style with
782 pr "This function returns 0 on success or -1 on error.\n\n"
784 pr "On error this function returns -1.\n\n"
786 pr "This function returns a C truth value on success or -1 on error.\n\n"
788 pr "This function returns a string or NULL on error.
789 The string is owned by the guest handle and must I<not> be freed.\n\n"
791 pr "This function returns a string or NULL on error.
792 I<The caller must free the returned string after use>.\n\n"
794 pr "This function returns a NULL-terminated array of strings
795 (like L<environ(3)>), or NULL if there was an error.
796 I<The caller must free the strings and the array after use>.\n\n"
798 pr "This function returns a C<struct guestfs_int_bool *>.
799 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
801 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
802 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
804 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
805 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
807 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
808 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
810 if List.mem ProtocolLimitWarning flags then
811 pr "Because of the message protocol, there is a transfer limit
812 of somewhere between 2MB and 4MB. To transfer large files you should use
814 ) all_functions_sorted
816 and generate_structs_pod () =
817 (* LVM structs documentation. *)
820 pr "=head2 guestfs_lvm_%s\n" typ;
822 pr " struct guestfs_lvm_%s {\n" typ;
825 | name, `String -> pr " char *%s;\n" name
827 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
828 pr " char %s[32];\n" name
829 | name, `Bytes -> pr " uint64_t %s;\n" name
830 | name, `Int -> pr " int64_t %s;\n" name
831 | name, `OptPercent ->
832 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
833 pr " float %s;\n" name
836 pr " struct guestfs_lvm_%s_list {\n" typ;
837 pr " uint32_t len; /* Number of elements in list. */\n";
838 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
841 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
844 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
846 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
847 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
849 * We have to use an underscore instead of a dash because otherwise
850 * rpcgen generates incorrect code.
852 * This header is NOT exported to clients, but see also generate_structs_h.
854 and generate_xdr () =
855 generate_header CStyle LGPLv2;
857 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
858 pr "typedef string str<>;\n";
861 (* LVM internal structures. *)
865 pr "struct guestfs_lvm_int_%s {\n" typ;
867 | name, `String -> pr " string %s<>;\n" name
868 | name, `UUID -> pr " opaque %s[32];\n" name
869 | name, `Bytes -> pr " hyper %s;\n" name
870 | name, `Int -> pr " hyper %s;\n" name
871 | name, `OptPercent -> pr " float %s;\n" name
875 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
877 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
880 fun(shortname, style, _, _, _, _) ->
881 let name = "guestfs_" ^ shortname in
883 (match snd style with
886 pr "struct %s_args {\n" name;
889 | String n -> pr " string %s<>;\n" n
890 | OptString n -> pr " str *%s;\n" n
891 | Bool n -> pr " bool %s;\n" n
892 | Int n -> pr " int %s;\n" n
896 (match fst style with
899 pr "struct %s_ret {\n" name;
903 pr "struct %s_ret {\n" name;
907 failwithf "RConstString cannot be returned from a daemon function"
909 pr "struct %s_ret {\n" name;
910 pr " string %s<>;\n" n;
913 pr "struct %s_ret {\n" name;
917 pr "struct %s_ret {\n" name;
922 pr "struct %s_ret {\n" name;
923 pr " guestfs_lvm_int_pv_list %s;\n" n;
926 pr "struct %s_ret {\n" name;
927 pr " guestfs_lvm_int_vg_list %s;\n" n;
930 pr "struct %s_ret {\n" name;
931 pr " guestfs_lvm_int_lv_list %s;\n" n;
936 (* Table of procedure numbers. *)
937 pr "enum guestfs_procedure {\n";
939 fun (shortname, _, proc_nr, _, _, _) ->
940 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
942 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
946 (* Having to choose a maximum message size is annoying for several
947 * reasons (it limits what we can do in the API), but it (a) makes
948 * the protocol a lot simpler, and (b) provides a bound on the size
949 * of the daemon which operates in limited memory space. For large
950 * file transfers you should use FTP.
952 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
955 (* Message header, etc. *)
957 const GUESTFS_PROGRAM = 0x2000F5F5;
958 const GUESTFS_PROTOCOL_VERSION = 1;
960 enum guestfs_message_direction {
961 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
962 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
965 enum guestfs_message_status {
966 GUESTFS_STATUS_OK = 0,
967 GUESTFS_STATUS_ERROR = 1
970 const GUESTFS_ERROR_LEN = 256;
972 struct guestfs_message_error {
973 string error<GUESTFS_ERROR_LEN>; /* error message */
976 struct guestfs_message_header {
977 unsigned prog; /* GUESTFS_PROGRAM */
978 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
979 guestfs_procedure proc; /* GUESTFS_PROC_x */
980 guestfs_message_direction direction;
981 unsigned serial; /* message serial number */
982 guestfs_message_status status;
986 (* Generate the guestfs-structs.h file. *)
987 and generate_structs_h () =
988 generate_header CStyle LGPLv2;
990 (* This is a public exported header file containing various
991 * structures. The structures are carefully written to have
992 * exactly the same in-memory format as the XDR structures that
993 * we use on the wire to the daemon. The reason for creating
994 * copies of these structures here is just so we don't have to
995 * export the whole of guestfs_protocol.h (which includes much
996 * unrelated and XDR-dependent stuff that we don't want to be
997 * public, or required by clients).
999 * To reiterate, we will pass these structures to and from the
1000 * client with a simple assignment or memcpy, so the format
1001 * must be identical to what rpcgen / the RFC defines.
1004 (* guestfs_int_bool structure. *)
1005 pr "struct guestfs_int_bool {\n";
1011 (* LVM public structures. *)
1015 pr "struct guestfs_lvm_%s {\n" typ;
1018 | name, `String -> pr " char *%s;\n" name
1019 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1020 | name, `Bytes -> pr " uint64_t %s;\n" name
1021 | name, `Int -> pr " int64_t %s;\n" name
1022 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1026 pr "struct guestfs_lvm_%s_list {\n" typ;
1027 pr " uint32_t len;\n";
1028 pr " struct guestfs_lvm_%s *val;\n" typ;
1031 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1033 (* Generate the guestfs-actions.h file. *)
1034 and generate_actions_h () =
1035 generate_header CStyle LGPLv2;
1037 fun (shortname, style, _, _, _, _) ->
1038 let name = "guestfs_" ^ shortname in
1039 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1043 (* Generate the client-side dispatch stubs. *)
1044 and generate_client_actions () =
1045 generate_header CStyle LGPLv2;
1047 (* Client-side stubs for each function. *)
1049 fun (shortname, style, _, _, _, _) ->
1050 let name = "guestfs_" ^ shortname in
1052 (* Generate the return value struct. *)
1053 pr "struct %s_rv {\n" shortname;
1054 pr " int cb_done; /* flag to indicate callback was called */\n";
1055 pr " struct guestfs_message_header hdr;\n";
1056 pr " struct guestfs_message_error err;\n";
1057 (match fst style with
1060 failwithf "RConstString cannot be returned from a daemon function"
1062 | RBool _ | RString _ | RStringList _
1064 | RPVList _ | RVGList _ | RLVList _ ->
1065 pr " struct %s_ret ret;\n" name
1069 (* Generate the callback function. *)
1070 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1072 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1074 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1075 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1078 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1079 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1080 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1086 (match fst style with
1089 failwithf "RConstString cannot be returned from a daemon function"
1091 | RBool _ | RString _ | RStringList _
1093 | RPVList _ | RVGList _ | RLVList _ ->
1094 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1095 pr " error (g, \"%s: failed to parse reply\");\n" name;
1101 pr " rv->cb_done = 1;\n";
1102 pr " main_loop.main_loop_quit (g);\n";
1105 (* Generate the action stub. *)
1106 generate_prototype ~extern:false ~semicolon:false ~newline:true
1107 ~handle:"g" name style;
1110 match fst style with
1111 | Err | RInt _ | RBool _ -> "-1"
1113 failwithf "RConstString cannot be returned from a daemon function"
1114 | RString _ | RStringList _ | RIntBool _
1115 | RPVList _ | RVGList _ | RLVList _ ->
1120 (match snd style with
1122 | _ -> pr " struct %s_args args;\n" name
1125 pr " struct %s_rv rv;\n" shortname;
1126 pr " int serial;\n";
1128 pr " if (g->state != READY) {\n";
1129 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1132 pr " return %s;\n" error_code;
1135 pr " memset (&rv, 0, sizeof rv);\n";
1138 (match snd style with
1140 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1141 (String.uppercase shortname)
1146 pr " args.%s = (char *) %s;\n" n n
1148 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1150 pr " args.%s = %s;\n" n n
1152 pr " args.%s = %s;\n" n n
1154 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1155 (String.uppercase shortname);
1156 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1159 pr " if (serial == -1)\n";
1160 pr " return %s;\n" error_code;
1163 pr " rv.cb_done = 0;\n";
1164 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1165 pr " g->reply_cb_internal_data = &rv;\n";
1166 pr " main_loop.main_loop_run (g);\n";
1167 pr " g->reply_cb_internal = NULL;\n";
1168 pr " g->reply_cb_internal_data = NULL;\n";
1169 pr " if (!rv.cb_done) {\n";
1170 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1171 pr " return %s;\n" error_code;
1175 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1176 (String.uppercase shortname);
1177 pr " return %s;\n" error_code;
1180 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1181 pr " error (g, \"%%s\", rv.err.error);\n";
1182 pr " return %s;\n" error_code;
1186 (match fst style with
1187 | Err -> pr " return 0;\n"
1189 | RBool n -> pr " return rv.ret.%s;\n" n
1191 failwithf "RConstString cannot be returned from a daemon function"
1193 pr " return rv.ret.%s; /* caller will free */\n" n
1195 pr " /* caller will free this, but we need to add a NULL entry */\n";
1196 pr " rv.ret.%s.%s_val =" n n;
1197 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1198 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1200 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1201 pr " return rv.ret.%s.%s_val;\n" n n
1203 pr " /* caller with free this */\n";
1204 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\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
1212 pr " /* caller will free this */\n";
1213 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1219 (* Generate daemon/actions.h. *)
1220 and generate_daemon_actions_h () =
1221 generate_header CStyle GPLv2;
1223 pr "#include \"../src/guestfs_protocol.h\"\n";
1227 fun (name, style, _, _, _, _) ->
1229 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1233 (* Generate the server-side stubs. *)
1234 and generate_daemon_actions () =
1235 generate_header CStyle GPLv2;
1237 pr "#define _GNU_SOURCE // for strchrnul\n";
1239 pr "#include <stdio.h>\n";
1240 pr "#include <stdlib.h>\n";
1241 pr "#include <string.h>\n";
1242 pr "#include <inttypes.h>\n";
1243 pr "#include <ctype.h>\n";
1244 pr "#include <rpc/types.h>\n";
1245 pr "#include <rpc/xdr.h>\n";
1247 pr "#include \"daemon.h\"\n";
1248 pr "#include \"../src/guestfs_protocol.h\"\n";
1249 pr "#include \"actions.h\"\n";
1253 fun (name, style, _, _, _, _) ->
1254 (* Generate server-side stubs. *)
1255 pr "static void %s_stub (XDR *xdr_in)\n" name;
1258 match fst style with
1259 | Err | RInt _ -> pr " int r;\n"; "-1"
1260 | RBool _ -> pr " int r;\n"; "-1"
1262 failwithf "RConstString cannot be returned from a daemon function"
1263 | RString _ -> pr " char *r;\n"; "NULL"
1264 | RStringList _ -> pr " char **r;\n"; "NULL"
1265 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1266 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1267 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1268 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1270 (match snd style with
1273 pr " struct guestfs_%s_args args;\n" name;
1277 | OptString n -> pr " const char *%s;\n" n
1278 | Bool n -> pr " int %s;\n" n
1279 | Int n -> pr " int %s;\n" n
1284 (match snd style with
1287 pr " memset (&args, 0, sizeof args);\n";
1289 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1290 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1295 | String n -> pr " %s = args.%s;\n" n n
1296 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1297 | Bool n -> pr " %s = args.%s;\n" n n
1298 | Int n -> pr " %s = args.%s;\n" n n
1303 pr " r = do_%s " name;
1304 generate_call_args style;
1307 pr " if (r == %s)\n" error_code;
1308 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1312 (match fst style with
1313 | Err -> pr " reply (NULL, NULL);\n"
1315 pr " struct guestfs_%s_ret ret;\n" name;
1316 pr " ret.%s = r;\n" n;
1317 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1319 pr " struct guestfs_%s_ret ret;\n" name;
1320 pr " ret.%s = r;\n" n;
1321 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1323 failwithf "RConstString cannot be returned from a daemon function"
1325 pr " struct guestfs_%s_ret ret;\n" name;
1326 pr " ret.%s = r;\n" n;
1327 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1330 pr " struct guestfs_%s_ret ret;\n" name;
1331 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1332 pr " ret.%s.%s_val = r;\n" n n;
1333 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1334 pr " free_strings (r);\n"
1336 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1337 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1339 pr " struct guestfs_%s_ret ret;\n" name;
1340 pr " ret.%s = *r;\n" n;
1341 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1342 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1344 pr " struct guestfs_%s_ret ret;\n" name;
1345 pr " ret.%s = *r;\n" n;
1346 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1347 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1349 pr " struct guestfs_%s_ret ret;\n" name;
1350 pr " ret.%s = *r;\n" n;
1351 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1352 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1358 (* Dispatch function. *)
1359 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1361 pr " switch (proc_nr) {\n";
1364 fun (name, style, _, _, _, _) ->
1365 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1366 pr " %s_stub (xdr_in);\n" name;
1371 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1376 (* LVM columns and tokenization functions. *)
1377 (* XXX This generates crap code. We should rethink how we
1383 pr "static const char *lvm_%s_cols = \"%s\";\n"
1384 typ (String.concat "," (List.map fst cols));
1387 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1389 pr " char *tok, *p, *next;\n";
1393 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1396 pr " if (!str) {\n";
1397 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1400 pr " if (!*str || isspace (*str)) {\n";
1401 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1406 fun (name, coltype) ->
1407 pr " if (!tok) {\n";
1408 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1411 pr " p = strchrnul (tok, ',');\n";
1412 pr " if (*p) next = p+1; else next = NULL;\n";
1413 pr " *p = '\\0';\n";
1416 pr " r->%s = strdup (tok);\n" name;
1417 pr " if (r->%s == NULL) {\n" name;
1418 pr " perror (\"strdup\");\n";
1422 pr " for (i = j = 0; i < 32; ++j) {\n";
1423 pr " if (tok[j] == '\\0') {\n";
1424 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1426 pr " } else if (tok[j] != '-')\n";
1427 pr " r->%s[i++] = tok[j];\n" name;
1430 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1431 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1435 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1436 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1440 pr " if (tok[0] == '\\0')\n";
1441 pr " r->%s = -1;\n" name;
1442 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1443 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1447 pr " tok = next;\n";
1450 pr " if (tok != NULL) {\n";
1451 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1458 pr "guestfs_lvm_int_%s_list *\n" typ;
1459 pr "parse_command_line_%ss (void)\n" typ;
1461 pr " char *out, *err;\n";
1462 pr " char *p, *pend;\n";
1464 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1465 pr " void *newp;\n";
1467 pr " ret = malloc (sizeof *ret);\n";
1468 pr " if (!ret) {\n";
1469 pr " reply_with_perror (\"malloc\");\n";
1470 pr " return NULL;\n";
1473 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1474 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1476 pr " r = command (&out, &err,\n";
1477 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1478 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1479 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1480 pr " if (r == -1) {\n";
1481 pr " reply_with_error (\"%%s\", err);\n";
1482 pr " free (out);\n";
1483 pr " free (err);\n";
1484 pr " return NULL;\n";
1487 pr " free (err);\n";
1489 pr " /* Tokenize each line of the output. */\n";
1492 pr " while (p) {\n";
1493 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1494 pr " if (pend) {\n";
1495 pr " *pend = '\\0';\n";
1499 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1502 pr " if (!*p) { /* Empty line? Skip it. */\n";
1507 pr " /* Allocate some space to store this next entry. */\n";
1508 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1509 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1510 pr " if (newp == NULL) {\n";
1511 pr " reply_with_perror (\"realloc\");\n";
1512 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1513 pr " free (ret);\n";
1514 pr " free (out);\n";
1515 pr " return NULL;\n";
1517 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1519 pr " /* Tokenize the next entry. */\n";
1520 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1521 pr " if (r == -1) {\n";
1522 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1523 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1524 pr " free (ret);\n";
1525 pr " free (out);\n";
1526 pr " return NULL;\n";
1533 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1535 pr " free (out);\n";
1536 pr " return ret;\n";
1539 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1541 (* Generate a lot of different functions for guestfish. *)
1542 and generate_fish_cmds () =
1543 generate_header CStyle GPLv2;
1547 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1549 let all_functions_sorted =
1551 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1552 ) all_functions_sorted in
1554 pr "#include <stdio.h>\n";
1555 pr "#include <stdlib.h>\n";
1556 pr "#include <string.h>\n";
1557 pr "#include <inttypes.h>\n";
1559 pr "#include <guestfs.h>\n";
1560 pr "#include \"fish.h\"\n";
1563 (* list_commands function, which implements guestfish -h *)
1564 pr "void list_commands (void)\n";
1566 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1567 pr " list_builtin_commands ();\n";
1569 fun (name, _, _, flags, shortdesc, _) ->
1570 let name = replace_char name '_' '-' in
1571 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1573 ) all_functions_sorted;
1574 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1578 (* display_command function, which implements guestfish -h cmd *)
1579 pr "void display_command (const char *cmd)\n";
1582 fun (name, style, _, flags, shortdesc, longdesc) ->
1583 let name2 = replace_char name '_' '-' in
1585 try find_map (function FishAlias n -> Some n | _ -> None) flags
1586 with Not_found -> name in
1587 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1589 match snd style with
1593 name2 (String.concat "> <" (List.map name_of_argt args)) in
1596 if List.mem ProtocolLimitWarning flags then
1597 "\n\nBecause of the message protocol, there is a transfer limit
1598 of somewhere between 2MB and 4MB. To transfer large files you should use
1602 let describe_alias =
1603 if name <> alias then
1604 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1608 pr "strcasecmp (cmd, \"%s\") == 0" name;
1609 if name <> name2 then
1610 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1611 if name <> alias then
1612 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1614 pr " pod2text (\"%s - %s\", %S);\n"
1616 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1619 pr " display_builtin_command (cmd);\n";
1623 (* print_{pv,vg,lv}_list functions *)
1627 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1634 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1636 pr " printf (\"%s: \");\n" name;
1637 pr " for (i = 0; i < 32; ++i)\n";
1638 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1639 pr " printf (\"\\n\");\n"
1641 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1643 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1644 | name, `OptPercent ->
1645 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1646 typ name name typ name;
1647 pr " else printf (\"%s: \\n\");\n" name
1651 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1656 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1657 pr " print_%s (&%ss->val[i]);\n" typ typ;
1660 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1662 (* run_<action> actions *)
1664 fun (name, style, _, flags, _, _) ->
1665 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1667 (match fst style with
1670 | RBool _ -> pr " int r;\n"
1671 | RConstString _ -> pr " const char *r;\n"
1672 | RString _ -> pr " char *r;\n"
1673 | RStringList _ -> pr " char **r;\n"
1674 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1675 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1676 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1677 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1681 | String n -> pr " const char *%s;\n" n
1682 | OptString n -> pr " const char *%s;\n" n
1683 | Bool n -> pr " int %s;\n" n
1684 | Int n -> pr " int %s;\n" n
1687 (* Check and convert parameters. *)
1688 let argc_expected = List.length (snd style) in
1689 pr " if (argc != %d) {\n" argc_expected;
1690 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1692 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1698 | String name -> pr " %s = argv[%d];\n" name i
1700 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1703 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1705 pr " %s = atoi (argv[%d]);\n" name i
1708 (* Call C API function. *)
1710 try find_map (function FishAction n -> Some n | _ -> None) flags
1711 with Not_found -> sprintf "guestfs_%s" name in
1713 generate_call_args ~handle:"g" style;
1716 (* Check return value for errors and display command results. *)
1717 (match fst style with
1718 | Err -> pr " return r;\n"
1720 pr " if (r == -1) return -1;\n";
1721 pr " if (r) printf (\"%%d\\n\", r);\n";
1724 pr " if (r == -1) return -1;\n";
1725 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1728 pr " if (r == NULL) return -1;\n";
1729 pr " printf (\"%%s\\n\", r);\n";
1732 pr " if (r == NULL) return -1;\n";
1733 pr " printf (\"%%s\\n\", r);\n";
1737 pr " if (r == NULL) return -1;\n";
1738 pr " print_strings (r);\n";
1739 pr " free_strings (r);\n";
1742 pr " if (r == NULL) return -1;\n";
1743 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1744 pr " r->b ? \"true\" : \"false\");\n";
1745 pr " guestfs_free_int_bool (r);\n";
1748 pr " if (r == NULL) return -1;\n";
1749 pr " print_pv_list (r);\n";
1750 pr " guestfs_free_lvm_pv_list (r);\n";
1753 pr " if (r == NULL) return -1;\n";
1754 pr " print_vg_list (r);\n";
1755 pr " guestfs_free_lvm_vg_list (r);\n";
1758 pr " if (r == NULL) return -1;\n";
1759 pr " print_lv_list (r);\n";
1760 pr " guestfs_free_lvm_lv_list (r);\n";
1767 (* run_action function *)
1768 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1771 fun (name, _, _, flags, _, _) ->
1772 let name2 = replace_char name '_' '-' in
1774 try find_map (function FishAlias n -> Some n | _ -> None) flags
1775 with Not_found -> name in
1777 pr "strcasecmp (cmd, \"%s\") == 0" name;
1778 if name <> name2 then
1779 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1780 if name <> alias then
1781 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1783 pr " return run_%s (cmd, argc, argv);\n" name;
1787 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1794 (* Generate the POD documentation for guestfish. *)
1795 and generate_fish_actions_pod () =
1796 let all_functions_sorted =
1798 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1799 ) all_functions_sorted in
1802 fun (name, style, _, flags, _, longdesc) ->
1803 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1804 let name = replace_char name '_' '-' in
1806 try find_map (function FishAlias n -> Some n | _ -> None) flags
1807 with Not_found -> name in
1809 pr "=head2 %s" name;
1810 if name <> alias then
1817 | String n -> pr " %s" n
1818 | OptString n -> pr " %s" n
1819 | Bool _ -> pr " true|false"
1820 | Int n -> pr " %s" n
1824 pr "%s\n\n" longdesc
1825 ) all_functions_sorted
1827 (* Generate a C function prototype. *)
1828 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1829 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1831 ?handle name style =
1832 if extern then pr "extern ";
1833 if static then pr "static ";
1834 (match fst style with
1836 | RInt _ -> pr "int "
1837 | RBool _ -> pr "int "
1838 | RConstString _ -> pr "const char *"
1839 | RString _ -> pr "char *"
1840 | RStringList _ -> pr "char **"
1842 if not in_daemon then pr "struct guestfs_int_bool *"
1843 else pr "guestfs_%s_ret *" name
1845 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1846 else pr "guestfs_lvm_int_pv_list *"
1848 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1849 else pr "guestfs_lvm_int_vg_list *"
1851 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1852 else pr "guestfs_lvm_int_lv_list *"
1854 pr "%s%s (" prefix name;
1855 if handle = None && List.length (snd style) = 0 then
1858 let comma = ref false in
1861 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1865 if single_line then pr ", " else pr ",\n\t\t"
1871 | String n -> next (); pr "const char *%s" n
1872 | OptString n -> next (); pr "const char *%s" n
1873 | Bool n -> next (); pr "int %s" n
1874 | Int n -> next (); pr "int %s" n
1878 if semicolon then pr ";";
1879 if newline then pr "\n"
1881 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1882 and generate_call_args ?handle style =
1884 let comma = ref false in
1887 | Some handle -> pr "%s" handle; comma := true
1891 if !comma then pr ", ";
1894 | String n -> pr "%s" n
1895 | OptString n -> pr "%s" n
1896 | Bool n -> pr "%s" n
1897 | Int n -> pr "%s" n
1901 (* Generate the OCaml bindings interface. *)
1902 and generate_ocaml_mli () =
1903 generate_header OCamlStyle LGPLv2;
1906 (** For API documentation you should refer to the C API
1907 in the guestfs(3) manual page. The OCaml API uses almost
1908 exactly the same calls. *)
1911 (** A [guestfs_h] handle. *)
1913 exception Error of string
1914 (** This exception is raised when there is an error. *)
1916 val create : unit -> t
1918 val close : t -> unit
1919 (** Handles are closed by the garbage collector when they become
1920 unreferenced, but callers can also call this in order to
1921 provide predictable cleanup. *)
1924 generate_ocaml_lvm_structure_decls ();
1928 fun (name, style, _, _, shortdesc, _) ->
1929 generate_ocaml_prototype name style;
1930 pr "(** %s *)\n" shortdesc;
1934 (* Generate the OCaml bindings implementation. *)
1935 and generate_ocaml_ml () =
1936 generate_header OCamlStyle LGPLv2;
1940 exception Error of string
1941 external create : unit -> t = \"ocaml_guestfs_create\"
1942 external close : t -> unit = \"ocaml_guestfs_close\"
1945 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1949 generate_ocaml_lvm_structure_decls ();
1953 fun (name, style, _, _, shortdesc, _) ->
1954 generate_ocaml_prototype ~is_external:true name style;
1957 (* Generate the OCaml bindings C implementation. *)
1958 and generate_ocaml_c () =
1959 generate_header CStyle LGPLv2;
1961 pr "#include <stdio.h>\n";
1962 pr "#include <stdlib.h>\n";
1963 pr "#include <string.h>\n";
1965 pr "#include <caml/config.h>\n";
1966 pr "#include <caml/alloc.h>\n";
1967 pr "#include <caml/callback.h>\n";
1968 pr "#include <caml/fail.h>\n";
1969 pr "#include <caml/memory.h>\n";
1970 pr "#include <caml/mlvalues.h>\n";
1971 pr "#include <caml/signals.h>\n";
1973 pr "#include <guestfs.h>\n";
1975 pr "#include \"guestfs_c.h\"\n";
1978 (* LVM struct copy functions. *)
1981 let has_optpercent_col =
1982 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1984 pr "static CAMLprim value\n";
1985 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1987 pr " CAMLparam0 ();\n";
1988 if has_optpercent_col then
1989 pr " CAMLlocal3 (rv, v, v2);\n"
1991 pr " CAMLlocal2 (rv, v);\n";
1993 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1998 pr " v = caml_copy_string (%s->%s);\n" typ name
2000 pr " v = caml_alloc_string (32);\n";
2001 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
2004 pr " v = caml_copy_int64 (%s->%s);\n" typ name
2005 | name, `OptPercent ->
2006 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
2007 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
2008 pr " v = caml_alloc (1, 0);\n";
2009 pr " Store_field (v, 0, v2);\n";
2010 pr " } else /* None */\n";
2011 pr " v = Val_int (0);\n";
2013 pr " Store_field (rv, %d, v);\n" i
2015 pr " CAMLreturn (rv);\n";
2019 pr "static CAMLprim value\n";
2020 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
2023 pr " CAMLparam0 ();\n";
2024 pr " CAMLlocal2 (rv, v);\n";
2027 pr " if (%ss->len == 0)\n" typ;
2028 pr " CAMLreturn (Atom (0));\n";
2030 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
2031 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
2032 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
2033 pr " caml_modify (&Field (rv, i), v);\n";
2035 pr " CAMLreturn (rv);\n";
2039 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2042 fun (name, style, _, _, _, _) ->
2043 pr "CAMLprim value\n";
2044 pr "ocaml_guestfs_%s (value gv" name;
2046 fun arg -> pr ", value %sv" (name_of_argt arg)
2050 pr " CAMLparam%d (gv" (1 + (List.length (snd style)));
2052 fun arg -> pr ", %sv" (name_of_argt arg)
2055 pr " CAMLlocal1 (rv);\n";
2058 pr " guestfs_h *g = Guestfs_val (gv);\n";
2059 pr " if (g == NULL)\n";
2060 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2066 pr " const char *%s = String_val (%sv);\n" n n
2068 pr " const char *%s =\n" n;
2069 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2072 pr " int %s = Bool_val (%sv);\n" n n
2074 pr " int %s = Int_val (%sv);\n" n n
2077 match fst style with
2078 | Err -> pr " int r;\n"; "-1"
2079 | RInt _ -> pr " int r;\n"; "-1"
2080 | RBool _ -> pr " int r;\n"; "-1"
2081 | RConstString _ -> pr " const char *r;\n"; "NULL"
2082 | RString _ -> pr " char *r;\n"; "NULL"
2088 pr " struct guestfs_int_bool *r;\n";
2091 pr " struct guestfs_lvm_pv_list *r;\n";
2094 pr " struct guestfs_lvm_vg_list *r;\n";
2097 pr " struct guestfs_lvm_lv_list *r;\n";
2101 pr " caml_enter_blocking_section ();\n";
2102 pr " r = guestfs_%s " name;
2103 generate_call_args ~handle:"g" style;
2105 pr " caml_leave_blocking_section ();\n";
2106 pr " if (r == %s)\n" error_code;
2107 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2110 (match fst style with
2111 | Err -> pr " rv = Val_unit;\n"
2112 | RInt _ -> pr " rv = Val_int (r);\n"
2113 | RBool _ -> pr " rv = Val_bool (r);\n"
2114 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2116 pr " rv = caml_copy_string (r);\n";
2119 pr " rv = caml_copy_string_array ((const char **) r);\n";
2120 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2123 pr " rv = caml_alloc (2, 0);\n";
2124 pr " Store_field (rv, 0, Val_int (r->i));\n";
2125 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2126 pr " guestfs_free_int_bool (r);\n";
2128 pr " rv = copy_lvm_pv_list (r);\n";
2129 pr " guestfs_free_lvm_pv_list (r);\n";
2131 pr " rv = copy_lvm_vg_list (r);\n";
2132 pr " guestfs_free_lvm_vg_list (r);\n";
2134 pr " rv = copy_lvm_lv_list (r);\n";
2135 pr " guestfs_free_lvm_lv_list (r);\n";
2138 pr " CAMLreturn (rv);\n";
2143 and generate_ocaml_lvm_structure_decls () =
2146 pr "type lvm_%s = {\n" typ;
2149 | name, `String -> pr " %s : string;\n" name
2150 | name, `UUID -> pr " %s : string;\n" name
2151 | name, `Bytes -> pr " %s : int64;\n" name
2152 | name, `Int -> pr " %s : int64;\n" name
2153 | name, `OptPercent -> pr " %s : float option;\n" name
2157 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2159 and generate_ocaml_prototype ?(is_external = false) name style =
2160 if is_external then pr "external " else pr "val ";
2161 pr "%s : t -> " name;
2164 | String _ -> pr "string -> "
2165 | OptString _ -> pr "string option -> "
2166 | Bool _ -> pr "bool -> "
2167 | Int _ -> pr "int -> "
2169 (match fst style with
2170 | Err -> pr "unit" (* all errors are turned into exceptions *)
2171 | RInt _ -> pr "int"
2172 | RBool _ -> pr "bool"
2173 | RConstString _ -> pr "string"
2174 | RString _ -> pr "string"
2175 | RStringList _ -> pr "string array"
2176 | RIntBool _ -> pr "int * bool"
2177 | RPVList _ -> pr "lvm_pv array"
2178 | RVGList _ -> pr "lvm_vg array"
2179 | RLVList _ -> pr "lvm_lv array"
2181 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2184 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2185 and generate_perl_xs () =
2186 generate_header CStyle LGPLv2;
2189 #include \"EXTERN.h\"
2193 #include <guestfs.h>
2196 #define PRId64 \"lld\"
2200 my_newSVll(long long val) {
2201 #ifdef USE_64_BIT_ALL
2202 return newSViv(val);
2206 len = snprintf(buf, 100, \"%%\" PRId64, val);
2207 return newSVpv(buf, len);
2212 #define PRIu64 \"llu\"
2216 my_newSVull(unsigned long long val) {
2217 #ifdef USE_64_BIT_ALL
2218 return newSVuv(val);
2222 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2223 return newSVpv(buf, len);
2227 /* XXX Not thread-safe, and in general not safe if the caller is
2228 * issuing multiple requests in parallel (on different guestfs
2229 * handles). We should use the guestfs_h handle passed to the
2230 * error handle to distinguish these cases.
2232 static char *last_error = NULL;
2235 error_handler (guestfs_h *g,
2239 if (last_error != NULL) free (last_error);
2240 last_error = strdup (msg);
2243 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2248 RETVAL = guestfs_create ();
2250 croak (\"could not create guestfs handle\");
2251 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2264 fun (name, style, _, _, _, _) ->
2265 (match fst style with
2266 | Err -> pr "void\n"
2267 | RInt _ -> pr "SV *\n"
2268 | RBool _ -> pr "SV *\n"
2269 | RConstString _ -> pr "SV *\n"
2270 | RString _ -> pr "SV *\n"
2273 | RPVList _ | RVGList _ | RLVList _ ->
2274 pr "void\n" (* all lists returned implictly on the stack *)
2276 (* Call and arguments. *)
2278 generate_call_args ~handle:"g" style;
2280 pr " guestfs_h *g;\n";
2283 | String n -> pr " char *%s;\n" n
2284 | OptString n -> pr " char *%s;\n" n
2285 | Bool n -> pr " int %s;\n" n
2286 | Int n -> pr " int %s;\n" n
2289 (match fst style with
2292 pr " if (guestfs_%s " name;
2293 generate_call_args ~handle:"g" style;
2295 pr " croak (\"%s: %%s\", last_error);\n" name
2301 pr " %s = guestfs_%s " n name;
2302 generate_call_args ~handle:"g" style;
2304 pr " if (%s == -1)\n" n;
2305 pr " croak (\"%s: %%s\", last_error);\n" name;
2306 pr " RETVAL = newSViv (%s);\n" n;
2311 pr " const char *%s;\n" n;
2313 pr " %s = guestfs_%s " n name;
2314 generate_call_args ~handle:"g" style;
2316 pr " if (%s == NULL)\n" n;
2317 pr " croak (\"%s: %%s\", last_error);\n" name;
2318 pr " RETVAL = newSVpv (%s, 0);\n" n;
2323 pr " char *%s;\n" n;
2325 pr " %s = guestfs_%s " n name;
2326 generate_call_args ~handle:"g" style;
2328 pr " if (%s == NULL)\n" n;
2329 pr " croak (\"%s: %%s\", last_error);\n" name;
2330 pr " RETVAL = newSVpv (%s, 0);\n" n;
2331 pr " free (%s);\n" n;
2336 pr " char **%s;\n" n;
2339 pr " %s = guestfs_%s " n name;
2340 generate_call_args ~handle:"g" style;
2342 pr " if (%s == NULL)\n" n;
2343 pr " croak (\"%s: %%s\", last_error);\n" name;
2344 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2345 pr " EXTEND (SP, n);\n";
2346 pr " for (i = 0; i < n; ++i) {\n";
2347 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2348 pr " free (%s[i]);\n" n;
2350 pr " free (%s);\n" n;
2353 pr " struct guestfs_int_bool *r;\n";
2355 pr " r = guestfs_%s " name;
2356 generate_call_args ~handle:"g" style;
2358 pr " if (r == NULL)\n";
2359 pr " croak (\"%s: %%s\", last_error);\n" name;
2360 pr " EXTEND (SP, 2);\n";
2361 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2362 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2363 pr " guestfs_free_int_bool (r);\n";
2365 generate_perl_lvm_code "pv" pv_cols name style n;
2367 generate_perl_lvm_code "vg" vg_cols name style n;
2369 generate_perl_lvm_code "lv" lv_cols name style n;
2374 and generate_perl_lvm_code typ cols name style n =
2376 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2380 pr " %s = guestfs_%s " n name;
2381 generate_call_args ~handle:"g" style;
2383 pr " if (%s == NULL)\n" n;
2384 pr " croak (\"%s: %%s\", last_error);\n" name;
2385 pr " EXTEND (SP, %s->len);\n" n;
2386 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2387 pr " hv = newHV ();\n";
2391 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2392 name (String.length name) n name
2394 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2395 name (String.length name) n name
2397 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2398 name (String.length name) n name
2400 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2401 name (String.length name) n name
2402 | name, `OptPercent ->
2403 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2404 name (String.length name) n name
2406 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2408 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2410 (* Generate Sys/Guestfs.pm. *)
2411 and generate_perl_pm () =
2412 generate_header HashStyle LGPLv2;
2419 Sys::Guestfs - Perl bindings for libguestfs
2425 my $h = Sys::Guestfs->new ();
2426 $h->add_drive ('guest.img');
2429 $h->mount ('/dev/sda1', '/');
2430 $h->touch ('/hello');
2435 The C<Sys::Guestfs> module provides a Perl XS binding to the
2436 libguestfs API for examining and modifying virtual machine
2439 Amongst the things this is good for: making batch configuration
2440 changes to guests, getting disk used/free statistics (see also:
2441 virt-df), migrating between virtualization systems (see also:
2442 virt-p2v), performing partial backups, performing partial guest
2443 clones, cloning guests and changing registry/UUID/hostname info, and
2446 Libguestfs uses Linux kernel and qemu code, and can access any type of
2447 guest filesystem that Linux and qemu can, including but not limited
2448 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2449 schemes, qcow, qcow2, vmdk.
2451 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2452 LVs, what filesystem is in each LV, etc.). It can also run commands
2453 in the context of the guest. Also you can access filesystems over FTP.
2457 All errors turn into calls to C<croak> (see L<Carp(3)>).
2465 package Sys::Guestfs;
2471 XSLoader::load ('Sys::Guestfs');
2473 =item $h = Sys::Guestfs->new ();
2475 Create a new guestfs handle.
2481 my $class = ref ($proto) || $proto;
2483 my $self = Sys::Guestfs::_create ();
2484 bless $self, $class;
2490 (* Actions. We only need to print documentation for these as
2491 * they are pulled in from the XS code automatically.
2494 fun (name, style, _, flags, _, longdesc) ->
2495 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2497 generate_perl_prototype name style;
2499 pr "%s\n\n" longdesc;
2500 if List.mem ProtocolLimitWarning flags then
2501 pr "Because of the message protocol, there is a transfer limit
2502 of somewhere between 2MB and 4MB. To transfer large files you should use
2504 ) all_functions_sorted;
2516 Copyright (C) 2009 Red Hat Inc.
2520 Please see the file COPYING.LIB for the full license.
2524 L<guestfs(3)>, L<guestfish(1)>.
2529 and generate_perl_prototype name style =
2530 (match fst style with
2535 | RString n -> pr "$%s = " n
2536 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2540 | RLVList n -> pr "@%s = " n
2543 let comma = ref false in
2546 if !comma then pr ", ";
2548 pr "%s" (name_of_argt arg)
2552 let output_to filename =
2553 let filename_new = filename ^ ".new" in
2554 chan := open_out filename_new;
2558 Unix.rename filename_new filename;
2559 printf "written %s\n%!" filename;
2567 if not (Sys.file_exists "configure.ac") then (
2569 You are probably running this from the wrong directory.
2570 Run it from the top source directory using the command
2576 let close = output_to "src/guestfs_protocol.x" in
2580 let close = output_to "src/guestfs-structs.h" in
2581 generate_structs_h ();
2584 let close = output_to "src/guestfs-actions.h" in
2585 generate_actions_h ();
2588 let close = output_to "src/guestfs-actions.c" in
2589 generate_client_actions ();
2592 let close = output_to "daemon/actions.h" in
2593 generate_daemon_actions_h ();
2596 let close = output_to "daemon/stubs.c" in
2597 generate_daemon_actions ();
2600 let close = output_to "fish/cmds.c" in
2601 generate_fish_cmds ();
2604 let close = output_to "guestfs-structs.pod" in
2605 generate_structs_pod ();
2608 let close = output_to "guestfs-actions.pod" in
2609 generate_actions_pod ();
2612 let close = output_to "guestfish-actions.pod" in
2613 generate_fish_actions_pod ();
2616 let close = output_to "ocaml/guestfs.mli" in
2617 generate_ocaml_mli ();
2620 let close = output_to "ocaml/guestfs.ml" in
2621 generate_ocaml_ml ();
2624 let close = output_to "ocaml/guestfs_c_actions.c" in
2625 generate_ocaml_c ();
2628 let close = output_to "perl/Guestfs.xs" in
2629 generate_perl_xs ();
2632 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2633 generate_perl_pm ();