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. *)
67 (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
71 | P3 of argt * argt * argt
73 | String of string (* const char *name, cannot be NULL *)
74 | OptString of string (* const char *name, may be NULL *)
75 | Bool of string (* boolean *)
76 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
79 | ProtocolLimitWarning (* display warning about protocol size limits *)
80 | FishAlias of string (* provide an alias for this cmd in guestfish *)
81 | FishAction of string (* call this function in guestfish *)
82 | NotInFish (* do not export via guestfish *)
84 (* Note about long descriptions: When referring to another
85 * action, use the format C<guestfs_other> (ie. the full name of
86 * the C function). This will be replaced as appropriate in other
89 * Apart from that, long descriptions are just perldoc paragraphs.
92 let non_daemon_functions = [
93 ("launch", (Err, P0), -1, [FishAlias "run"; FishAction "launch"],
94 "launch the qemu subprocess",
96 Internally libguestfs is implemented by running a virtual machine
99 You should call this after configuring the handle
100 (eg. adding drives) but before performing any actions.");
102 ("wait_ready", (Err, P0), -1, [NotInFish],
103 "wait until the qemu subprocess launches",
105 Internally libguestfs is implemented by running a virtual machine
108 You should call this after C<guestfs_launch> to wait for the launch
111 ("kill_subprocess", (Err, P0), -1, [],
112 "kill the qemu subprocess",
114 This kills the qemu subprocess. You should never need to call this.");
116 ("add_drive", (Err, P1 (String "filename")), -1, [FishAlias "add"],
117 "add an image to examine or modify",
119 This function adds a virtual machine disk image C<filename> to the
120 guest. The first time you call this function, the disk appears as IDE
121 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
124 You don't necessarily need to be root when using libguestfs. However
125 you obviously do need sufficient permissions to access the filename
126 for whatever operations you want to perform (ie. read access if you
127 just want to read the image or write access if you want to modify the
130 This is equivalent to the qemu parameter C<-drive file=filename>.");
132 ("add_cdrom", (Err, P1 (String "filename")), -1, [FishAlias "cdrom"],
133 "add a CD-ROM disk image to examine",
135 This function adds a virtual CD-ROM disk image to the guest.
137 This is equivalent to the qemu parameter C<-cdrom filename>.");
139 ("config", (Err, P2 (String "qemuparam", OptString "qemuvalue")), -1, [],
140 "add qemu parameters",
142 This can be used to add arbitrary qemu command line parameters
143 of the form C<-param value>. Actually it's not quite arbitrary - we
144 prevent you from setting some parameters which would interfere with
145 parameters that we use.
147 The first character of C<param> string must be a C<-> (dash).
149 C<value> can be NULL.");
151 ("set_path", (Err, P1 (String "path")), -1, [FishAlias "path"],
152 "set the search path",
154 Set the path that libguestfs searches for kernel and initrd.img.
156 The default is C<$libdir/guestfs> unless overridden by setting
157 C<LIBGUESTFS_PATH> environment variable.
159 The string C<path> is stashed in the libguestfs handle, so the caller
160 must make sure it remains valid for the lifetime of the handle.
162 Setting C<path> to C<NULL> restores the default path.");
164 ("get_path", (RConstString "path", P0), -1, [],
165 "get the search path",
167 Return the current search path.
169 This is always non-NULL. If it wasn't set already, then this will
170 return the default path.");
172 ("set_autosync", (Err, P1 (Bool "autosync")), -1, [FishAlias "autosync"],
175 If C<autosync> is true, this enables autosync. Libguestfs will make a
176 best effort attempt to run C<guestfs_sync> when the handle is closed
177 (also if the program exits without closing handles).");
179 ("get_autosync", (RBool "autosync", P0), -1, [],
182 Get the autosync flag.");
184 ("set_verbose", (Err, P1 (Bool "verbose")), -1, [FishAlias "verbose"],
187 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
189 Verbose messages are disabled unless the environment variable
190 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
192 ("get_verbose", (RBool "verbose", P0), -1, [],
195 This returns the verbose messages flag.")
198 let daemon_functions = [
199 ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
200 "mount a guest disk at a position in the filesystem",
202 Mount a guest disk at a position in the filesystem. Block devices
203 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
204 the guest. If those block devices contain partitions, they will have
205 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
208 The rules are the same as for L<mount(2)>: A filesystem must
209 first be mounted on C</> before others can be mounted. Other
210 filesystems can only be mounted on directories which already
213 The mounted filesystem is writable, if we have sufficient permissions
214 on the underlying device.
216 The filesystem options C<sync> and C<noatime> are set with this
217 call, in order to improve reliability.");
219 ("sync", (Err, P0), 2, [],
220 "sync disks, writes are flushed through to the disk image",
222 This syncs the disk, so that any writes are flushed through to the
223 underlying disk image.
225 You should always call this if you have modified a disk image, before
226 closing the handle.");
228 ("touch", (Err, P1 (String "path")), 3, [],
229 "update file timestamps or create a new file",
231 Touch acts like the L<touch(1)> command. It can be used to
232 update the timestamps on a file, or, if the file does not exist,
233 to create a new zero-length file.");
235 ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
236 "list the contents of a file",
238 Return the contents of the file named C<path>.
240 Note that this function cannot correctly handle binary files
241 (specifically, files containing C<\\0> character which is treated
242 as end of string). For those you need to use the C<guestfs_read_file>
243 function which has a more complex interface.");
245 ("ll", (RString "listing", P1 (String "directory")), 5, [],
246 "list the files in a directory (long format)",
248 List the files in C<directory> (relative to the root directory,
249 there is no cwd) in the format of 'ls -la'.
251 This command is mostly useful for interactive sessions. It
252 is I<not> intended that you try to parse the output string.");
254 ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
255 "list the files in a directory",
257 List the files in C<directory> (relative to the root directory,
258 there is no cwd). The '.' and '..' entries are not returned, but
259 hidden files are shown.
261 This command is mostly useful for interactive sessions. Programs
262 should probably use C<guestfs_readdir> instead.");
264 ("list_devices", (RStringList "devices", P0), 7, [],
265 "list the block devices",
267 List all the block devices.
269 The full block device names are returned, eg. C</dev/sda>");
271 ("list_partitions", (RStringList "partitions", P0), 8, [],
272 "list the partitions",
274 List all the partitions detected on all block devices.
276 The full partition device names are returned, eg. C</dev/sda1>
278 This does not return logical volumes. For that you will need to
279 call C<guestfs_lvs>.");
281 ("pvs", (RStringList "physvols", P0), 9, [],
282 "list the LVM physical volumes (PVs)",
284 List all the physical volumes detected. This is the equivalent
285 of the L<pvs(8)> command.
287 This returns a list of just the device names that contain
288 PVs (eg. C</dev/sda2>).
290 See also C<guestfs_pvs_full>.");
292 ("vgs", (RStringList "volgroups", P0), 10, [],
293 "list the LVM volume groups (VGs)",
295 List all the volumes groups detected. This is the equivalent
296 of the L<vgs(8)> command.
298 This returns a list of just the volume group names that were
299 detected (eg. C<VolGroup00>).
301 See also C<guestfs_vgs_full>.");
303 ("lvs", (RStringList "logvols", P0), 11, [],
304 "list the LVM logical volumes (LVs)",
306 List all the logical volumes detected. This is the equivalent
307 of the L<lvs(8)> command.
309 This returns a list of the logical volume device names
310 (eg. C</dev/VolGroup00/LogVol00>).
312 See also C<guestfs_lvs_full>.");
314 ("pvs_full", (RPVList "physvols", P0), 12, [],
315 "list the LVM physical volumes (PVs)",
317 List all the physical volumes detected. This is the equivalent
318 of the L<pvs(8)> command. The \"full\" version includes all fields.");
320 ("vgs_full", (RVGList "volgroups", P0), 13, [],
321 "list the LVM volume groups (VGs)",
323 List all the volumes groups detected. This is the equivalent
324 of the L<vgs(8)> command. The \"full\" version includes all fields.");
326 ("lvs_full", (RLVList "logvols", P0), 14, [],
327 "list the LVM logical volumes (LVs)",
329 List all the logical volumes detected. This is the equivalent
330 of the L<lvs(8)> command. The \"full\" version includes all fields.");
332 ("read_lines", (RStringList "lines", P1 (String "path")), 15, [],
333 "read file as lines",
335 Return the contents of the file named C<path>.
337 The file contents are returned as a list of lines. Trailing
338 C<LF> and C<CRLF> character sequences are I<not> returned.
340 Note that this function cannot correctly handle binary files
341 (specifically, files containing C<\\0> character which is treated
342 as end of line). For those you need to use the C<guestfs_read_file>
343 function which has a more complex interface.");
345 ("aug_init", (Err, P2 (String "root", Int "flags")), 16, [],
346 "create a new Augeas handle",
348 Create a new Augeas handle for editing configuration files.
349 If there was any previous Augeas handle associated with this
350 guestfs session, then it is closed.
352 You must call this before using any other C<guestfs_aug_*>
355 C<root> is the filesystem root. C<root> must not be NULL,
358 The flags are the same as the flags defined in
359 E<lt>augeas.hE<gt>, the logical I<or> of the following
364 =item C<AUG_SAVE_BACKUP> = 1
366 Keep the original file with a C<.augsave> extension.
368 =item C<AUG_SAVE_NEWFILE> = 2
370 Save changes into a file with extension C<.augnew>, and
371 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
373 =item C<AUG_TYPE_CHECK> = 4
375 Typecheck lenses (can be expensive).
377 =item C<AUG_NO_STDINC> = 8
379 Do not use standard load path for modules.
381 =item C<AUG_SAVE_NOOP> = 16
383 Make save a no-op, just record what would have been changed.
385 =item C<AUG_NO_LOAD> = 32
387 Do not load the tree in C<guestfs_aug_init>.
391 To close the handle, you can call C<guestfs_aug_close>.
393 To find out more about Augeas, see L<http://augeas.net/>.");
395 ("aug_close", (Err, P0), 26, [],
396 "close the current Augeas handle",
398 Close the current Augeas handle and free up any resources
399 used by it. After calling this, you have to call
400 C<guestfs_aug_init> again before you can use any other
403 ("aug_defvar", (RInt "nrnodes", P2 (String "name", OptString "expr")), 17, [],
404 "define an Augeas variable",
406 Defines an Augeas variable C<name> whose value is the result
407 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
410 On success this returns the number of nodes in C<expr>, or
411 C<0> if C<expr> evaluates to something which is not a nodeset.");
413 ("aug_defnode", (RIntBool ("nrnodes", "created"), P3 (String "name", String "expr", String "val")), 18, [],
414 "define an Augeas node",
416 Defines a variable C<name> whose value is the result of
419 If C<expr> evaluates to an empty nodeset, a node is created,
420 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
421 C<name> will be the nodeset containing that single node.
423 On success this returns a pair containing the
424 number of nodes in the nodeset, and a boolean flag
425 if a node was created.");
427 ("aug_get", (RString "val", P1 (String "path")), 19, [],
428 "look up the value of an Augeas path",
430 Look up the value associated with C<path>. If C<path>
431 matches exactly one node, the C<value> is returned.");
433 ("aug_set", (Err, P2 (String "path", String "val")), 20, [],
434 "set Augeas path to value",
436 Set the value associated with C<path> to C<value>.");
438 ("aug_insert", (Err, P3 (String "path", String "label", Bool "before")), 21, [],
439 "insert a sibling Augeas node",
441 Create a new sibling C<label> for C<path>, inserting it into
442 the tree before or after C<path> (depending on the boolean
445 C<path> must match exactly one existing node in the tree, and
446 C<label> must be a label, ie. not contain C</>, C<*> or end
447 with a bracketed index C<[N]>.");
449 ("aug_rm", (RInt "nrnodes", P1 (String "path")), 22, [],
450 "remove an Augeas path",
452 Remove C<path> and all of its children.
454 On success this returns the number of entries which were removed.");
456 ("aug_mv", (Err, P2 (String "src", String "dest")), 23, [],
459 Move the node C<src> to C<dest>. C<src> must match exactly
460 one node. C<dest> is overwritten if it exists.");
462 ("aug_match", (RStringList "matches", P1 (String "path")), 24, [],
463 "return Augeas nodes which match path",
465 Returns a list of paths which match the path expression C<path>.
466 The returned paths are sufficiently qualified so that they match
467 exactly one node in the current tree.");
469 ("aug_save", (Err, P0), 25, [],
470 "write all pending Augeas changes to disk",
472 This writes all pending changes to disk.
474 The flags which were passed to C<guestfs_aug_init> affect exactly
475 how files are saved.");
477 ("aug_load", (Err, P0), 27, [],
478 "load files into the tree",
480 Load files into the tree.
482 See C<aug_load> in the Augeas documentation for the full gory
485 ("aug_ls", (RStringList "matches", P1 (String "path")), 28, [],
486 "list Augeas nodes under a path",
488 This is just a shortcut for listing C<guestfs_aug_match>
489 C<path/*> and sorting the resulting nodes into alphabetical order.");
492 let all_functions = non_daemon_functions @ daemon_functions
494 (* In some places we want the functions to be displayed sorted
495 * alphabetically, so this is useful:
497 let all_functions_sorted =
498 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
500 (* Column names and types from LVM PVs/VGs/LVs. *)
509 "pv_attr", `String (* XXX *);
511 "pv_pe_alloc_count", `Int;
514 "pv_mda_count", `Int;
515 "pv_mda_free", `Bytes;
517 "pv_mda_size", `Bytes;
524 "vg_attr", `String (* XXX *);
528 "vg_extent_size", `Bytes;
529 "vg_extent_count", `Int;
530 "vg_free_count", `Int;
538 "vg_mda_count", `Int;
539 "vg_mda_free", `Bytes;
541 "vg_mda_size", `Bytes;
547 "lv_attr", `String (* XXX *);
550 "lv_kernel_major", `Int;
551 "lv_kernel_minor", `Int;
555 "snap_percent", `OptPercent;
556 "copy_percent", `OptPercent;
559 "mirror_log", `String;
564 * Note we don't want to use any external OCaml libraries which
565 * makes this a bit harder than it should be.
567 let failwithf fs = ksprintf failwith fs
569 let replace_char s c1 c2 =
570 let s2 = String.copy s in
572 for i = 0 to String.length s2 - 1 do
573 if String.unsafe_get s2 i = c1 then (
574 String.unsafe_set s2 i c2;
578 if not !r then s else s2
581 let len = String.length s in
582 let sublen = String.length sub in
584 if i <= len-sublen then (
587 if s.[i+j] = sub.[j] then loop2 (j+1)
593 if r = -1 then loop (i+1) else r
599 let rec replace_str s s1 s2 =
600 let len = String.length s in
601 let sublen = String.length s1 in
605 let s' = String.sub s 0 i in
606 let s'' = String.sub s (i+sublen) (len-i-sublen) in
607 s' ^ s2 ^ replace_str s'' s1 s2
610 let rec find_map f = function
611 | [] -> raise Not_found
615 | None -> find_map f xs
618 let rec loop i = function
620 | x :: xs -> f i x; loop (i+1) xs
624 (* 'pr' prints to the current output file. *)
625 let chan = ref stdout
626 let pr fs = ksprintf (output_string !chan) fs
628 let iter_args f = function
631 | P2 (arg1, arg2) -> f arg1; f arg2
632 | P3 (arg1, arg2, arg3) -> f arg1; f arg2; f arg3
634 let iteri_args f = function
636 | P1 arg1 -> f 0 arg1
637 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
638 | P3 (arg1, arg2, arg3) -> f 0 arg1; f 1 arg2; f 2 arg3
640 let map_args f = function
642 | P1 arg1 -> [f arg1]
644 let n1 = f arg1 in let n2 = f arg2 in [n1; n2]
645 | P3 (arg1, arg2, arg3) ->
646 let n1 = f arg1 in let n2 = f arg2 in let n3 = f arg3 in [n1; n2; n3]
648 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2 | P3 _ -> 3
650 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
652 (* Check function names etc. for consistency. *)
653 let check_functions () =
655 fun (name, _, _, _, _, longdesc) ->
656 if String.contains name '-' then
657 failwithf "function name '%s' should not contain '-', use '_' instead."
659 if longdesc.[String.length longdesc-1] = '\n' then
660 failwithf "long description of %s should not end with \\n." name
664 fun (name, _, proc_nr, _, _, _) ->
666 failwithf "daemon function %s should have proc_nr > 0" name
670 fun (name, _, proc_nr, _, _, _) ->
671 if proc_nr <> -1 then
672 failwithf "non-daemon function %s should have proc_nr -1" name
673 ) non_daemon_functions;
676 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
679 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
680 let rec loop = function
683 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
685 | (name1,nr1) :: (name2,nr2) :: _ ->
686 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
691 type comment_style = CStyle | HashStyle | OCamlStyle
692 type license = GPLv2 | LGPLv2
694 (* Generate a header block in a number of standard styles. *)
695 let rec generate_header comment license =
696 let c = match comment with
697 | CStyle -> pr "/* "; " *"
698 | HashStyle -> pr "# "; "#"
699 | OCamlStyle -> pr "(* "; " *" in
700 pr "libguestfs generated file\n";
701 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
702 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
704 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
708 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
709 pr "%s it under the terms of the GNU General Public License as published by\n" c;
710 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
711 pr "%s (at your option) any later version.\n" c;
713 pr "%s This program is distributed in the hope that it will be useful,\n" c;
714 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
715 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
716 pr "%s GNU General Public License for more details.\n" c;
718 pr "%s You should have received a copy of the GNU General Public License along\n" c;
719 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
720 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
723 pr "%s This library is free software; you can redistribute it and/or\n" c;
724 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
725 pr "%s License as published by the Free Software Foundation; either\n" c;
726 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
728 pr "%s This library is distributed in the hope that it will be useful,\n" c;
729 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
730 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
731 pr "%s Lesser General Public License for more details.\n" c;
733 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
734 pr "%s License along with this library; if not, write to the Free Software\n" c;
735 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
738 | CStyle -> pr " */\n"
740 | OCamlStyle -> pr " *)\n"
744 (* Generate the pod documentation for the C API. *)
745 and generate_actions_pod () =
747 fun (shortname, style, _, flags, _, longdesc) ->
748 let name = "guestfs_" ^ shortname in
749 pr "=head2 %s\n\n" name;
751 generate_prototype ~extern:false ~handle:"handle" name style;
753 pr "%s\n\n" longdesc;
754 (match fst style with
756 pr "This function returns 0 on success or -1 on error.\n\n"
758 pr "On error this function returns -1.\n\n"
760 pr "This function returns a C truth value on success or -1 on error.\n\n"
762 pr "This function returns a string or NULL on error.
763 The string is owned by the guest handle and must I<not> be freed.\n\n"
765 pr "This function returns a string or NULL on error.
766 I<The caller must free the returned string after use>.\n\n"
768 pr "This function returns a NULL-terminated array of strings
769 (like L<environ(3)>), or NULL if there was an error.
770 I<The caller must free the strings and the array after use>.\n\n"
772 pr "This function returns a C<struct guestfs_int_bool *>.
773 I<The caller must call C<guestfs_free_int_bool> after use.>.\n\n"
775 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
776 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
778 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
779 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
781 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
782 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
784 if List.mem ProtocolLimitWarning flags then
785 pr "Because of the message protocol, there is a transfer limit
786 of somewhere between 2MB and 4MB. To transfer large files you should use
788 ) all_functions_sorted
790 and generate_structs_pod () =
791 (* LVM structs documentation. *)
794 pr "=head2 guestfs_lvm_%s\n" typ;
796 pr " struct guestfs_lvm_%s {\n" typ;
799 | name, `String -> pr " char *%s;\n" name
801 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
802 pr " char %s[32];\n" name
803 | name, `Bytes -> pr " uint64_t %s;\n" name
804 | name, `Int -> pr " int64_t %s;\n" name
805 | name, `OptPercent ->
806 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
807 pr " float %s;\n" name
810 pr " struct guestfs_lvm_%s_list {\n" typ;
811 pr " uint32_t len; /* Number of elements in list. */\n";
812 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
815 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
818 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
820 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
821 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
822 * have to use an underscore instead of a dash because otherwise
823 * rpcgen generates incorrect code.
825 * This header is NOT exported to clients, but see also generate_structs_h.
827 and generate_xdr () =
828 generate_header CStyle LGPLv2;
830 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
831 pr "typedef string str<>;\n";
834 (* LVM internal structures. *)
838 pr "struct guestfs_lvm_int_%s {\n" typ;
840 | name, `String -> pr " string %s<>;\n" name
841 | name, `UUID -> pr " opaque %s[32];\n" name
842 | name, `Bytes -> pr " hyper %s;\n" name
843 | name, `Int -> pr " hyper %s;\n" name
844 | name, `OptPercent -> pr " float %s;\n" name
848 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
850 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
853 fun(shortname, style, _, _, _, _) ->
854 let name = "guestfs_" ^ shortname in
856 (match snd style with
859 pr "struct %s_args {\n" name;
862 | String n -> pr " string %s<>;\n" n
863 | OptString n -> pr " str *%s;\n" n
864 | Bool n -> pr " bool %s;\n" n
865 | Int n -> pr " int %s;\n" n
869 (match fst style with
872 pr "struct %s_ret {\n" name;
876 pr "struct %s_ret {\n" name;
880 failwithf "RConstString cannot be returned from a daemon function"
882 pr "struct %s_ret {\n" name;
883 pr " string %s<>;\n" n;
886 pr "struct %s_ret {\n" name;
890 pr "struct %s_ret {\n" name;
895 pr "struct %s_ret {\n" name;
896 pr " guestfs_lvm_int_pv_list %s;\n" n;
899 pr "struct %s_ret {\n" name;
900 pr " guestfs_lvm_int_vg_list %s;\n" n;
903 pr "struct %s_ret {\n" name;
904 pr " guestfs_lvm_int_lv_list %s;\n" n;
909 (* Table of procedure numbers. *)
910 pr "enum guestfs_procedure {\n";
912 fun (shortname, _, proc_nr, _, _, _) ->
913 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
915 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
919 (* Having to choose a maximum message size is annoying for several
920 * reasons (it limits what we can do in the API), but it (a) makes
921 * the protocol a lot simpler, and (b) provides a bound on the size
922 * of the daemon which operates in limited memory space. For large
923 * file transfers you should use FTP.
925 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
928 (* Message header, etc. *)
930 const GUESTFS_PROGRAM = 0x2000F5F5;
931 const GUESTFS_PROTOCOL_VERSION = 1;
933 enum guestfs_message_direction {
934 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
935 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
938 enum guestfs_message_status {
939 GUESTFS_STATUS_OK = 0,
940 GUESTFS_STATUS_ERROR = 1
943 const GUESTFS_ERROR_LEN = 256;
945 struct guestfs_message_error {
946 string error<GUESTFS_ERROR_LEN>; /* error message */
949 struct guestfs_message_header {
950 unsigned prog; /* GUESTFS_PROGRAM */
951 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
952 guestfs_procedure proc; /* GUESTFS_PROC_x */
953 guestfs_message_direction direction;
954 unsigned serial; /* message serial number */
955 guestfs_message_status status;
959 (* Generate the guestfs-structs.h file. *)
960 and generate_structs_h () =
961 generate_header CStyle LGPLv2;
963 (* This is a public exported header file containing various
964 * structures. The structures are carefully written to have
965 * exactly the same in-memory format as the XDR structures that
966 * we use on the wire to the daemon. The reason for creating
967 * copies of these structures here is just so we don't have to
968 * export the whole of guestfs_protocol.h (which includes much
969 * unrelated and XDR-dependent stuff that we don't want to be
970 * public, or required by clients).
972 * To reiterate, we will pass these structures to and from the
973 * client with a simple assignment or memcpy, so the format
974 * must be identical to what rpcgen / the RFC defines.
977 (* guestfs_int_bool structure. *)
978 pr "struct guestfs_int_bool {\n";
984 (* LVM public structures. *)
988 pr "struct guestfs_lvm_%s {\n" typ;
991 | name, `String -> pr " char *%s;\n" name
992 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
993 | name, `Bytes -> pr " uint64_t %s;\n" name
994 | name, `Int -> pr " int64_t %s;\n" name
995 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
999 pr "struct guestfs_lvm_%s_list {\n" typ;
1000 pr " uint32_t len;\n";
1001 pr " struct guestfs_lvm_%s *val;\n" typ;
1004 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1006 (* Generate the guestfs-actions.h file. *)
1007 and generate_actions_h () =
1008 generate_header CStyle LGPLv2;
1010 fun (shortname, style, _, _, _, _) ->
1011 let name = "guestfs_" ^ shortname in
1012 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1016 (* Generate the client-side dispatch stubs. *)
1017 and generate_client_actions () =
1018 generate_header CStyle LGPLv2;
1020 (* Client-side stubs for each function. *)
1022 fun (shortname, style, _, _, _, _) ->
1023 let name = "guestfs_" ^ shortname in
1025 (* Generate the return value struct. *)
1026 pr "struct %s_rv {\n" shortname;
1027 pr " int cb_done; /* flag to indicate callback was called */\n";
1028 pr " struct guestfs_message_header hdr;\n";
1029 pr " struct guestfs_message_error err;\n";
1030 (match fst style with
1033 failwithf "RConstString cannot be returned from a daemon function"
1035 | RBool _ | RString _ | RStringList _
1037 | RPVList _ | RVGList _ | RLVList _ ->
1038 pr " struct %s_ret ret;\n" name
1042 (* Generate the callback function. *)
1043 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1045 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1047 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1048 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1051 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1052 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1053 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1059 (match fst style with
1062 failwithf "RConstString cannot be returned from a daemon function"
1064 | RBool _ | RString _ | RStringList _
1066 | RPVList _ | RVGList _ | RLVList _ ->
1067 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1068 pr " error (g, \"%s: failed to parse reply\");\n" name;
1074 pr " rv->cb_done = 1;\n";
1075 pr " main_loop.main_loop_quit (g);\n";
1078 (* Generate the action stub. *)
1079 generate_prototype ~extern:false ~semicolon:false ~newline:true
1080 ~handle:"g" name style;
1083 match fst style with
1084 | Err | RInt _ | RBool _ -> "-1"
1086 failwithf "RConstString cannot be returned from a daemon function"
1087 | RString _ | RStringList _ | RIntBool _
1088 | RPVList _ | RVGList _ | RLVList _ ->
1093 (match snd style with
1095 | _ -> pr " struct %s_args args;\n" name
1098 pr " struct %s_rv rv;\n" shortname;
1099 pr " int serial;\n";
1101 pr " if (g->state != READY) {\n";
1102 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1105 pr " return %s;\n" error_code;
1108 pr " memset (&rv, 0, sizeof rv);\n";
1111 (match snd style with
1113 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1114 (String.uppercase shortname)
1119 pr " args.%s = (char *) %s;\n" n n
1121 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1123 pr " args.%s = %s;\n" n n
1125 pr " args.%s = %s;\n" n n
1127 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1128 (String.uppercase shortname);
1129 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1132 pr " if (serial == -1)\n";
1133 pr " return %s;\n" error_code;
1136 pr " rv.cb_done = 0;\n";
1137 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1138 pr " g->reply_cb_internal_data = &rv;\n";
1139 pr " main_loop.main_loop_run (g);\n";
1140 pr " g->reply_cb_internal = NULL;\n";
1141 pr " g->reply_cb_internal_data = NULL;\n";
1142 pr " if (!rv.cb_done) {\n";
1143 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1144 pr " return %s;\n" error_code;
1148 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1149 (String.uppercase shortname);
1150 pr " return %s;\n" error_code;
1153 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1154 pr " error (g, \"%%s\", rv.err.error);\n";
1155 pr " return %s;\n" error_code;
1159 (match fst style with
1160 | Err -> pr " return 0;\n"
1162 | RBool n -> pr " return rv.ret.%s;\n" n
1164 failwithf "RConstString cannot be returned from a daemon function"
1166 pr " return rv.ret.%s; /* caller will free */\n" n
1168 pr " /* caller will free this, but we need to add a NULL entry */\n";
1169 pr " rv.ret.%s.%s_val =" n n;
1170 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1171 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1173 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1174 pr " return rv.ret.%s.%s_val;\n" n n
1176 pr " /* caller with free this */\n";
1177 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1179 pr " /* caller will free this */\n";
1180 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1182 pr " /* caller will free this */\n";
1183 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1185 pr " /* caller will free this */\n";
1186 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1192 (* Generate daemon/actions.h. *)
1193 and generate_daemon_actions_h () =
1194 generate_header CStyle GPLv2;
1196 pr "#include \"../src/guestfs_protocol.h\"\n";
1200 fun (name, style, _, _, _, _) ->
1202 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1206 (* Generate the server-side stubs. *)
1207 and generate_daemon_actions () =
1208 generate_header CStyle GPLv2;
1210 pr "#define _GNU_SOURCE // for strchrnul\n";
1212 pr "#include <stdio.h>\n";
1213 pr "#include <stdlib.h>\n";
1214 pr "#include <string.h>\n";
1215 pr "#include <inttypes.h>\n";
1216 pr "#include <ctype.h>\n";
1217 pr "#include <rpc/types.h>\n";
1218 pr "#include <rpc/xdr.h>\n";
1220 pr "#include \"daemon.h\"\n";
1221 pr "#include \"../src/guestfs_protocol.h\"\n";
1222 pr "#include \"actions.h\"\n";
1226 fun (name, style, _, _, _, _) ->
1227 (* Generate server-side stubs. *)
1228 pr "static void %s_stub (XDR *xdr_in)\n" name;
1231 match fst style with
1232 | Err | RInt _ -> pr " int r;\n"; "-1"
1233 | RBool _ -> pr " int r;\n"; "-1"
1235 failwithf "RConstString cannot be returned from a daemon function"
1236 | RString _ -> pr " char *r;\n"; "NULL"
1237 | RStringList _ -> pr " char **r;\n"; "NULL"
1238 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1239 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1240 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1241 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1243 (match snd style with
1246 pr " struct guestfs_%s_args args;\n" name;
1250 | OptString n -> pr " const char *%s;\n" n
1251 | Bool n -> pr " int %s;\n" n
1252 | Int n -> pr " int %s;\n" n
1257 (match snd style with
1260 pr " memset (&args, 0, sizeof args);\n";
1262 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1263 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1268 | String n -> pr " %s = args.%s;\n" n n
1269 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1270 | Bool n -> pr " %s = args.%s;\n" n n
1271 | Int n -> pr " %s = args.%s;\n" n n
1276 pr " r = do_%s " name;
1277 generate_call_args style;
1280 pr " if (r == %s)\n" error_code;
1281 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1285 (match fst style with
1286 | Err -> pr " reply (NULL, NULL);\n"
1288 pr " struct guestfs_%s_ret ret;\n" name;
1289 pr " ret.%s = r;\n" n;
1290 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1292 pr " struct guestfs_%s_ret ret;\n" name;
1293 pr " ret.%s = r;\n" n;
1294 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1296 failwithf "RConstString cannot be returned from a daemon function"
1298 pr " struct guestfs_%s_ret ret;\n" name;
1299 pr " ret.%s = r;\n" n;
1300 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1303 pr " struct guestfs_%s_ret ret;\n" name;
1304 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1305 pr " ret.%s.%s_val = r;\n" n n;
1306 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1307 pr " free_strings (r);\n"
1309 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1310 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
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;
1315 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1317 pr " struct guestfs_%s_ret ret;\n" name;
1318 pr " ret.%s = *r;\n" n;
1319 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1320 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
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;
1325 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1331 (* Dispatch function. *)
1332 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1334 pr " switch (proc_nr) {\n";
1337 fun (name, style, _, _, _, _) ->
1338 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1339 pr " %s_stub (xdr_in);\n" name;
1344 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1349 (* LVM columns and tokenization functions. *)
1350 (* XXX This generates crap code. We should rethink how we
1356 pr "static const char *lvm_%s_cols = \"%s\";\n"
1357 typ (String.concat "," (List.map fst cols));
1360 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1362 pr " char *tok, *p, *next;\n";
1366 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1369 pr " if (!str) {\n";
1370 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1373 pr " if (!*str || isspace (*str)) {\n";
1374 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1379 fun (name, coltype) ->
1380 pr " if (!tok) {\n";
1381 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1384 pr " p = strchrnul (tok, ',');\n";
1385 pr " if (*p) next = p+1; else next = NULL;\n";
1386 pr " *p = '\\0';\n";
1389 pr " r->%s = strdup (tok);\n" name;
1390 pr " if (r->%s == NULL) {\n" name;
1391 pr " perror (\"strdup\");\n";
1395 pr " for (i = j = 0; i < 32; ++j) {\n";
1396 pr " if (tok[j] == '\\0') {\n";
1397 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1399 pr " } else if (tok[j] != '-')\n";
1400 pr " r->%s[i++] = tok[j];\n" name;
1403 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1404 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1408 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1409 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1413 pr " if (tok[0] == '\\0')\n";
1414 pr " r->%s = -1;\n" name;
1415 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1416 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1420 pr " tok = next;\n";
1423 pr " if (tok != NULL) {\n";
1424 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1431 pr "guestfs_lvm_int_%s_list *\n" typ;
1432 pr "parse_command_line_%ss (void)\n" typ;
1434 pr " char *out, *err;\n";
1435 pr " char *p, *pend;\n";
1437 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1438 pr " void *newp;\n";
1440 pr " ret = malloc (sizeof *ret);\n";
1441 pr " if (!ret) {\n";
1442 pr " reply_with_perror (\"malloc\");\n";
1443 pr " return NULL;\n";
1446 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1447 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1449 pr " r = command (&out, &err,\n";
1450 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1451 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1452 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1453 pr " if (r == -1) {\n";
1454 pr " reply_with_error (\"%%s\", err);\n";
1455 pr " free (out);\n";
1456 pr " free (err);\n";
1457 pr " return NULL;\n";
1460 pr " free (err);\n";
1462 pr " /* Tokenize each line of the output. */\n";
1465 pr " while (p) {\n";
1466 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1467 pr " if (pend) {\n";
1468 pr " *pend = '\\0';\n";
1472 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1475 pr " if (!*p) { /* Empty line? Skip it. */\n";
1480 pr " /* Allocate some space to store this next entry. */\n";
1481 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1482 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1483 pr " if (newp == NULL) {\n";
1484 pr " reply_with_perror (\"realloc\");\n";
1485 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1486 pr " free (ret);\n";
1487 pr " free (out);\n";
1488 pr " return NULL;\n";
1490 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1492 pr " /* Tokenize the next entry. */\n";
1493 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1494 pr " if (r == -1) {\n";
1495 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1496 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1497 pr " free (ret);\n";
1498 pr " free (out);\n";
1499 pr " return NULL;\n";
1506 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1508 pr " free (out);\n";
1509 pr " return ret;\n";
1512 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1514 (* Generate a lot of different functions for guestfish. *)
1515 and generate_fish_cmds () =
1516 generate_header CStyle GPLv2;
1520 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1522 let all_functions_sorted =
1524 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1525 ) all_functions_sorted in
1527 pr "#include <stdio.h>\n";
1528 pr "#include <stdlib.h>\n";
1529 pr "#include <string.h>\n";
1530 pr "#include <inttypes.h>\n";
1532 pr "#include <guestfs.h>\n";
1533 pr "#include \"fish.h\"\n";
1536 (* list_commands function, which implements guestfish -h *)
1537 pr "void list_commands (void)\n";
1539 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1540 pr " list_builtin_commands ();\n";
1542 fun (name, _, _, flags, shortdesc, _) ->
1543 let name = replace_char name '_' '-' in
1544 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1546 ) all_functions_sorted;
1547 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1551 (* display_command function, which implements guestfish -h cmd *)
1552 pr "void display_command (const char *cmd)\n";
1555 fun (name, style, _, flags, shortdesc, longdesc) ->
1556 let name2 = replace_char name '_' '-' in
1558 try find_map (function FishAlias n -> Some n | _ -> None) flags
1559 with Not_found -> name in
1560 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1562 match snd style with
1566 name2 (String.concat "> <" (map_args name_of_argt args)) in
1569 if List.mem ProtocolLimitWarning flags then
1570 "\n\nBecause of the message protocol, there is a transfer limit
1571 of somewhere between 2MB and 4MB. To transfer large files you should use
1575 let describe_alias =
1576 if name <> alias then
1577 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1581 pr "strcasecmp (cmd, \"%s\") == 0" name;
1582 if name <> name2 then
1583 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1584 if name <> alias then
1585 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1587 pr " pod2text (\"%s - %s\", %S);\n"
1589 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1592 pr " display_builtin_command (cmd);\n";
1596 (* print_{pv,vg,lv}_list functions *)
1600 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1607 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1609 pr " printf (\"%s: \");\n" name;
1610 pr " for (i = 0; i < 32; ++i)\n";
1611 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1612 pr " printf (\"\\n\");\n"
1614 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1616 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1617 | name, `OptPercent ->
1618 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1619 typ name name typ name;
1620 pr " else printf (\"%s: \\n\");\n" name
1624 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1629 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1630 pr " print_%s (&%ss->val[i]);\n" typ typ;
1633 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1635 (* run_<action> actions *)
1637 fun (name, style, _, flags, _, _) ->
1638 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1640 (match fst style with
1643 | RBool _ -> pr " int r;\n"
1644 | RConstString _ -> pr " const char *r;\n"
1645 | RString _ -> pr " char *r;\n"
1646 | RStringList _ -> pr " char **r;\n"
1647 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1648 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1649 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1650 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1654 | String n -> pr " const char *%s;\n" n
1655 | OptString n -> pr " const char *%s;\n" n
1656 | Bool n -> pr " int %s;\n" n
1657 | Int n -> pr " int %s;\n" n
1660 (* Check and convert parameters. *)
1661 let argc_expected = nr_args (snd style) in
1662 pr " if (argc != %d) {\n" argc_expected;
1663 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1665 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1671 | String name -> pr " %s = argv[%d];\n" name i
1673 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1676 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1678 pr " %s = atoi (argv[%d]);\n" name i
1681 (* Call C API function. *)
1683 try find_map (function FishAction n -> Some n | _ -> None) flags
1684 with Not_found -> sprintf "guestfs_%s" name in
1686 generate_call_args ~handle:"g" style;
1689 (* Check return value for errors and display command results. *)
1690 (match fst style with
1691 | Err -> pr " return r;\n"
1693 pr " if (r == -1) return -1;\n";
1694 pr " if (r) printf (\"%%d\\n\", r);\n";
1697 pr " if (r == -1) return -1;\n";
1698 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1701 pr " if (r == NULL) return -1;\n";
1702 pr " printf (\"%%s\\n\", r);\n";
1705 pr " if (r == NULL) return -1;\n";
1706 pr " printf (\"%%s\\n\", r);\n";
1710 pr " if (r == NULL) return -1;\n";
1711 pr " print_strings (r);\n";
1712 pr " free_strings (r);\n";
1715 pr " if (r == NULL) return -1;\n";
1716 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1717 pr " r->b ? \"true\" : \"false\");\n";
1718 pr " guestfs_free_int_bool (r);\n";
1721 pr " if (r == NULL) return -1;\n";
1722 pr " print_pv_list (r);\n";
1723 pr " guestfs_free_lvm_pv_list (r);\n";
1726 pr " if (r == NULL) return -1;\n";
1727 pr " print_vg_list (r);\n";
1728 pr " guestfs_free_lvm_vg_list (r);\n";
1731 pr " if (r == NULL) return -1;\n";
1732 pr " print_lv_list (r);\n";
1733 pr " guestfs_free_lvm_lv_list (r);\n";
1740 (* run_action function *)
1741 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1744 fun (name, _, _, flags, _, _) ->
1745 let name2 = replace_char name '_' '-' in
1747 try find_map (function FishAlias n -> Some n | _ -> None) flags
1748 with Not_found -> name in
1750 pr "strcasecmp (cmd, \"%s\") == 0" name;
1751 if name <> name2 then
1752 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1753 if name <> alias then
1754 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1756 pr " return run_%s (cmd, argc, argv);\n" name;
1760 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1767 (* Generate the POD documentation for guestfish. *)
1768 and generate_fish_actions_pod () =
1769 let all_functions_sorted =
1771 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1772 ) all_functions_sorted in
1775 fun (name, style, _, flags, _, longdesc) ->
1776 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1777 let name = replace_char name '_' '-' in
1779 try find_map (function FishAlias n -> Some n | _ -> None) flags
1780 with Not_found -> name in
1782 pr "=head2 %s" name;
1783 if name <> alias then
1790 | String n -> pr " %s" n
1791 | OptString n -> pr " %s" n
1792 | Bool _ -> pr " true|false"
1793 | Int n -> pr " %s" n
1797 pr "%s\n\n" longdesc
1798 ) all_functions_sorted
1800 (* Generate a C function prototype. *)
1801 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1802 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1804 ?handle name style =
1805 if extern then pr "extern ";
1806 if static then pr "static ";
1807 (match fst style with
1809 | RInt _ -> pr "int "
1810 | RBool _ -> pr "int "
1811 | RConstString _ -> pr "const char *"
1812 | RString _ -> pr "char *"
1813 | RStringList _ -> pr "char **"
1815 if not in_daemon then pr "struct guestfs_int_bool *"
1816 else pr "guestfs_%s_ret *" name
1818 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1819 else pr "guestfs_lvm_int_pv_list *"
1821 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1822 else pr "guestfs_lvm_int_vg_list *"
1824 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1825 else pr "guestfs_lvm_int_lv_list *"
1827 pr "%s%s (" prefix name;
1828 if handle = None && nr_args (snd style) = 0 then
1831 let comma = ref false in
1834 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1838 if single_line then pr ", " else pr ",\n\t\t"
1844 | String n -> next (); pr "const char *%s" n
1845 | OptString n -> next (); pr "const char *%s" n
1846 | Bool n -> next (); pr "int %s" n
1847 | Int n -> next (); pr "int %s" n
1851 if semicolon then pr ";";
1852 if newline then pr "\n"
1854 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1855 and generate_call_args ?handle style =
1857 let comma = ref false in
1860 | Some handle -> pr "%s" handle; comma := true
1864 if !comma then pr ", ";
1867 | String n -> pr "%s" n
1868 | OptString n -> pr "%s" n
1869 | Bool n -> pr "%s" n
1870 | Int n -> pr "%s" n
1874 (* Generate the OCaml bindings interface. *)
1875 and generate_ocaml_mli () =
1876 generate_header OCamlStyle LGPLv2;
1879 (** For API documentation you should refer to the C API
1880 in the guestfs(3) manual page. The OCaml API uses almost
1881 exactly the same calls. *)
1884 (** A [guestfs_h] handle. *)
1886 exception Error of string
1887 (** This exception is raised when there is an error. *)
1889 val create : unit -> t
1891 val close : t -> unit
1892 (** Handles are closed by the garbage collector when they become
1893 unreferenced, but callers can also call this in order to
1894 provide predictable cleanup. *)
1897 generate_ocaml_lvm_structure_decls ();
1901 fun (name, style, _, _, shortdesc, _) ->
1902 generate_ocaml_prototype name style;
1903 pr "(** %s *)\n" shortdesc;
1907 (* Generate the OCaml bindings implementation. *)
1908 and generate_ocaml_ml () =
1909 generate_header OCamlStyle LGPLv2;
1913 exception Error of string
1914 external create : unit -> t = \"ocaml_guestfs_create\"
1915 external close : t -> unit = \"ocaml_guestfs_close\"
1918 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1922 generate_ocaml_lvm_structure_decls ();
1926 fun (name, style, _, _, shortdesc, _) ->
1927 generate_ocaml_prototype ~is_external:true name style;
1930 (* Generate the OCaml bindings C implementation. *)
1931 and generate_ocaml_c () =
1932 generate_header CStyle LGPLv2;
1934 pr "#include <stdio.h>\n";
1935 pr "#include <stdlib.h>\n";
1936 pr "#include <string.h>\n";
1938 pr "#include <caml/config.h>\n";
1939 pr "#include <caml/alloc.h>\n";
1940 pr "#include <caml/callback.h>\n";
1941 pr "#include <caml/fail.h>\n";
1942 pr "#include <caml/memory.h>\n";
1943 pr "#include <caml/mlvalues.h>\n";
1944 pr "#include <caml/signals.h>\n";
1946 pr "#include <guestfs.h>\n";
1948 pr "#include \"guestfs_c.h\"\n";
1951 (* LVM struct copy functions. *)
1954 let has_optpercent_col =
1955 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1957 pr "static CAMLprim value\n";
1958 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1960 pr " CAMLparam0 ();\n";
1961 if has_optpercent_col then
1962 pr " CAMLlocal3 (rv, v, v2);\n"
1964 pr " CAMLlocal2 (rv, v);\n";
1966 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1971 pr " v = caml_copy_string (%s->%s);\n" typ name
1973 pr " v = caml_alloc_string (32);\n";
1974 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
1977 pr " v = caml_copy_int64 (%s->%s);\n" typ name
1978 | name, `OptPercent ->
1979 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
1980 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
1981 pr " v = caml_alloc (1, 0);\n";
1982 pr " Store_field (v, 0, v2);\n";
1983 pr " } else /* None */\n";
1984 pr " v = Val_int (0);\n";
1986 pr " Store_field (rv, %d, v);\n" i
1988 pr " CAMLreturn (rv);\n";
1992 pr "static CAMLprim value\n";
1993 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
1996 pr " CAMLparam0 ();\n";
1997 pr " CAMLlocal2 (rv, v);\n";
2000 pr " if (%ss->len == 0)\n" typ;
2001 pr " CAMLreturn (Atom (0));\n";
2003 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
2004 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
2005 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
2006 pr " caml_modify (&Field (rv, i), v);\n";
2008 pr " CAMLreturn (rv);\n";
2012 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2015 fun (name, style, _, _, _, _) ->
2016 pr "CAMLprim value\n";
2017 pr "ocaml_guestfs_%s (value gv" name;
2019 fun arg -> pr ", value %sv" (name_of_argt arg)
2023 pr " CAMLparam%d (gv" (1 + (nr_args (snd style)));
2025 fun arg -> pr ", %sv" (name_of_argt arg)
2028 pr " CAMLlocal1 (rv);\n";
2031 pr " guestfs_h *g = Guestfs_val (gv);\n";
2032 pr " if (g == NULL)\n";
2033 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2039 pr " const char *%s = String_val (%sv);\n" n n
2041 pr " const char *%s =\n" n;
2042 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2045 pr " int %s = Bool_val (%sv);\n" n n
2047 pr " int %s = Int_val (%sv);\n" n n
2050 match fst style with
2051 | Err -> pr " int r;\n"; "-1"
2052 | RInt _ -> pr " int r;\n"; "-1"
2053 | RBool _ -> pr " int r;\n"; "-1"
2054 | RConstString _ -> pr " const char *r;\n"; "NULL"
2055 | RString _ -> pr " char *r;\n"; "NULL"
2061 pr " struct guestfs_int_bool *r;\n";
2064 pr " struct guestfs_lvm_pv_list *r;\n";
2067 pr " struct guestfs_lvm_vg_list *r;\n";
2070 pr " struct guestfs_lvm_lv_list *r;\n";
2074 pr " caml_enter_blocking_section ();\n";
2075 pr " r = guestfs_%s " name;
2076 generate_call_args ~handle:"g" style;
2078 pr " caml_leave_blocking_section ();\n";
2079 pr " if (r == %s)\n" error_code;
2080 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2083 (match fst style with
2084 | Err -> pr " rv = Val_unit;\n"
2085 | RInt _ -> pr " rv = Val_int (r);\n"
2086 | RBool _ -> pr " rv = Val_bool (r);\n"
2087 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2089 pr " rv = caml_copy_string (r);\n";
2092 pr " rv = caml_copy_string_array ((const char **) r);\n";
2093 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2096 pr " rv = caml_alloc (2, 0);\n";
2097 pr " Store_field (rv, 0, Val_int (r->i));\n";
2098 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2099 pr " guestfs_free_int_bool (r);\n";
2101 pr " rv = copy_lvm_pv_list (r);\n";
2102 pr " guestfs_free_lvm_pv_list (r);\n";
2104 pr " rv = copy_lvm_vg_list (r);\n";
2105 pr " guestfs_free_lvm_vg_list (r);\n";
2107 pr " rv = copy_lvm_lv_list (r);\n";
2108 pr " guestfs_free_lvm_lv_list (r);\n";
2111 pr " CAMLreturn (rv);\n";
2116 and generate_ocaml_lvm_structure_decls () =
2119 pr "type lvm_%s = {\n" typ;
2122 | name, `String -> pr " %s : string;\n" name
2123 | name, `UUID -> pr " %s : string;\n" name
2124 | name, `Bytes -> pr " %s : int64;\n" name
2125 | name, `Int -> pr " %s : int64;\n" name
2126 | name, `OptPercent -> pr " %s : float option;\n" name
2130 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2132 and generate_ocaml_prototype ?(is_external = false) name style =
2133 if is_external then pr "external " else pr "val ";
2134 pr "%s : t -> " name;
2137 | String _ -> pr "string -> "
2138 | OptString _ -> pr "string option -> "
2139 | Bool _ -> pr "bool -> "
2140 | Int _ -> pr "int -> "
2142 (match fst style with
2143 | Err -> pr "unit" (* all errors are turned into exceptions *)
2144 | RInt _ -> pr "int"
2145 | RBool _ -> pr "bool"
2146 | RConstString _ -> pr "string"
2147 | RString _ -> pr "string"
2148 | RStringList _ -> pr "string array"
2149 | RIntBool _ -> pr "int * bool"
2150 | RPVList _ -> pr "lvm_pv array"
2151 | RVGList _ -> pr "lvm_vg array"
2152 | RLVList _ -> pr "lvm_lv array"
2154 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2157 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2158 and generate_perl_xs () =
2159 generate_header CStyle LGPLv2;
2162 #include \"EXTERN.h\"
2166 #include <guestfs.h>
2169 #define PRId64 \"lld\"
2173 my_newSVll(long long val) {
2174 #ifdef USE_64_BIT_ALL
2175 return newSViv(val);
2179 len = snprintf(buf, 100, \"%%\" PRId64, val);
2180 return newSVpv(buf, len);
2185 #define PRIu64 \"llu\"
2189 my_newSVull(unsigned long long val) {
2190 #ifdef USE_64_BIT_ALL
2191 return newSVuv(val);
2195 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2196 return newSVpv(buf, len);
2200 /* XXX Not thread-safe, and in general not safe if the caller is
2201 * issuing multiple requests in parallel (on different guestfs
2202 * handles). We should use the guestfs_h handle passed to the
2203 * error handle to distinguish these cases.
2205 static char *last_error = NULL;
2208 error_handler (guestfs_h *g,
2212 if (last_error != NULL) free (last_error);
2213 last_error = strdup (msg);
2216 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2221 RETVAL = guestfs_create ();
2223 croak (\"could not create guestfs handle\");
2224 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2237 fun (name, style, _, _, _, _) ->
2238 (match fst style with
2239 | Err -> pr "void\n"
2240 | RInt _ -> pr "SV *\n"
2241 | RBool _ -> pr "SV *\n"
2242 | RConstString _ -> pr "SV *\n"
2243 | RString _ -> pr "SV *\n"
2246 | RPVList _ | RVGList _ | RLVList _ ->
2247 pr "void\n" (* all lists returned implictly on the stack *)
2249 (* Call and arguments. *)
2251 generate_call_args ~handle:"g" style;
2253 pr " guestfs_h *g;\n";
2256 | String n -> pr " char *%s;\n" n
2257 | OptString n -> pr " char *%s;\n" n
2258 | Bool n -> pr " int %s;\n" n
2259 | Int n -> pr " int %s;\n" n
2262 (match fst style with
2265 pr " if (guestfs_%s " name;
2266 generate_call_args ~handle:"g" style;
2268 pr " croak (\"%s: %%s\", last_error);\n" name
2274 pr " %s = guestfs_%s " n name;
2275 generate_call_args ~handle:"g" style;
2277 pr " if (%s == -1)\n" n;
2278 pr " croak (\"%s: %%s\", last_error);\n" name;
2279 pr " RETVAL = newSViv (%s);\n" n;
2284 pr " const char *%s;\n" n;
2286 pr " %s = guestfs_%s " n name;
2287 generate_call_args ~handle:"g" style;
2289 pr " if (%s == NULL)\n" n;
2290 pr " croak (\"%s: %%s\", last_error);\n" name;
2291 pr " RETVAL = newSVpv (%s, 0);\n" n;
2296 pr " char *%s;\n" n;
2298 pr " %s = guestfs_%s " n name;
2299 generate_call_args ~handle:"g" style;
2301 pr " if (%s == NULL)\n" n;
2302 pr " croak (\"%s: %%s\", last_error);\n" name;
2303 pr " RETVAL = newSVpv (%s, 0);\n" n;
2304 pr " free (%s);\n" n;
2309 pr " char **%s;\n" n;
2312 pr " %s = guestfs_%s " n name;
2313 generate_call_args ~handle:"g" style;
2315 pr " if (%s == NULL)\n" n;
2316 pr " croak (\"%s: %%s\", last_error);\n" name;
2317 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2318 pr " EXTEND (SP, n);\n";
2319 pr " for (i = 0; i < n; ++i) {\n";
2320 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2321 pr " free (%s[i]);\n" n;
2323 pr " free (%s);\n" n;
2326 pr " struct guestfs_int_bool *r;\n";
2328 pr " r = guestfs_%s " name;
2329 generate_call_args ~handle:"g" style;
2331 pr " if (r == NULL)\n";
2332 pr " croak (\"%s: %%s\", last_error);\n" name;
2333 pr " EXTEND (SP, 2);\n";
2334 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2335 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2336 pr " guestfs_free_int_bool (r);\n";
2338 generate_perl_lvm_code "pv" pv_cols name style n;
2340 generate_perl_lvm_code "vg" vg_cols name style n;
2342 generate_perl_lvm_code "lv" lv_cols name style n;
2347 and generate_perl_lvm_code typ cols name style n =
2349 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2353 pr " %s = guestfs_%s " n name;
2354 generate_call_args ~handle:"g" style;
2356 pr " if (%s == NULL)\n" n;
2357 pr " croak (\"%s: %%s\", last_error);\n" name;
2358 pr " EXTEND (SP, %s->len);\n" n;
2359 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2360 pr " hv = newHV ();\n";
2364 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2365 name (String.length name) n name
2367 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2368 name (String.length name) n name
2370 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2371 name (String.length name) n name
2373 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2374 name (String.length name) n name
2375 | name, `OptPercent ->
2376 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2377 name (String.length name) n name
2379 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2381 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2383 (* Generate Sys/Guestfs.pm. *)
2384 and generate_perl_pm () =
2385 generate_header HashStyle LGPLv2;
2392 Sys::Guestfs - Perl bindings for libguestfs
2398 my $h = Sys::Guestfs->new ();
2399 $h->add_drive ('guest.img');
2402 $h->mount ('/dev/sda1', '/');
2403 $h->touch ('/hello');
2408 The C<Sys::Guestfs> module provides a Perl XS binding to the
2409 libguestfs API for examining and modifying virtual machine
2412 Amongst the things this is good for: making batch configuration
2413 changes to guests, getting disk used/free statistics (see also:
2414 virt-df), migrating between virtualization systems (see also:
2415 virt-p2v), performing partial backups, performing partial guest
2416 clones, cloning guests and changing registry/UUID/hostname info, and
2419 Libguestfs uses Linux kernel and qemu code, and can access any type of
2420 guest filesystem that Linux and qemu can, including but not limited
2421 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2422 schemes, qcow, qcow2, vmdk.
2424 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2425 LVs, what filesystem is in each LV, etc.). It can also run commands
2426 in the context of the guest. Also you can access filesystems over FTP.
2430 All errors turn into calls to C<croak> (see L<Carp(3)>).
2438 package Sys::Guestfs;
2444 XSLoader::load ('Sys::Guestfs');
2446 =item $h = Sys::Guestfs->new ();
2448 Create a new guestfs handle.
2454 my $class = ref ($proto) || $proto;
2456 my $self = Sys::Guestfs::_create ();
2457 bless $self, $class;
2463 (* Actions. We only need to print documentation for these as
2464 * they are pulled in from the XS code automatically.
2467 fun (name, style, _, flags, _, longdesc) ->
2468 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2470 generate_perl_prototype name style;
2472 pr "%s\n\n" longdesc;
2473 if List.mem ProtocolLimitWarning flags then
2474 pr "Because of the message protocol, there is a transfer limit
2475 of somewhere between 2MB and 4MB. To transfer large files you should use
2477 ) all_functions_sorted;
2489 Copyright (C) 2009 Red Hat Inc.
2493 Please see the file COPYING.LIB for the full license.
2497 L<guestfs(3)>, L<guestfish(1)>.
2502 and generate_perl_prototype name style =
2503 (match fst style with
2508 | RString n -> pr "$%s = " n
2509 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2513 | RLVList n -> pr "@%s = " n
2516 let comma = ref false in
2519 if !comma then pr ", ";
2521 pr "%s" (name_of_argt arg)
2525 let output_to filename =
2526 let filename_new = filename ^ ".new" in
2527 chan := open_out filename_new;
2531 Unix.rename filename_new filename;
2532 printf "written %s\n%!" filename;
2540 let close = output_to "src/guestfs_protocol.x" in
2544 let close = output_to "src/guestfs-structs.h" in
2545 generate_structs_h ();
2548 let close = output_to "src/guestfs-actions.h" in
2549 generate_actions_h ();
2552 let close = output_to "src/guestfs-actions.c" in
2553 generate_client_actions ();
2556 let close = output_to "daemon/actions.h" in
2557 generate_daemon_actions_h ();
2560 let close = output_to "daemon/stubs.c" in
2561 generate_daemon_actions ();
2564 let close = output_to "fish/cmds.c" in
2565 generate_fish_cmds ();
2568 let close = output_to "guestfs-structs.pod" in
2569 generate_structs_pod ();
2572 let close = output_to "guestfs-actions.pod" in
2573 generate_actions_pod ();
2576 let close = output_to "guestfish-actions.pod" in
2577 generate_fish_actions_pod ();
2580 let close = output_to "ocaml/guestfs.mli" in
2581 generate_ocaml_mli ();
2584 let close = output_to "ocaml/guestfs.ml" in
2585 generate_ocaml_ml ();
2588 let close = output_to "ocaml/guestfs_c_actions.c" in
2589 generate_ocaml_c ();
2592 let close = output_to "perl/Guestfs.xs" in
2593 generate_perl_xs ();
2596 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2597 generate_perl_pm ();