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.");
487 let all_functions = non_daemon_functions @ daemon_functions
489 (* In some places we want the functions to be displayed sorted
490 * alphabetically, so this is useful:
492 let all_functions_sorted =
493 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
495 (* Column names and types from LVM PVs/VGs/LVs. *)
504 "pv_attr", `String (* XXX *);
506 "pv_pe_alloc_count", `Int;
509 "pv_mda_count", `Int;
510 "pv_mda_free", `Bytes;
512 "pv_mda_size", `Bytes;
519 "vg_attr", `String (* XXX *);
523 "vg_extent_size", `Bytes;
524 "vg_extent_count", `Int;
525 "vg_free_count", `Int;
533 "vg_mda_count", `Int;
534 "vg_mda_free", `Bytes;
536 "vg_mda_size", `Bytes;
542 "lv_attr", `String (* XXX *);
545 "lv_kernel_major", `Int;
546 "lv_kernel_minor", `Int;
550 "snap_percent", `OptPercent;
551 "copy_percent", `OptPercent;
554 "mirror_log", `String;
559 * Note we don't want to use any external OCaml libraries which
560 * makes this a bit harder than it should be.
562 let failwithf fs = ksprintf failwith fs
564 let replace_char s c1 c2 =
565 let s2 = String.copy s in
567 for i = 0 to String.length s2 - 1 do
568 if String.unsafe_get s2 i = c1 then (
569 String.unsafe_set s2 i c2;
573 if not !r then s else s2
576 let len = String.length s in
577 let sublen = String.length sub in
579 if i <= len-sublen then (
582 if s.[i+j] = sub.[j] then loop2 (j+1)
588 if r = -1 then loop (i+1) else r
594 let rec replace_str s s1 s2 =
595 let len = String.length s in
596 let sublen = String.length s1 in
600 let s' = String.sub s 0 i in
601 let s'' = String.sub s (i+sublen) (len-i-sublen) in
602 s' ^ s2 ^ replace_str s'' s1 s2
605 let rec find_map f = function
606 | [] -> raise Not_found
610 | None -> find_map f xs
613 let rec loop i = function
615 | x :: xs -> f i x; loop (i+1) xs
619 (* 'pr' prints to the current output file. *)
620 let chan = ref stdout
621 let pr fs = ksprintf (output_string !chan) fs
623 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
625 (* Check function names etc. for consistency. *)
626 let check_functions () =
628 fun (name, _, _, _, _, longdesc) ->
629 if String.contains name '-' then
630 failwithf "function name '%s' should not contain '-', use '_' instead."
632 if longdesc.[String.length longdesc-1] = '\n' then
633 failwithf "long description of %s should not end with \\n." name
637 fun (name, _, proc_nr, _, _, _) ->
639 failwithf "daemon function %s should have proc_nr > 0" name
643 fun (name, _, proc_nr, _, _, _) ->
644 if proc_nr <> -1 then
645 failwithf "non-daemon function %s should have proc_nr -1" name
646 ) non_daemon_functions;
649 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
652 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
653 let rec loop = function
656 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
658 | (name1,nr1) :: (name2,nr2) :: _ ->
659 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
664 type comment_style = CStyle | HashStyle | OCamlStyle
665 type license = GPLv2 | LGPLv2
667 (* Generate a header block in a number of standard styles. *)
668 let rec generate_header comment license =
669 let c = match comment with
670 | CStyle -> pr "/* "; " *"
671 | HashStyle -> pr "# "; "#"
672 | OCamlStyle -> pr "(* "; " *" in
673 pr "libguestfs generated file\n";
674 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
675 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
677 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
681 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
682 pr "%s it under the terms of the GNU General Public License as published by\n" c;
683 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
684 pr "%s (at your option) any later version.\n" c;
686 pr "%s This program is distributed in the hope that it will be useful,\n" c;
687 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
688 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
689 pr "%s GNU General Public License for more details.\n" c;
691 pr "%s You should have received a copy of the GNU General Public License along\n" c;
692 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
693 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
696 pr "%s This library is free software; you can redistribute it and/or\n" c;
697 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
698 pr "%s License as published by the Free Software Foundation; either\n" c;
699 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
701 pr "%s This library is distributed in the hope that it will be useful,\n" c;
702 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
703 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
704 pr "%s Lesser General Public License for more details.\n" c;
706 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
707 pr "%s License along with this library; if not, write to the Free Software\n" c;
708 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
711 | CStyle -> pr " */\n"
713 | OCamlStyle -> pr " *)\n"
717 (* Generate the pod documentation for the C API. *)
718 and generate_actions_pod () =
720 fun (shortname, style, _, flags, _, longdesc) ->
721 let name = "guestfs_" ^ shortname in
722 pr "=head2 %s\n\n" name;
724 generate_prototype ~extern:false ~handle:"handle" name style;
726 pr "%s\n\n" longdesc;
727 (match fst style with
729 pr "This function returns 0 on success or -1 on error.\n\n"
731 pr "On error this function returns -1.\n\n"
733 pr "This function returns a C truth value on success or -1 on error.\n\n"
735 pr "This function returns a string or NULL on error.
736 The string is owned by the guest handle and must I<not> be freed.\n\n"
738 pr "This function returns a string or NULL on error.
739 I<The caller must free the returned string after use>.\n\n"
741 pr "This function returns a NULL-terminated array of strings
742 (like L<environ(3)>), or NULL if there was an error.
743 I<The caller must free the strings and the array after use>.\n\n"
745 pr "This function returns a C<struct guestfs_int_bool *>.
746 I<The caller must call C<guestfs_free_int_bool> after use.>.\n\n"
748 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
749 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
751 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
752 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
754 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
755 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
757 if List.mem ProtocolLimitWarning flags then
758 pr "Because of the message protocol, there is a transfer limit
759 of somewhere between 2MB and 4MB. To transfer large files you should use
761 ) all_functions_sorted
763 and generate_structs_pod () =
764 (* LVM structs documentation. *)
767 pr "=head2 guestfs_lvm_%s\n" typ;
769 pr " struct guestfs_lvm_%s {\n" typ;
772 | name, `String -> pr " char *%s;\n" name
774 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
775 pr " char %s[32];\n" name
776 | name, `Bytes -> pr " uint64_t %s;\n" name
777 | name, `Int -> pr " int64_t %s;\n" name
778 | name, `OptPercent ->
779 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
780 pr " float %s;\n" name
783 pr " struct guestfs_lvm_%s_list {\n" typ;
784 pr " uint32_t len; /* Number of elements in list. */\n";
785 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
788 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
791 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
793 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
794 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
795 * have to use an underscore instead of a dash because otherwise
796 * rpcgen generates incorrect code.
798 * This header is NOT exported to clients, but see also generate_structs_h.
800 and generate_xdr () =
801 generate_header CStyle LGPLv2;
803 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
804 pr "typedef string str<>;\n";
807 (* LVM internal structures. *)
811 pr "struct guestfs_lvm_int_%s {\n" typ;
813 | name, `String -> pr " string %s<>;\n" name
814 | name, `UUID -> pr " opaque %s[32];\n" name
815 | name, `Bytes -> pr " hyper %s;\n" name
816 | name, `Int -> pr " hyper %s;\n" name
817 | name, `OptPercent -> pr " float %s;\n" name
821 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
823 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
826 fun(shortname, style, _, _, _, _) ->
827 let name = "guestfs_" ^ shortname in
829 (match snd style with
832 pr "struct %s_args {\n" name;
835 | String n -> pr " string %s<>;\n" n
836 | OptString n -> pr " str *%s;\n" n
837 | Bool n -> pr " bool %s;\n" n
838 | Int n -> pr " int %s;\n" n
842 (match fst style with
845 pr "struct %s_ret {\n" name;
849 pr "struct %s_ret {\n" name;
853 failwithf "RConstString cannot be returned from a daemon function"
855 pr "struct %s_ret {\n" name;
856 pr " string %s<>;\n" n;
859 pr "struct %s_ret {\n" name;
863 pr "struct %s_ret {\n" name;
868 pr "struct %s_ret {\n" name;
869 pr " guestfs_lvm_int_pv_list %s;\n" n;
872 pr "struct %s_ret {\n" name;
873 pr " guestfs_lvm_int_vg_list %s;\n" n;
876 pr "struct %s_ret {\n" name;
877 pr " guestfs_lvm_int_lv_list %s;\n" n;
882 (* Table of procedure numbers. *)
883 pr "enum guestfs_procedure {\n";
885 fun (shortname, _, proc_nr, _, _, _) ->
886 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
888 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
892 (* Having to choose a maximum message size is annoying for several
893 * reasons (it limits what we can do in the API), but it (a) makes
894 * the protocol a lot simpler, and (b) provides a bound on the size
895 * of the daemon which operates in limited memory space. For large
896 * file transfers you should use FTP.
898 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
901 (* Message header, etc. *)
903 const GUESTFS_PROGRAM = 0x2000F5F5;
904 const GUESTFS_PROTOCOL_VERSION = 1;
906 enum guestfs_message_direction {
907 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
908 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
911 enum guestfs_message_status {
912 GUESTFS_STATUS_OK = 0,
913 GUESTFS_STATUS_ERROR = 1
916 const GUESTFS_ERROR_LEN = 256;
918 struct guestfs_message_error {
919 string error<GUESTFS_ERROR_LEN>; /* error message */
922 struct guestfs_message_header {
923 unsigned prog; /* GUESTFS_PROGRAM */
924 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
925 guestfs_procedure proc; /* GUESTFS_PROC_x */
926 guestfs_message_direction direction;
927 unsigned serial; /* message serial number */
928 guestfs_message_status status;
932 (* Generate the guestfs-structs.h file. *)
933 and generate_structs_h () =
934 generate_header CStyle LGPLv2;
936 (* This is a public exported header file containing various
937 * structures. The structures are carefully written to have
938 * exactly the same in-memory format as the XDR structures that
939 * we use on the wire to the daemon. The reason for creating
940 * copies of these structures here is just so we don't have to
941 * export the whole of guestfs_protocol.h (which includes much
942 * unrelated and XDR-dependent stuff that we don't want to be
943 * public, or required by clients).
945 * To reiterate, we will pass these structures to and from the
946 * client with a simple assignment or memcpy, so the format
947 * must be identical to what rpcgen / the RFC defines.
950 (* guestfs_int_bool structure. *)
951 pr "struct guestfs_int_bool {\n";
957 (* LVM public structures. *)
961 pr "struct guestfs_lvm_%s {\n" typ;
964 | name, `String -> pr " char *%s;\n" name
965 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
966 | name, `Bytes -> pr " uint64_t %s;\n" name
967 | name, `Int -> pr " int64_t %s;\n" name
968 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
972 pr "struct guestfs_lvm_%s_list {\n" typ;
973 pr " uint32_t len;\n";
974 pr " struct guestfs_lvm_%s *val;\n" typ;
977 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
979 (* Generate the guestfs-actions.h file. *)
980 and generate_actions_h () =
981 generate_header CStyle LGPLv2;
983 fun (shortname, style, _, _, _, _) ->
984 let name = "guestfs_" ^ shortname in
985 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
989 (* Generate the client-side dispatch stubs. *)
990 and generate_client_actions () =
991 generate_header CStyle LGPLv2;
993 (* Client-side stubs for each function. *)
995 fun (shortname, style, _, _, _, _) ->
996 let name = "guestfs_" ^ shortname in
998 (* Generate the return value struct. *)
999 pr "struct %s_rv {\n" shortname;
1000 pr " int cb_done; /* flag to indicate callback was called */\n";
1001 pr " struct guestfs_message_header hdr;\n";
1002 pr " struct guestfs_message_error err;\n";
1003 (match fst style with
1006 failwithf "RConstString cannot be returned from a daemon function"
1008 | RBool _ | RString _ | RStringList _
1010 | RPVList _ | RVGList _ | RLVList _ ->
1011 pr " struct %s_ret ret;\n" name
1015 (* Generate the callback function. *)
1016 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1018 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1020 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1021 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1024 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1025 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1026 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1032 (match fst style with
1035 failwithf "RConstString cannot be returned from a daemon function"
1037 | RBool _ | RString _ | RStringList _
1039 | RPVList _ | RVGList _ | RLVList _ ->
1040 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1041 pr " error (g, \"%s: failed to parse reply\");\n" name;
1047 pr " rv->cb_done = 1;\n";
1048 pr " main_loop.main_loop_quit (g);\n";
1051 (* Generate the action stub. *)
1052 generate_prototype ~extern:false ~semicolon:false ~newline:true
1053 ~handle:"g" name style;
1056 match fst style with
1057 | Err | RInt _ | RBool _ -> "-1"
1059 failwithf "RConstString cannot be returned from a daemon function"
1060 | RString _ | RStringList _ | RIntBool _
1061 | RPVList _ | RVGList _ | RLVList _ ->
1066 (match snd style with
1068 | _ -> pr " struct %s_args args;\n" name
1071 pr " struct %s_rv rv;\n" shortname;
1072 pr " int serial;\n";
1074 pr " if (g->state != READY) {\n";
1075 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1078 pr " return %s;\n" error_code;
1081 pr " memset (&rv, 0, sizeof rv);\n";
1084 (match snd style with
1086 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1087 (String.uppercase shortname)
1092 pr " args.%s = (char *) %s;\n" n n
1094 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1096 pr " args.%s = %s;\n" n n
1098 pr " args.%s = %s;\n" n n
1100 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1101 (String.uppercase shortname);
1102 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1105 pr " if (serial == -1)\n";
1106 pr " return %s;\n" error_code;
1109 pr " rv.cb_done = 0;\n";
1110 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1111 pr " g->reply_cb_internal_data = &rv;\n";
1112 pr " main_loop.main_loop_run (g);\n";
1113 pr " g->reply_cb_internal = NULL;\n";
1114 pr " g->reply_cb_internal_data = NULL;\n";
1115 pr " if (!rv.cb_done) {\n";
1116 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1117 pr " return %s;\n" error_code;
1121 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1122 (String.uppercase shortname);
1123 pr " return %s;\n" error_code;
1126 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1127 pr " error (g, \"%%s\", rv.err.error);\n";
1128 pr " return %s;\n" error_code;
1132 (match fst style with
1133 | Err -> pr " return 0;\n"
1135 | RBool n -> pr " return rv.ret.%s;\n" n
1137 failwithf "RConstString cannot be returned from a daemon function"
1139 pr " return rv.ret.%s; /* caller will free */\n" n
1141 pr " /* caller will free this, but we need to add a NULL entry */\n";
1142 pr " rv.ret.%s.%s_val =" n n;
1143 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1144 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1146 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1147 pr " return rv.ret.%s.%s_val;\n" n n
1149 pr " /* caller with free this */\n";
1150 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1152 pr " /* caller will free this */\n";
1153 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1155 pr " /* caller will free this */\n";
1156 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1158 pr " /* caller will free this */\n";
1159 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1165 (* Generate daemon/actions.h. *)
1166 and generate_daemon_actions_h () =
1167 generate_header CStyle GPLv2;
1169 pr "#include \"../src/guestfs_protocol.h\"\n";
1173 fun (name, style, _, _, _, _) ->
1175 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1179 (* Generate the server-side stubs. *)
1180 and generate_daemon_actions () =
1181 generate_header CStyle GPLv2;
1183 pr "#define _GNU_SOURCE // for strchrnul\n";
1185 pr "#include <stdio.h>\n";
1186 pr "#include <stdlib.h>\n";
1187 pr "#include <string.h>\n";
1188 pr "#include <inttypes.h>\n";
1189 pr "#include <ctype.h>\n";
1190 pr "#include <rpc/types.h>\n";
1191 pr "#include <rpc/xdr.h>\n";
1193 pr "#include \"daemon.h\"\n";
1194 pr "#include \"../src/guestfs_protocol.h\"\n";
1195 pr "#include \"actions.h\"\n";
1199 fun (name, style, _, _, _, _) ->
1200 (* Generate server-side stubs. *)
1201 pr "static void %s_stub (XDR *xdr_in)\n" name;
1204 match fst style with
1205 | Err | RInt _ -> pr " int r;\n"; "-1"
1206 | RBool _ -> pr " int r;\n"; "-1"
1208 failwithf "RConstString cannot be returned from a daemon function"
1209 | RString _ -> pr " char *r;\n"; "NULL"
1210 | RStringList _ -> pr " char **r;\n"; "NULL"
1211 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1212 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1213 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1214 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1216 (match snd style with
1219 pr " struct guestfs_%s_args args;\n" name;
1223 | OptString n -> pr " const char *%s;\n" n
1224 | Bool n -> pr " int %s;\n" n
1225 | Int n -> pr " int %s;\n" n
1230 (match snd style with
1233 pr " memset (&args, 0, sizeof args);\n";
1235 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1236 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1241 | String n -> pr " %s = args.%s;\n" n n
1242 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1243 | Bool n -> pr " %s = args.%s;\n" n n
1244 | Int n -> pr " %s = args.%s;\n" n n
1249 pr " r = do_%s " name;
1250 generate_call_args style;
1253 pr " if (r == %s)\n" error_code;
1254 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1258 (match fst style with
1259 | Err -> pr " reply (NULL, NULL);\n"
1261 pr " struct guestfs_%s_ret ret;\n" name;
1262 pr " ret.%s = r;\n" n;
1263 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1265 pr " struct guestfs_%s_ret ret;\n" name;
1266 pr " ret.%s = r;\n" n;
1267 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1269 failwithf "RConstString cannot be returned from a daemon function"
1271 pr " struct guestfs_%s_ret ret;\n" name;
1272 pr " ret.%s = r;\n" n;
1273 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1276 pr " struct guestfs_%s_ret ret;\n" name;
1277 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1278 pr " ret.%s.%s_val = r;\n" n n;
1279 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1280 pr " free_strings (r);\n"
1282 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1283 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1285 pr " struct guestfs_%s_ret ret;\n" name;
1286 pr " ret.%s = *r;\n" n;
1287 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1288 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1290 pr " struct guestfs_%s_ret ret;\n" name;
1291 pr " ret.%s = *r;\n" n;
1292 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1293 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1295 pr " struct guestfs_%s_ret ret;\n" name;
1296 pr " ret.%s = *r;\n" n;
1297 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1298 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1304 (* Dispatch function. *)
1305 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1307 pr " switch (proc_nr) {\n";
1310 fun (name, style, _, _, _, _) ->
1311 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1312 pr " %s_stub (xdr_in);\n" name;
1317 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1322 (* LVM columns and tokenization functions. *)
1323 (* XXX This generates crap code. We should rethink how we
1329 pr "static const char *lvm_%s_cols = \"%s\";\n"
1330 typ (String.concat "," (List.map fst cols));
1333 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1335 pr " char *tok, *p, *next;\n";
1339 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1342 pr " if (!str) {\n";
1343 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1346 pr " if (!*str || isspace (*str)) {\n";
1347 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1352 fun (name, coltype) ->
1353 pr " if (!tok) {\n";
1354 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1357 pr " p = strchrnul (tok, ',');\n";
1358 pr " if (*p) next = p+1; else next = NULL;\n";
1359 pr " *p = '\\0';\n";
1362 pr " r->%s = strdup (tok);\n" name;
1363 pr " if (r->%s == NULL) {\n" name;
1364 pr " perror (\"strdup\");\n";
1368 pr " for (i = j = 0; i < 32; ++j) {\n";
1369 pr " if (tok[j] == '\\0') {\n";
1370 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1372 pr " } else if (tok[j] != '-')\n";
1373 pr " r->%s[i++] = tok[j];\n" name;
1376 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1377 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1381 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1382 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1386 pr " if (tok[0] == '\\0')\n";
1387 pr " r->%s = -1;\n" name;
1388 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1389 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1393 pr " tok = next;\n";
1396 pr " if (tok != NULL) {\n";
1397 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1404 pr "guestfs_lvm_int_%s_list *\n" typ;
1405 pr "parse_command_line_%ss (void)\n" typ;
1407 pr " char *out, *err;\n";
1408 pr " char *p, *pend;\n";
1410 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1411 pr " void *newp;\n";
1413 pr " ret = malloc (sizeof *ret);\n";
1414 pr " if (!ret) {\n";
1415 pr " reply_with_perror (\"malloc\");\n";
1416 pr " return NULL;\n";
1419 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1420 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1422 pr " r = command (&out, &err,\n";
1423 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1424 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1425 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1426 pr " if (r == -1) {\n";
1427 pr " reply_with_error (\"%%s\", err);\n";
1428 pr " free (out);\n";
1429 pr " free (err);\n";
1430 pr " return NULL;\n";
1433 pr " free (err);\n";
1435 pr " /* Tokenize each line of the output. */\n";
1438 pr " while (p) {\n";
1439 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1440 pr " if (pend) {\n";
1441 pr " *pend = '\\0';\n";
1445 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1448 pr " if (!*p) { /* Empty line? Skip it. */\n";
1453 pr " /* Allocate some space to store this next entry. */\n";
1454 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1455 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1456 pr " if (newp == NULL) {\n";
1457 pr " reply_with_perror (\"realloc\");\n";
1458 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1459 pr " free (ret);\n";
1460 pr " free (out);\n";
1461 pr " return NULL;\n";
1463 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1465 pr " /* Tokenize the next entry. */\n";
1466 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1467 pr " if (r == -1) {\n";
1468 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1469 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1470 pr " free (ret);\n";
1471 pr " free (out);\n";
1472 pr " return NULL;\n";
1479 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1481 pr " free (out);\n";
1482 pr " return ret;\n";
1485 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1487 (* Generate a lot of different functions for guestfish. *)
1488 and generate_fish_cmds () =
1489 generate_header CStyle GPLv2;
1493 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1495 let all_functions_sorted =
1497 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1498 ) all_functions_sorted in
1500 pr "#include <stdio.h>\n";
1501 pr "#include <stdlib.h>\n";
1502 pr "#include <string.h>\n";
1503 pr "#include <inttypes.h>\n";
1505 pr "#include <guestfs.h>\n";
1506 pr "#include \"fish.h\"\n";
1509 (* list_commands function, which implements guestfish -h *)
1510 pr "void list_commands (void)\n";
1512 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1513 pr " list_builtin_commands ();\n";
1515 fun (name, _, _, flags, shortdesc, _) ->
1516 let name = replace_char name '_' '-' in
1517 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1519 ) all_functions_sorted;
1520 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1524 (* display_command function, which implements guestfish -h cmd *)
1525 pr "void display_command (const char *cmd)\n";
1528 fun (name, style, _, flags, shortdesc, longdesc) ->
1529 let name2 = replace_char name '_' '-' in
1531 try find_map (function FishAlias n -> Some n | _ -> None) flags
1532 with Not_found -> name in
1533 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1535 match snd style with
1539 name2 (String.concat "> <" (List.map name_of_argt args)) in
1542 if List.mem ProtocolLimitWarning flags then
1543 "\n\nBecause of the message protocol, there is a transfer limit
1544 of somewhere between 2MB and 4MB. To transfer large files you should use
1548 let describe_alias =
1549 if name <> alias then
1550 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1554 pr "strcasecmp (cmd, \"%s\") == 0" name;
1555 if name <> name2 then
1556 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1557 if name <> alias then
1558 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1560 pr " pod2text (\"%s - %s\", %S);\n"
1562 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1565 pr " display_builtin_command (cmd);\n";
1569 (* print_{pv,vg,lv}_list functions *)
1573 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1580 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1582 pr " printf (\"%s: \");\n" name;
1583 pr " for (i = 0; i < 32; ++i)\n";
1584 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1585 pr " printf (\"\\n\");\n"
1587 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1589 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1590 | name, `OptPercent ->
1591 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1592 typ name name typ name;
1593 pr " else printf (\"%s: \\n\");\n" name
1597 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1602 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1603 pr " print_%s (&%ss->val[i]);\n" typ typ;
1606 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1608 (* run_<action> actions *)
1610 fun (name, style, _, flags, _, _) ->
1611 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1613 (match fst style with
1616 | RBool _ -> pr " int r;\n"
1617 | RConstString _ -> pr " const char *r;\n"
1618 | RString _ -> pr " char *r;\n"
1619 | RStringList _ -> pr " char **r;\n"
1620 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1621 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1622 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1623 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1627 | String n -> pr " const char *%s;\n" n
1628 | OptString n -> pr " const char *%s;\n" n
1629 | Bool n -> pr " int %s;\n" n
1630 | Int n -> pr " int %s;\n" n
1633 (* Check and convert parameters. *)
1634 let argc_expected = List.length (snd style) in
1635 pr " if (argc != %d) {\n" argc_expected;
1636 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1638 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1644 | String name -> pr " %s = argv[%d];\n" name i
1646 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1649 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1651 pr " %s = atoi (argv[%d]);\n" name i
1654 (* Call C API function. *)
1656 try find_map (function FishAction n -> Some n | _ -> None) flags
1657 with Not_found -> sprintf "guestfs_%s" name in
1659 generate_call_args ~handle:"g" style;
1662 (* Check return value for errors and display command results. *)
1663 (match fst style with
1664 | Err -> pr " return r;\n"
1666 pr " if (r == -1) return -1;\n";
1667 pr " if (r) printf (\"%%d\\n\", r);\n";
1670 pr " if (r == -1) return -1;\n";
1671 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1674 pr " if (r == NULL) return -1;\n";
1675 pr " printf (\"%%s\\n\", r);\n";
1678 pr " if (r == NULL) return -1;\n";
1679 pr " printf (\"%%s\\n\", r);\n";
1683 pr " if (r == NULL) return -1;\n";
1684 pr " print_strings (r);\n";
1685 pr " free_strings (r);\n";
1688 pr " if (r == NULL) return -1;\n";
1689 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1690 pr " r->b ? \"true\" : \"false\");\n";
1691 pr " guestfs_free_int_bool (r);\n";
1694 pr " if (r == NULL) return -1;\n";
1695 pr " print_pv_list (r);\n";
1696 pr " guestfs_free_lvm_pv_list (r);\n";
1699 pr " if (r == NULL) return -1;\n";
1700 pr " print_vg_list (r);\n";
1701 pr " guestfs_free_lvm_vg_list (r);\n";
1704 pr " if (r == NULL) return -1;\n";
1705 pr " print_lv_list (r);\n";
1706 pr " guestfs_free_lvm_lv_list (r);\n";
1713 (* run_action function *)
1714 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1717 fun (name, _, _, flags, _, _) ->
1718 let name2 = replace_char name '_' '-' in
1720 try find_map (function FishAlias n -> Some n | _ -> None) flags
1721 with Not_found -> name in
1723 pr "strcasecmp (cmd, \"%s\") == 0" name;
1724 if name <> name2 then
1725 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1726 if name <> alias then
1727 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1729 pr " return run_%s (cmd, argc, argv);\n" name;
1733 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1740 (* Generate the POD documentation for guestfish. *)
1741 and generate_fish_actions_pod () =
1742 let all_functions_sorted =
1744 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1745 ) all_functions_sorted in
1748 fun (name, style, _, flags, _, longdesc) ->
1749 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1750 let name = replace_char name '_' '-' in
1752 try find_map (function FishAlias n -> Some n | _ -> None) flags
1753 with Not_found -> name in
1755 pr "=head2 %s" name;
1756 if name <> alias then
1763 | String n -> pr " %s" n
1764 | OptString n -> pr " %s" n
1765 | Bool _ -> pr " true|false"
1766 | Int n -> pr " %s" n
1770 pr "%s\n\n" longdesc
1771 ) all_functions_sorted
1773 (* Generate a C function prototype. *)
1774 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1775 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1777 ?handle name style =
1778 if extern then pr "extern ";
1779 if static then pr "static ";
1780 (match fst style with
1782 | RInt _ -> pr "int "
1783 | RBool _ -> pr "int "
1784 | RConstString _ -> pr "const char *"
1785 | RString _ -> pr "char *"
1786 | RStringList _ -> pr "char **"
1788 if not in_daemon then pr "struct guestfs_int_bool *"
1789 else pr "guestfs_%s_ret *" name
1791 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1792 else pr "guestfs_lvm_int_pv_list *"
1794 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1795 else pr "guestfs_lvm_int_vg_list *"
1797 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1798 else pr "guestfs_lvm_int_lv_list *"
1800 pr "%s%s (" prefix name;
1801 if handle = None && List.length (snd style) = 0 then
1804 let comma = ref false in
1807 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1811 if single_line then pr ", " else pr ",\n\t\t"
1817 | String n -> next (); pr "const char *%s" n
1818 | OptString n -> next (); pr "const char *%s" n
1819 | Bool n -> next (); pr "int %s" n
1820 | Int n -> next (); pr "int %s" n
1824 if semicolon then pr ";";
1825 if newline then pr "\n"
1827 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1828 and generate_call_args ?handle style =
1830 let comma = ref false in
1833 | Some handle -> pr "%s" handle; comma := true
1837 if !comma then pr ", ";
1840 | String n -> pr "%s" n
1841 | OptString n -> pr "%s" n
1842 | Bool n -> pr "%s" n
1843 | Int n -> pr "%s" n
1847 (* Generate the OCaml bindings interface. *)
1848 and generate_ocaml_mli () =
1849 generate_header OCamlStyle LGPLv2;
1852 (** For API documentation you should refer to the C API
1853 in the guestfs(3) manual page. The OCaml API uses almost
1854 exactly the same calls. *)
1857 (** A [guestfs_h] handle. *)
1859 exception Error of string
1860 (** This exception is raised when there is an error. *)
1862 val create : unit -> t
1864 val close : t -> unit
1865 (** Handles are closed by the garbage collector when they become
1866 unreferenced, but callers can also call this in order to
1867 provide predictable cleanup. *)
1870 generate_ocaml_lvm_structure_decls ();
1874 fun (name, style, _, _, shortdesc, _) ->
1875 generate_ocaml_prototype name style;
1876 pr "(** %s *)\n" shortdesc;
1880 (* Generate the OCaml bindings implementation. *)
1881 and generate_ocaml_ml () =
1882 generate_header OCamlStyle LGPLv2;
1886 exception Error of string
1887 external create : unit -> t = \"ocaml_guestfs_create\"
1888 external close : t -> unit = \"ocaml_guestfs_close\"
1891 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1895 generate_ocaml_lvm_structure_decls ();
1899 fun (name, style, _, _, shortdesc, _) ->
1900 generate_ocaml_prototype ~is_external:true name style;
1903 (* Generate the OCaml bindings C implementation. *)
1904 and generate_ocaml_c () =
1905 generate_header CStyle LGPLv2;
1907 pr "#include <stdio.h>\n";
1908 pr "#include <stdlib.h>\n";
1909 pr "#include <string.h>\n";
1911 pr "#include <caml/config.h>\n";
1912 pr "#include <caml/alloc.h>\n";
1913 pr "#include <caml/callback.h>\n";
1914 pr "#include <caml/fail.h>\n";
1915 pr "#include <caml/memory.h>\n";
1916 pr "#include <caml/mlvalues.h>\n";
1917 pr "#include <caml/signals.h>\n";
1919 pr "#include <guestfs.h>\n";
1921 pr "#include \"guestfs_c.h\"\n";
1924 (* LVM struct copy functions. *)
1927 let has_optpercent_col =
1928 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1930 pr "static CAMLprim value\n";
1931 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1933 pr " CAMLparam0 ();\n";
1934 if has_optpercent_col then
1935 pr " CAMLlocal3 (rv, v, v2);\n"
1937 pr " CAMLlocal2 (rv, v);\n";
1939 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1944 pr " v = caml_copy_string (%s->%s);\n" typ name
1946 pr " v = caml_alloc_string (32);\n";
1947 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
1950 pr " v = caml_copy_int64 (%s->%s);\n" typ name
1951 | name, `OptPercent ->
1952 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
1953 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
1954 pr " v = caml_alloc (1, 0);\n";
1955 pr " Store_field (v, 0, v2);\n";
1956 pr " } else /* None */\n";
1957 pr " v = Val_int (0);\n";
1959 pr " Store_field (rv, %d, v);\n" i
1961 pr " CAMLreturn (rv);\n";
1965 pr "static CAMLprim value\n";
1966 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
1969 pr " CAMLparam0 ();\n";
1970 pr " CAMLlocal2 (rv, v);\n";
1973 pr " if (%ss->len == 0)\n" typ;
1974 pr " CAMLreturn (Atom (0));\n";
1976 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
1977 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
1978 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
1979 pr " caml_modify (&Field (rv, i), v);\n";
1981 pr " CAMLreturn (rv);\n";
1985 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1988 fun (name, style, _, _, _, _) ->
1989 pr "CAMLprim value\n";
1990 pr "ocaml_guestfs_%s (value gv" name;
1992 fun arg -> pr ", value %sv" (name_of_argt arg)
1996 pr " CAMLparam%d (gv" (1 + (List.length (snd style)));
1998 fun arg -> pr ", %sv" (name_of_argt arg)
2001 pr " CAMLlocal1 (rv);\n";
2004 pr " guestfs_h *g = Guestfs_val (gv);\n";
2005 pr " if (g == NULL)\n";
2006 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2012 pr " const char *%s = String_val (%sv);\n" n n
2014 pr " const char *%s =\n" n;
2015 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2018 pr " int %s = Bool_val (%sv);\n" n n
2020 pr " int %s = Int_val (%sv);\n" n n
2023 match fst style with
2024 | Err -> pr " int r;\n"; "-1"
2025 | RInt _ -> pr " int r;\n"; "-1"
2026 | RBool _ -> pr " int r;\n"; "-1"
2027 | RConstString _ -> pr " const char *r;\n"; "NULL"
2028 | RString _ -> pr " char *r;\n"; "NULL"
2034 pr " struct guestfs_int_bool *r;\n";
2037 pr " struct guestfs_lvm_pv_list *r;\n";
2040 pr " struct guestfs_lvm_vg_list *r;\n";
2043 pr " struct guestfs_lvm_lv_list *r;\n";
2047 pr " caml_enter_blocking_section ();\n";
2048 pr " r = guestfs_%s " name;
2049 generate_call_args ~handle:"g" style;
2051 pr " caml_leave_blocking_section ();\n";
2052 pr " if (r == %s)\n" error_code;
2053 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2056 (match fst style with
2057 | Err -> pr " rv = Val_unit;\n"
2058 | RInt _ -> pr " rv = Val_int (r);\n"
2059 | RBool _ -> pr " rv = Val_bool (r);\n"
2060 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2062 pr " rv = caml_copy_string (r);\n";
2065 pr " rv = caml_copy_string_array ((const char **) r);\n";
2066 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2069 pr " rv = caml_alloc (2, 0);\n";
2070 pr " Store_field (rv, 0, Val_int (r->i));\n";
2071 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2072 pr " guestfs_free_int_bool (r);\n";
2074 pr " rv = copy_lvm_pv_list (r);\n";
2075 pr " guestfs_free_lvm_pv_list (r);\n";
2077 pr " rv = copy_lvm_vg_list (r);\n";
2078 pr " guestfs_free_lvm_vg_list (r);\n";
2080 pr " rv = copy_lvm_lv_list (r);\n";
2081 pr " guestfs_free_lvm_lv_list (r);\n";
2084 pr " CAMLreturn (rv);\n";
2089 and generate_ocaml_lvm_structure_decls () =
2092 pr "type lvm_%s = {\n" typ;
2095 | name, `String -> pr " %s : string;\n" name
2096 | name, `UUID -> pr " %s : string;\n" name
2097 | name, `Bytes -> pr " %s : int64;\n" name
2098 | name, `Int -> pr " %s : int64;\n" name
2099 | name, `OptPercent -> pr " %s : float option;\n" name
2103 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2105 and generate_ocaml_prototype ?(is_external = false) name style =
2106 if is_external then pr "external " else pr "val ";
2107 pr "%s : t -> " name;
2110 | String _ -> pr "string -> "
2111 | OptString _ -> pr "string option -> "
2112 | Bool _ -> pr "bool -> "
2113 | Int _ -> pr "int -> "
2115 (match fst style with
2116 | Err -> pr "unit" (* all errors are turned into exceptions *)
2117 | RInt _ -> pr "int"
2118 | RBool _ -> pr "bool"
2119 | RConstString _ -> pr "string"
2120 | RString _ -> pr "string"
2121 | RStringList _ -> pr "string array"
2122 | RIntBool _ -> pr "int * bool"
2123 | RPVList _ -> pr "lvm_pv array"
2124 | RVGList _ -> pr "lvm_vg array"
2125 | RLVList _ -> pr "lvm_lv array"
2127 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2130 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2131 and generate_perl_xs () =
2132 generate_header CStyle LGPLv2;
2135 #include \"EXTERN.h\"
2139 #include <guestfs.h>
2142 #define PRId64 \"lld\"
2146 my_newSVll(long long val) {
2147 #ifdef USE_64_BIT_ALL
2148 return newSViv(val);
2152 len = snprintf(buf, 100, \"%%\" PRId64, val);
2153 return newSVpv(buf, len);
2158 #define PRIu64 \"llu\"
2162 my_newSVull(unsigned long long val) {
2163 #ifdef USE_64_BIT_ALL
2164 return newSVuv(val);
2168 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2169 return newSVpv(buf, len);
2173 /* XXX Not thread-safe, and in general not safe if the caller is
2174 * issuing multiple requests in parallel (on different guestfs
2175 * handles). We should use the guestfs_h handle passed to the
2176 * error handle to distinguish these cases.
2178 static char *last_error = NULL;
2181 error_handler (guestfs_h *g,
2185 if (last_error != NULL) free (last_error);
2186 last_error = strdup (msg);
2189 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2194 RETVAL = guestfs_create ();
2196 croak (\"could not create guestfs handle\");
2197 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2210 fun (name, style, _, _, _, _) ->
2211 (match fst style with
2212 | Err -> pr "void\n"
2213 | RInt _ -> pr "SV *\n"
2214 | RBool _ -> pr "SV *\n"
2215 | RConstString _ -> pr "SV *\n"
2216 | RString _ -> pr "SV *\n"
2219 | RPVList _ | RVGList _ | RLVList _ ->
2220 pr "void\n" (* all lists returned implictly on the stack *)
2222 (* Call and arguments. *)
2224 generate_call_args ~handle:"g" style;
2226 pr " guestfs_h *g;\n";
2229 | String n -> pr " char *%s;\n" n
2230 | OptString n -> pr " char *%s;\n" n
2231 | Bool n -> pr " int %s;\n" n
2232 | Int n -> pr " int %s;\n" n
2235 (match fst style with
2238 pr " if (guestfs_%s " name;
2239 generate_call_args ~handle:"g" style;
2241 pr " croak (\"%s: %%s\", last_error);\n" name
2247 pr " %s = guestfs_%s " n name;
2248 generate_call_args ~handle:"g" style;
2250 pr " if (%s == -1)\n" n;
2251 pr " croak (\"%s: %%s\", last_error);\n" name;
2252 pr " RETVAL = newSViv (%s);\n" n;
2257 pr " const char *%s;\n" n;
2259 pr " %s = guestfs_%s " n name;
2260 generate_call_args ~handle:"g" style;
2262 pr " if (%s == NULL)\n" n;
2263 pr " croak (\"%s: %%s\", last_error);\n" name;
2264 pr " RETVAL = newSVpv (%s, 0);\n" n;
2269 pr " char *%s;\n" n;
2271 pr " %s = guestfs_%s " n name;
2272 generate_call_args ~handle:"g" style;
2274 pr " if (%s == NULL)\n" n;
2275 pr " croak (\"%s: %%s\", last_error);\n" name;
2276 pr " RETVAL = newSVpv (%s, 0);\n" n;
2277 pr " free (%s);\n" n;
2282 pr " char **%s;\n" n;
2285 pr " %s = guestfs_%s " n name;
2286 generate_call_args ~handle:"g" style;
2288 pr " if (%s == NULL)\n" n;
2289 pr " croak (\"%s: %%s\", last_error);\n" name;
2290 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2291 pr " EXTEND (SP, n);\n";
2292 pr " for (i = 0; i < n; ++i) {\n";
2293 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2294 pr " free (%s[i]);\n" n;
2296 pr " free (%s);\n" n;
2299 pr " struct guestfs_int_bool *r;\n";
2301 pr " r = guestfs_%s " name;
2302 generate_call_args ~handle:"g" style;
2304 pr " if (r == NULL)\n";
2305 pr " croak (\"%s: %%s\", last_error);\n" name;
2306 pr " EXTEND (SP, 2);\n";
2307 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2308 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2309 pr " guestfs_free_int_bool (r);\n";
2311 generate_perl_lvm_code "pv" pv_cols name style n;
2313 generate_perl_lvm_code "vg" vg_cols name style n;
2315 generate_perl_lvm_code "lv" lv_cols name style n;
2320 and generate_perl_lvm_code typ cols name style n =
2322 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2326 pr " %s = guestfs_%s " n name;
2327 generate_call_args ~handle:"g" style;
2329 pr " if (%s == NULL)\n" n;
2330 pr " croak (\"%s: %%s\", last_error);\n" name;
2331 pr " EXTEND (SP, %s->len);\n" n;
2332 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2333 pr " hv = newHV ();\n";
2337 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2338 name (String.length name) n name
2340 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2341 name (String.length name) n name
2343 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2344 name (String.length name) n name
2346 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2347 name (String.length name) n name
2348 | name, `OptPercent ->
2349 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2350 name (String.length name) n name
2352 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2354 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2356 (* Generate Sys/Guestfs.pm. *)
2357 and generate_perl_pm () =
2358 generate_header HashStyle LGPLv2;
2365 Sys::Guestfs - Perl bindings for libguestfs
2371 my $h = Sys::Guestfs->new ();
2372 $h->add_drive ('guest.img');
2375 $h->mount ('/dev/sda1', '/');
2376 $h->touch ('/hello');
2381 The C<Sys::Guestfs> module provides a Perl XS binding to the
2382 libguestfs API for examining and modifying virtual machine
2385 Amongst the things this is good for: making batch configuration
2386 changes to guests, getting disk used/free statistics (see also:
2387 virt-df), migrating between virtualization systems (see also:
2388 virt-p2v), performing partial backups, performing partial guest
2389 clones, cloning guests and changing registry/UUID/hostname info, and
2392 Libguestfs uses Linux kernel and qemu code, and can access any type of
2393 guest filesystem that Linux and qemu can, including but not limited
2394 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2395 schemes, qcow, qcow2, vmdk.
2397 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2398 LVs, what filesystem is in each LV, etc.). It can also run commands
2399 in the context of the guest. Also you can access filesystems over FTP.
2403 All errors turn into calls to C<croak> (see L<Carp(3)>).
2411 package Sys::Guestfs;
2417 XSLoader::load ('Sys::Guestfs');
2419 =item $h = Sys::Guestfs->new ();
2421 Create a new guestfs handle.
2427 my $class = ref ($proto) || $proto;
2429 my $self = Sys::Guestfs::_create ();
2430 bless $self, $class;
2436 (* Actions. We only need to print documentation for these as
2437 * they are pulled in from the XS code automatically.
2440 fun (name, style, _, flags, _, longdesc) ->
2441 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2443 generate_perl_prototype name style;
2445 pr "%s\n\n" longdesc;
2446 if List.mem ProtocolLimitWarning flags then
2447 pr "Because of the message protocol, there is a transfer limit
2448 of somewhere between 2MB and 4MB. To transfer large files you should use
2450 ) all_functions_sorted;
2462 Copyright (C) 2009 Red Hat Inc.
2466 Please see the file COPYING.LIB for the full license.
2470 L<guestfs(3)>, L<guestfish(1)>.
2475 and generate_perl_prototype name style =
2476 (match fst style with
2481 | RString n -> pr "$%s = " n
2482 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2486 | RLVList n -> pr "@%s = " n
2489 let comma = ref false in
2492 if !comma then pr ", ";
2494 pr "%s" (name_of_argt arg)
2498 let output_to filename =
2499 let filename_new = filename ^ ".new" in
2500 chan := open_out filename_new;
2504 Unix.rename filename_new filename;
2505 printf "written %s\n%!" filename;
2513 let close = output_to "src/guestfs_protocol.x" in
2517 let close = output_to "src/guestfs-structs.h" in
2518 generate_structs_h ();
2521 let close = output_to "src/guestfs-actions.h" in
2522 generate_actions_h ();
2525 let close = output_to "src/guestfs-actions.c" in
2526 generate_client_actions ();
2529 let close = output_to "daemon/actions.h" in
2530 generate_daemon_actions_h ();
2533 let close = output_to "daemon/stubs.c" in
2534 generate_daemon_actions ();
2537 let close = output_to "fish/cmds.c" in
2538 generate_fish_cmds ();
2541 let close = output_to "guestfs-structs.pod" in
2542 generate_structs_pod ();
2545 let close = output_to "guestfs-actions.pod" in
2546 generate_actions_pod ();
2549 let close = output_to "guestfish-actions.pod" in
2550 generate_fish_actions_pod ();
2553 let close = output_to "ocaml/guestfs.mli" in
2554 generate_ocaml_mli ();
2557 let close = output_to "ocaml/guestfs.ml" in
2558 generate_ocaml_ml ();
2561 let close = output_to "ocaml/guestfs_c_actions.c" in
2562 generate_ocaml_c ();
2565 let close = output_to "perl/Guestfs.xs" in
2566 generate_perl_xs ();
2569 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2570 generate_perl_pm ();