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
19 * This script generates a large amount of code and documentation for
20 * all the daemon actions. To add a new action there are only two
21 * files you need to change, this one to describe the interface, and
22 * daemon/<somefile>.c to write the implementation.
29 type style = ret * args
31 (* "Err" as a return value means an int used as a simple error
32 * indication, ie. 0 or -1.
35 (* "Int" as a return value means an int which is -1 for error
36 * or any value >= 0 on success.
39 (* "RBool" is a bool return value which can be true/false or
43 (* "RConstString" is a string that refers to a constant value.
44 * Try to avoid using this. In particular you cannot use this
45 * for values returned from the daemon, because there is no
46 * thread-safe way to return them in the C API.
48 | RConstString of string
49 (* "RString" and "RStringList" are caller-frees. *)
51 | RStringList of string
52 (* Some limited tuples are possible: *)
53 | RIntBool of string * string
54 (* LVM PVs, VGs and LVs. *)
59 (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
63 | P3 of argt * argt * argt
65 | String of string (* const char *name, cannot be NULL *)
66 | OptString of string (* const char *name, may be NULL *)
67 | Bool of string (* boolean *)
68 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
71 | ProtocolLimitWarning (* display warning about protocol size limits *)
72 | FishAlias of string (* provide an alias for this cmd in guestfish *)
73 | FishAction of string (* call this function in guestfish *)
74 | NotInFish (* do not export via guestfish *)
76 (* Note about long descriptions: When referring to another
77 * action, use the format C<guestfs_other> (ie. the full name of
78 * the C function). This will be replaced as appropriate in other
81 * Apart from that, long descriptions are just perldoc paragraphs.
84 let non_daemon_functions = [
85 ("launch", (Err, P0), -1, [FishAlias "run"; FishAction "launch"],
86 "launch the qemu subprocess",
88 Internally libguestfs is implemented by running a virtual machine
91 You should call this after configuring the handle
92 (eg. adding drives) but before performing any actions.");
94 ("wait_ready", (Err, P0), -1, [NotInFish],
95 "wait until the qemu subprocess launches",
97 Internally libguestfs is implemented by running a virtual machine
100 You should call this after C<guestfs_launch> to wait for the launch
103 ("kill_subprocess", (Err, P0), -1, [],
104 "kill the qemu subprocess",
106 This kills the qemu subprocess. You should never need to call this.");
108 ("add_drive", (Err, P1 (String "filename")), -1, [FishAlias "add"],
109 "add an image to examine or modify",
111 This function adds a virtual machine disk image C<filename> to the
112 guest. The first time you call this function, the disk appears as IDE
113 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
116 You don't necessarily need to be root when using libguestfs. However
117 you obviously do need sufficient permissions to access the filename
118 for whatever operations you want to perform (ie. read access if you
119 just want to read the image or write access if you want to modify the
122 This is equivalent to the qemu parameter C<-drive file=filename>.");
124 ("add_cdrom", (Err, P1 (String "filename")), -1, [FishAlias "cdrom"],
125 "add a CD-ROM disk image to examine",
127 This function adds a virtual CD-ROM disk image to the guest.
129 This is equivalent to the qemu parameter C<-cdrom filename>.");
131 ("config", (Err, P2 (String "qemuparam", OptString "qemuvalue")), -1, [],
132 "add qemu parameters",
134 This can be used to add arbitrary qemu command line parameters
135 of the form C<-param value>. Actually it's not quite arbitrary - we
136 prevent you from setting some parameters which would interfere with
137 parameters that we use.
139 The first character of C<param> string must be a C<-> (dash).
141 C<value> can be NULL.");
143 ("set_path", (Err, P1 (String "path")), -1, [FishAlias "path"],
144 "set the search path",
146 Set the path that libguestfs searches for kernel and initrd.img.
148 The default is C<$libdir/guestfs> unless overridden by setting
149 C<LIBGUESTFS_PATH> environment variable.
151 The string C<path> is stashed in the libguestfs handle, so the caller
152 must make sure it remains valid for the lifetime of the handle.
154 Setting C<path> to C<NULL> restores the default path.");
156 ("get_path", (RConstString "path", P0), -1, [],
157 "get the search path",
159 Return the current search path.
161 This is always non-NULL. If it wasn't set already, then this will
162 return the default path.");
164 ("set_autosync", (Err, P1 (Bool "autosync")), -1, [FishAlias "autosync"],
167 If C<autosync> is true, this enables autosync. Libguestfs will make a
168 best effort attempt to run C<guestfs_sync> when the handle is closed
169 (also if the program exits without closing handles).");
171 ("get_autosync", (RBool "autosync", P0), -1, [],
174 Get the autosync flag.");
176 ("set_verbose", (Err, P1 (Bool "verbose")), -1, [FishAlias "verbose"],
179 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
181 Verbose messages are disabled unless the environment variable
182 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
184 ("get_verbose", (RBool "verbose", P0), -1, [],
187 This returns the verbose messages flag.")
190 let daemon_functions = [
191 ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
192 "mount a guest disk at a position in the filesystem",
194 Mount a guest disk at a position in the filesystem. Block devices
195 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
196 the guest. If those block devices contain partitions, they will have
197 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
200 The rules are the same as for L<mount(2)>: A filesystem must
201 first be mounted on C</> before others can be mounted. Other
202 filesystems can only be mounted on directories which already
205 The mounted filesystem is writable, if we have sufficient permissions
206 on the underlying device.
208 The filesystem options C<sync> and C<noatime> are set with this
209 call, in order to improve reliability.");
211 ("sync", (Err, P0), 2, [],
212 "sync disks, writes are flushed through to the disk image",
214 This syncs the disk, so that any writes are flushed through to the
215 underlying disk image.
217 You should always call this if you have modified a disk image, before
218 closing the handle.");
220 ("touch", (Err, P1 (String "path")), 3, [],
221 "update file timestamps or create a new file",
223 Touch acts like the L<touch(1)> command. It can be used to
224 update the timestamps on a file, or, if the file does not exist,
225 to create a new zero-length file.");
227 ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
228 "list the contents of a file",
230 Return the contents of the file named C<path>.
232 Note that this function cannot correctly handle binary files
233 (specifically, files containing C<\\0> character which is treated
234 as end of string). For those you need to use the C<guestfs_read_file>
235 function which has a more complex interface.");
237 ("ll", (RString "listing", P1 (String "directory")), 5, [],
238 "list the files in a directory (long format)",
240 List the files in C<directory> (relative to the root directory,
241 there is no cwd) in the format of 'ls -la'.
243 This command is mostly useful for interactive sessions. It
244 is I<not> intended that you try to parse the output string.");
246 ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
247 "list the files in a directory",
249 List the files in C<directory> (relative to the root directory,
250 there is no cwd). The '.' and '..' entries are not returned, but
251 hidden files are shown.
253 This command is mostly useful for interactive sessions. Programs
254 should probably use C<guestfs_readdir> instead.");
256 ("list_devices", (RStringList "devices", P0), 7, [],
257 "list the block devices",
259 List all the block devices.
261 The full block device names are returned, eg. C</dev/sda>");
263 ("list_partitions", (RStringList "partitions", P0), 8, [],
264 "list the partitions",
266 List all the partitions detected on all block devices.
268 The full partition device names are returned, eg. C</dev/sda1>
270 This does not return logical volumes. For that you will need to
271 call C<guestfs_lvs>.");
273 ("pvs", (RStringList "physvols", P0), 9, [],
274 "list the LVM physical volumes (PVs)",
276 List all the physical volumes detected. This is the equivalent
277 of the L<pvs(8)> command.
279 This returns a list of just the device names that contain
280 PVs (eg. C</dev/sda2>).
282 See also C<guestfs_pvs_full>.");
284 ("vgs", (RStringList "volgroups", P0), 10, [],
285 "list the LVM volume groups (VGs)",
287 List all the volumes groups detected. This is the equivalent
288 of the L<vgs(8)> command.
290 This returns a list of just the volume group names that were
291 detected (eg. C<VolGroup00>).
293 See also C<guestfs_vgs_full>.");
295 ("lvs", (RStringList "logvols", P0), 11, [],
296 "list the LVM logical volumes (LVs)",
298 List all the logical volumes detected. This is the equivalent
299 of the L<lvs(8)> command.
301 This returns a list of the logical volume device names
302 (eg. C</dev/VolGroup00/LogVol00>).
304 See also C<guestfs_lvs_full>.");
306 ("pvs_full", (RPVList "physvols", P0), 12, [],
307 "list the LVM physical volumes (PVs)",
309 List all the physical volumes detected. This is the equivalent
310 of the L<pvs(8)> command. The \"full\" version includes all fields.");
312 ("vgs_full", (RVGList "volgroups", P0), 13, [],
313 "list the LVM volume groups (VGs)",
315 List all the volumes groups detected. This is the equivalent
316 of the L<vgs(8)> command. The \"full\" version includes all fields.");
318 ("lvs_full", (RLVList "logvols", P0), 14, [],
319 "list the LVM logical volumes (LVs)",
321 List all the logical volumes detected. This is the equivalent
322 of the L<lvs(8)> command. The \"full\" version includes all fields.");
324 ("read_lines", (RStringList "lines", P1 (String "path")), 15, [],
325 "read file as lines",
327 Return the contents of the file named C<path>.
329 The file contents are returned as a list of lines. Trailing
330 C<LF> and C<CRLF> character sequences are I<not> returned.
332 Note that this function cannot correctly handle binary files
333 (specifically, files containing C<\\0> character which is treated
334 as end of line). For those you need to use the C<guestfs_read_file>
335 function which has a more complex interface.");
337 ("aug_init", (Err, P2 (String "root", Int "flags")), 16, [],
338 "create a new Augeas handle",
340 Create a new Augeas handle for editing configuration files.
341 If there was any previous Augeas handle associated with this
342 guestfs session, then it is closed.
344 You must call this before using any other C<guestfs_aug_*>
347 C<root> is the filesystem root. C<root> must not be NULL,
350 The flags are the same as the flags defined in
351 E<lt>augeas.hE<gt>, the logical I<or> of the following
356 =item C<AUG_SAVE_BACKUP> = 1
358 Keep the original file with a C<.augsave> extension.
360 =item C<AUG_SAVE_NEWFILE> = 2
362 Save changes into a file with extension C<.augnew>, and
363 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
365 =item C<AUG_TYPE_CHECK> = 4
367 Typecheck lenses (can be expensive).
369 =item C<AUG_NO_STDINC> = 8
371 Do not use standard load path for modules.
373 =item C<AUG_SAVE_NOOP> = 16
375 Make save a no-op, just record what would have been changed.
377 =item C<AUG_NO_LOAD> = 32
379 Do not load the tree in C<guestfs_aug_init>.
383 To close the handle, you can call C<guestfs_aug_close>.
385 To find out more about Augeas, see L<http://augeas.net/>.");
387 ("aug_close", (Err, P0), 26, [],
388 "close the current Augeas handle",
390 Close the current Augeas handle and free up any resources
391 used by it. After calling this, you have to call
392 C<guestfs_aug_init> again before you can use any other
395 ("aug_defvar", (RInt "nrnodes", P2 (String "name", OptString "expr")), 17, [],
396 "define an Augeas variable",
398 Defines an Augeas variable C<name> whose value is the result
399 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
402 On success this returns the number of nodes in C<expr>, or
403 C<0> if C<expr> evaluates to something which is not a nodeset.");
405 ("aug_defnode", (RIntBool ("nrnodes", "created"), P3 (String "name", String "expr", String "val")), 18, [],
406 "define an Augeas node",
408 Defines a variable C<name> whose value is the result of
411 If C<expr> evaluates to an empty nodeset, a node is created,
412 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
413 C<name> will be the nodeset containing that single node.
415 On success this returns a pair containing the
416 number of nodes in the nodeset, and a boolean flag
417 if a node was created.");
419 ("aug_get", (RString "val", P1 (String "path")), 19, [],
420 "look up the value of an Augeas path",
422 Look up the value associated with C<path>. If C<path>
423 matches exactly one node, the C<value> is returned.");
425 ("aug_set", (Err, P2 (String "path", String "val")), 20, [],
426 "set Augeas path to value",
428 Set the value associated with C<path> to C<value>.");
430 ("aug_insert", (Err, P3 (String "path", String "label", Bool "before")), 21, [],
431 "insert a sibling Augeas node",
433 Create a new sibling C<label> for C<path>, inserting it into
434 the tree before or after C<path> (depending on the boolean
437 C<path> must match exactly one existing node in the tree, and
438 C<label> must be a label, ie. not contain C</>, C<*> or end
439 with a bracketed index C<[N]>.");
441 ("aug_rm", (RInt "nrnodes", P1 (String "path")), 22, [],
442 "remove an Augeas path",
444 Remove C<path> and all of its children.
446 On success this returns the number of entries which were removed.");
448 ("aug_mv", (Err, P2 (String "src", String "dest")), 23, [],
451 Move the node C<src> to C<dest>. C<src> must match exactly
452 one node. C<dest> is overwritten if it exists.");
454 ("aug_match", (RStringList "matches", P1 (String "path")), 24, [],
455 "return Augeas nodes which match path",
457 Returns a list of paths which match the path expression C<path>.
458 The returned paths are sufficiently qualified so that they match
459 exactly one node in the current tree.");
461 ("aug_save", (Err, P0), 25, [],
462 "write all pending Augeas changes to disk",
464 This writes all pending changes to disk.
466 The flags which were passed to C<guestfs_aug_init> affect exactly
467 how files are saved.");
469 ("aug_load", (Err, P0), 27, [],
470 "load files into the tree",
472 Load files into the tree.
474 See C<aug_load> in the Augeas documentation for the full gory
478 let all_functions = non_daemon_functions @ daemon_functions
480 (* In some places we want the functions to be displayed sorted
481 * alphabetically, so this is useful:
483 let all_functions_sorted =
484 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
486 (* Column names and types from LVM PVs/VGs/LVs. *)
495 "pv_attr", `String (* XXX *);
497 "pv_pe_alloc_count", `Int;
500 "pv_mda_count", `Int;
501 "pv_mda_free", `Bytes;
503 "pv_mda_size", `Bytes;
510 "vg_attr", `String (* XXX *);
514 "vg_extent_size", `Bytes;
515 "vg_extent_count", `Int;
516 "vg_free_count", `Int;
524 "vg_mda_count", `Int;
525 "vg_mda_free", `Bytes;
527 "vg_mda_size", `Bytes;
533 "lv_attr", `String (* XXX *);
536 "lv_kernel_major", `Int;
537 "lv_kernel_minor", `Int;
541 "snap_percent", `OptPercent;
542 "copy_percent", `OptPercent;
545 "mirror_log", `String;
550 * Note we don't want to use any external OCaml libraries which
551 * makes this a bit harder than it should be.
553 let failwithf fs = ksprintf failwith fs
555 let replace_char s c1 c2 =
556 let s2 = String.copy s in
558 for i = 0 to String.length s2 - 1 do
559 if String.unsafe_get s2 i = c1 then (
560 String.unsafe_set s2 i c2;
564 if not !r then s else s2
567 let len = String.length s in
568 let sublen = String.length sub in
570 if i <= len-sublen then (
573 if s.[i+j] = sub.[j] then loop2 (j+1)
579 if r = -1 then loop (i+1) else r
585 let rec replace_str s s1 s2 =
586 let len = String.length s in
587 let sublen = String.length s1 in
591 let s' = String.sub s 0 i in
592 let s'' = String.sub s (i+sublen) (len-i-sublen) in
593 s' ^ s2 ^ replace_str s'' s1 s2
596 let rec find_map f = function
597 | [] -> raise Not_found
601 | None -> find_map f xs
604 let rec loop i = function
606 | x :: xs -> f i x; loop (i+1) xs
610 (* 'pr' prints to the current output file. *)
611 let chan = ref stdout
612 let pr fs = ksprintf (output_string !chan) fs
614 let iter_args f = function
617 | P2 (arg1, arg2) -> f arg1; f arg2
618 | P3 (arg1, arg2, arg3) -> f arg1; f arg2; f arg3
620 let iteri_args f = function
622 | P1 arg1 -> f 0 arg1
623 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
624 | P3 (arg1, arg2, arg3) -> f 0 arg1; f 1 arg2; f 2 arg3
626 let map_args f = function
628 | P1 arg1 -> [f arg1]
630 let n1 = f arg1 in let n2 = f arg2 in [n1; n2]
631 | P3 (arg1, arg2, arg3) ->
632 let n1 = f arg1 in let n2 = f arg2 in let n3 = f arg3 in [n1; n2; n3]
634 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2 | P3 _ -> 3
636 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
638 (* Check function names etc. for consistency. *)
639 let check_functions () =
641 fun (name, _, _, _, _, longdesc) ->
642 if String.contains name '-' then
643 failwithf "function name '%s' should not contain '-', use '_' instead."
645 if longdesc.[String.length longdesc-1] = '\n' then
646 failwithf "long description of %s should not end with \\n." name
650 fun (name, _, proc_nr, _, _, _) ->
652 failwithf "daemon function %s should have proc_nr > 0" name
656 fun (name, _, proc_nr, _, _, _) ->
657 if proc_nr <> -1 then
658 failwithf "non-daemon function %s should have proc_nr -1" name
659 ) non_daemon_functions;
662 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
665 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
666 let rec loop = function
669 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
671 | (name1,nr1) :: (name2,nr2) :: _ ->
672 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
677 type comment_style = CStyle | HashStyle | OCamlStyle
678 type license = GPLv2 | LGPLv2
680 (* Generate a header block in a number of standard styles. *)
681 let rec generate_header comment license =
682 let c = match comment with
683 | CStyle -> pr "/* "; " *"
684 | HashStyle -> pr "# "; "#"
685 | OCamlStyle -> pr "(* "; " *" in
686 pr "libguestfs generated file\n";
687 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
688 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
690 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
694 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
695 pr "%s it under the terms of the GNU General Public License as published by\n" c;
696 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
697 pr "%s (at your option) any later version.\n" c;
699 pr "%s This program is distributed in the hope that it will be useful,\n" c;
700 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
701 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
702 pr "%s GNU General Public License for more details.\n" c;
704 pr "%s You should have received a copy of the GNU General Public License along\n" c;
705 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
706 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
709 pr "%s This library is free software; you can redistribute it and/or\n" c;
710 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
711 pr "%s License as published by the Free Software Foundation; either\n" c;
712 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
714 pr "%s This library is distributed in the hope that it will be useful,\n" c;
715 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
716 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
717 pr "%s Lesser General Public License for more details.\n" c;
719 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
720 pr "%s License along with this library; if not, write to the Free Software\n" c;
721 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
724 | CStyle -> pr " */\n"
726 | OCamlStyle -> pr " *)\n"
730 (* Generate the pod documentation for the C API. *)
731 and generate_actions_pod () =
733 fun (shortname, style, _, flags, _, longdesc) ->
734 let name = "guestfs_" ^ shortname in
735 pr "=head2 %s\n\n" name;
737 generate_prototype ~extern:false ~handle:"handle" name style;
739 pr "%s\n\n" longdesc;
740 (match fst style with
742 pr "This function returns 0 on success or -1 on error.\n\n"
744 pr "On error this function returns -1.\n\n"
746 pr "This function returns a C truth value on success or -1 on error.\n\n"
748 pr "This function returns a string or NULL on error.
749 The string is owned by the guest handle and must I<not> be freed.\n\n"
751 pr "This function returns a string or NULL on error.
752 I<The caller must free the returned string after use>.\n\n"
754 pr "This function returns a NULL-terminated array of strings
755 (like L<environ(3)>), or NULL if there was an error.
756 I<The caller must free the strings and the array after use>.\n\n"
758 pr "This function returns a C<struct guestfs_int_bool *>.
759 I<The caller must call C<guestfs_free_int_bool> after use.>.\n\n"
761 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
762 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
764 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
765 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
767 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
768 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
770 if List.mem ProtocolLimitWarning flags then
771 pr "Because of the message protocol, there is a transfer limit
772 of somewhere between 2MB and 4MB. To transfer large files you should use
774 ) all_functions_sorted
776 and generate_structs_pod () =
777 (* LVM structs documentation. *)
780 pr "=head2 guestfs_lvm_%s\n" typ;
782 pr " struct guestfs_lvm_%s {\n" typ;
785 | name, `String -> pr " char *%s;\n" name
787 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
788 pr " char %s[32];\n" name
789 | name, `Bytes -> pr " uint64_t %s;\n" name
790 | name, `Int -> pr " int64_t %s;\n" name
791 | name, `OptPercent ->
792 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
793 pr " float %s;\n" name
796 pr " struct guestfs_lvm_%s_list {\n" typ;
797 pr " uint32_t len; /* Number of elements in list. */\n";
798 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
801 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
804 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
806 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
807 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
808 * have to use an underscore instead of a dash because otherwise
809 * rpcgen generates incorrect code.
811 * This header is NOT exported to clients, but see also generate_structs_h.
813 and generate_xdr () =
814 generate_header CStyle LGPLv2;
816 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
817 pr "typedef string str<>;\n";
820 (* LVM internal structures. *)
824 pr "struct guestfs_lvm_int_%s {\n" typ;
826 | name, `String -> pr " string %s<>;\n" name
827 | name, `UUID -> pr " opaque %s[32];\n" name
828 | name, `Bytes -> pr " hyper %s;\n" name
829 | name, `Int -> pr " hyper %s;\n" name
830 | name, `OptPercent -> pr " float %s;\n" name
834 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
836 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
839 fun(shortname, style, _, _, _, _) ->
840 let name = "guestfs_" ^ shortname in
842 (match snd style with
845 pr "struct %s_args {\n" name;
848 | String n -> pr " string %s<>;\n" n
849 | OptString n -> pr " str *%s;\n" n
850 | Bool n -> pr " bool %s;\n" n
851 | Int n -> pr " int %s;\n" n
855 (match fst style with
858 pr "struct %s_ret {\n" name;
862 pr "struct %s_ret {\n" name;
866 failwithf "RConstString cannot be returned from a daemon function"
868 pr "struct %s_ret {\n" name;
869 pr " string %s<>;\n" n;
872 pr "struct %s_ret {\n" name;
876 pr "struct %s_ret {\n" name;
881 pr "struct %s_ret {\n" name;
882 pr " guestfs_lvm_int_pv_list %s;\n" n;
885 pr "struct %s_ret {\n" name;
886 pr " guestfs_lvm_int_vg_list %s;\n" n;
889 pr "struct %s_ret {\n" name;
890 pr " guestfs_lvm_int_lv_list %s;\n" n;
895 (* Table of procedure numbers. *)
896 pr "enum guestfs_procedure {\n";
898 fun (shortname, _, proc_nr, _, _, _) ->
899 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
901 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
905 (* Having to choose a maximum message size is annoying for several
906 * reasons (it limits what we can do in the API), but it (a) makes
907 * the protocol a lot simpler, and (b) provides a bound on the size
908 * of the daemon which operates in limited memory space. For large
909 * file transfers you should use FTP.
911 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
914 (* Message header, etc. *)
916 const GUESTFS_PROGRAM = 0x2000F5F5;
917 const GUESTFS_PROTOCOL_VERSION = 1;
919 enum guestfs_message_direction {
920 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
921 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
924 enum guestfs_message_status {
925 GUESTFS_STATUS_OK = 0,
926 GUESTFS_STATUS_ERROR = 1
929 const GUESTFS_ERROR_LEN = 256;
931 struct guestfs_message_error {
932 string error<GUESTFS_ERROR_LEN>; /* error message */
935 struct guestfs_message_header {
936 unsigned prog; /* GUESTFS_PROGRAM */
937 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
938 guestfs_procedure proc; /* GUESTFS_PROC_x */
939 guestfs_message_direction direction;
940 unsigned serial; /* message serial number */
941 guestfs_message_status status;
945 (* Generate the guestfs-structs.h file. *)
946 and generate_structs_h () =
947 generate_header CStyle LGPLv2;
949 (* This is a public exported header file containing various
950 * structures. The structures are carefully written to have
951 * exactly the same in-memory format as the XDR structures that
952 * we use on the wire to the daemon. The reason for creating
953 * copies of these structures here is just so we don't have to
954 * export the whole of guestfs_protocol.h (which includes much
955 * unrelated and XDR-dependent stuff that we don't want to be
956 * public, or required by clients).
958 * To reiterate, we will pass these structures to and from the
959 * client with a simple assignment or memcpy, so the format
960 * must be identical to what rpcgen / the RFC defines.
963 (* guestfs_int_bool structure. *)
964 pr "struct guestfs_int_bool {\n";
970 (* LVM public structures. *)
974 pr "struct guestfs_lvm_%s {\n" typ;
977 | name, `String -> pr " char *%s;\n" name
978 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
979 | name, `Bytes -> pr " uint64_t %s;\n" name
980 | name, `Int -> pr " int64_t %s;\n" name
981 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
985 pr "struct guestfs_lvm_%s_list {\n" typ;
986 pr " uint32_t len;\n";
987 pr " struct guestfs_lvm_%s *val;\n" typ;
990 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
992 (* Generate the guestfs-actions.h file. *)
993 and generate_actions_h () =
994 generate_header CStyle LGPLv2;
996 fun (shortname, style, _, _, _, _) ->
997 let name = "guestfs_" ^ shortname in
998 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1002 (* Generate the client-side dispatch stubs. *)
1003 and generate_client_actions () =
1004 generate_header CStyle LGPLv2;
1006 (* Client-side stubs for each function. *)
1008 fun (shortname, style, _, _, _, _) ->
1009 let name = "guestfs_" ^ shortname in
1011 (* Generate the return value struct. *)
1012 pr "struct %s_rv {\n" shortname;
1013 pr " int cb_done; /* flag to indicate callback was called */\n";
1014 pr " struct guestfs_message_header hdr;\n";
1015 pr " struct guestfs_message_error err;\n";
1016 (match fst style with
1019 failwithf "RConstString cannot be returned from a daemon function"
1021 | RBool _ | RString _ | RStringList _
1023 | RPVList _ | RVGList _ | RLVList _ ->
1024 pr " struct %s_ret ret;\n" name
1028 (* Generate the callback function. *)
1029 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1031 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1033 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1034 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1037 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1038 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1039 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1045 (match fst style with
1048 failwithf "RConstString cannot be returned from a daemon function"
1050 | RBool _ | RString _ | RStringList _
1052 | RPVList _ | RVGList _ | RLVList _ ->
1053 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1054 pr " error (g, \"%s: failed to parse reply\");\n" name;
1060 pr " rv->cb_done = 1;\n";
1061 pr " main_loop.main_loop_quit (g);\n";
1064 (* Generate the action stub. *)
1065 generate_prototype ~extern:false ~semicolon:false ~newline:true
1066 ~handle:"g" name style;
1069 match fst style with
1070 | Err | RInt _ | RBool _ -> "-1"
1072 failwithf "RConstString cannot be returned from a daemon function"
1073 | RString _ | RStringList _ | RIntBool _
1074 | RPVList _ | RVGList _ | RLVList _ ->
1079 (match snd style with
1081 | _ -> pr " struct %s_args args;\n" name
1084 pr " struct %s_rv rv;\n" shortname;
1085 pr " int serial;\n";
1087 pr " if (g->state != READY) {\n";
1088 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1091 pr " return %s;\n" error_code;
1094 pr " memset (&rv, 0, sizeof rv);\n";
1097 (match snd style with
1099 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1100 (String.uppercase shortname)
1105 pr " args.%s = (char *) %s;\n" n n
1107 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1109 pr " args.%s = %s;\n" n n
1111 pr " args.%s = %s;\n" n n
1113 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1114 (String.uppercase shortname);
1115 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1118 pr " if (serial == -1)\n";
1119 pr " return %s;\n" error_code;
1122 pr " rv.cb_done = 0;\n";
1123 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1124 pr " g->reply_cb_internal_data = &rv;\n";
1125 pr " main_loop.main_loop_run (g);\n";
1126 pr " g->reply_cb_internal = NULL;\n";
1127 pr " g->reply_cb_internal_data = NULL;\n";
1128 pr " if (!rv.cb_done) {\n";
1129 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1130 pr " return %s;\n" error_code;
1134 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1135 (String.uppercase shortname);
1136 pr " return %s;\n" error_code;
1139 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1140 pr " error (g, \"%%s\", rv.err.error);\n";
1141 pr " return %s;\n" error_code;
1145 (match fst style with
1146 | Err -> pr " return 0;\n"
1148 | RBool n -> pr " return rv.ret.%s;\n" n
1150 failwithf "RConstString cannot be returned from a daemon function"
1152 pr " return rv.ret.%s; /* caller will free */\n" n
1154 pr " /* caller will free this, but we need to add a NULL entry */\n";
1155 pr " rv.ret.%s.%s_val =" n n;
1156 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1157 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1159 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1160 pr " return rv.ret.%s.%s_val;\n" n n
1162 pr " /* caller with free this */\n";
1163 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1165 pr " /* caller will free this */\n";
1166 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1168 pr " /* caller will free this */\n";
1169 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1171 pr " /* caller will free this */\n";
1172 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1178 (* Generate daemon/actions.h. *)
1179 and generate_daemon_actions_h () =
1180 generate_header CStyle GPLv2;
1182 pr "#include \"../src/guestfs_protocol.h\"\n";
1186 fun (name, style, _, _, _, _) ->
1188 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1192 (* Generate the server-side stubs. *)
1193 and generate_daemon_actions () =
1194 generate_header CStyle GPLv2;
1196 pr "#define _GNU_SOURCE // for strchrnul\n";
1198 pr "#include <stdio.h>\n";
1199 pr "#include <stdlib.h>\n";
1200 pr "#include <string.h>\n";
1201 pr "#include <inttypes.h>\n";
1202 pr "#include <ctype.h>\n";
1203 pr "#include <rpc/types.h>\n";
1204 pr "#include <rpc/xdr.h>\n";
1206 pr "#include \"daemon.h\"\n";
1207 pr "#include \"../src/guestfs_protocol.h\"\n";
1208 pr "#include \"actions.h\"\n";
1212 fun (name, style, _, _, _, _) ->
1213 (* Generate server-side stubs. *)
1214 pr "static void %s_stub (XDR *xdr_in)\n" name;
1217 match fst style with
1218 | Err | RInt _ -> pr " int r;\n"; "-1"
1219 | RBool _ -> pr " int r;\n"; "-1"
1221 failwithf "RConstString cannot be returned from a daemon function"
1222 | RString _ -> pr " char *r;\n"; "NULL"
1223 | RStringList _ -> pr " char **r;\n"; "NULL"
1224 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1225 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1226 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1227 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1229 (match snd style with
1232 pr " struct guestfs_%s_args args;\n" name;
1236 | OptString n -> pr " const char *%s;\n" n
1237 | Bool n -> pr " int %s;\n" n
1238 | Int n -> pr " int %s;\n" n
1243 (match snd style with
1246 pr " memset (&args, 0, sizeof args);\n";
1248 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1249 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1254 | String n -> pr " %s = args.%s;\n" n n
1255 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1256 | Bool n -> pr " %s = args.%s;\n" n n
1257 | Int n -> pr " %s = args.%s;\n" n n
1262 pr " r = do_%s " name;
1263 generate_call_args style;
1266 pr " if (r == %s)\n" error_code;
1267 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1271 (match fst style with
1272 | Err -> pr " reply (NULL, NULL);\n"
1274 pr " struct guestfs_%s_ret ret;\n" name;
1275 pr " ret.%s = r;\n" n;
1276 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1278 pr " struct guestfs_%s_ret ret;\n" name;
1279 pr " ret.%s = r;\n" n;
1280 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1282 failwithf "RConstString cannot be returned from a daemon function"
1284 pr " struct guestfs_%s_ret ret;\n" name;
1285 pr " ret.%s = r;\n" n;
1286 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1289 pr " struct guestfs_%s_ret ret;\n" name;
1290 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1291 pr " ret.%s.%s_val = r;\n" n n;
1292 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1293 pr " free_strings (r);\n"
1295 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1296 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
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;
1301 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1303 pr " struct guestfs_%s_ret ret;\n" name;
1304 pr " ret.%s = *r;\n" n;
1305 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1306 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1308 pr " struct guestfs_%s_ret ret;\n" name;
1309 pr " ret.%s = *r;\n" n;
1310 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1311 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1317 (* Dispatch function. *)
1318 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1320 pr " switch (proc_nr) {\n";
1323 fun (name, style, _, _, _, _) ->
1324 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1325 pr " %s_stub (xdr_in);\n" name;
1330 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1335 (* LVM columns and tokenization functions. *)
1336 (* XXX This generates crap code. We should rethink how we
1342 pr "static const char *lvm_%s_cols = \"%s\";\n"
1343 typ (String.concat "," (List.map fst cols));
1346 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1348 pr " char *tok, *p, *next;\n";
1352 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1355 pr " if (!str) {\n";
1356 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1359 pr " if (!*str || isspace (*str)) {\n";
1360 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1365 fun (name, coltype) ->
1366 pr " if (!tok) {\n";
1367 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1370 pr " p = strchrnul (tok, ',');\n";
1371 pr " if (*p) next = p+1; else next = NULL;\n";
1372 pr " *p = '\\0';\n";
1375 pr " r->%s = strdup (tok);\n" name;
1376 pr " if (r->%s == NULL) {\n" name;
1377 pr " perror (\"strdup\");\n";
1381 pr " for (i = j = 0; i < 32; ++j) {\n";
1382 pr " if (tok[j] == '\\0') {\n";
1383 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1385 pr " } else if (tok[j] != '-')\n";
1386 pr " r->%s[i++] = tok[j];\n" name;
1389 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1390 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1394 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1395 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1399 pr " if (tok[0] == '\\0')\n";
1400 pr " r->%s = -1;\n" name;
1401 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1402 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1406 pr " tok = next;\n";
1409 pr " if (tok != NULL) {\n";
1410 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1417 pr "guestfs_lvm_int_%s_list *\n" typ;
1418 pr "parse_command_line_%ss (void)\n" typ;
1420 pr " char *out, *err;\n";
1421 pr " char *p, *pend;\n";
1423 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1424 pr " void *newp;\n";
1426 pr " ret = malloc (sizeof *ret);\n";
1427 pr " if (!ret) {\n";
1428 pr " reply_with_perror (\"malloc\");\n";
1429 pr " return NULL;\n";
1432 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1433 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1435 pr " r = command (&out, &err,\n";
1436 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1437 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1438 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1439 pr " if (r == -1) {\n";
1440 pr " reply_with_error (\"%%s\", err);\n";
1441 pr " free (out);\n";
1442 pr " free (err);\n";
1443 pr " return NULL;\n";
1446 pr " free (err);\n";
1448 pr " /* Tokenize each line of the output. */\n";
1451 pr " while (p) {\n";
1452 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1453 pr " if (pend) {\n";
1454 pr " *pend = '\\0';\n";
1458 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1461 pr " if (!*p) { /* Empty line? Skip it. */\n";
1466 pr " /* Allocate some space to store this next entry. */\n";
1467 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1468 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1469 pr " if (newp == NULL) {\n";
1470 pr " reply_with_perror (\"realloc\");\n";
1471 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1472 pr " free (ret);\n";
1473 pr " free (out);\n";
1474 pr " return NULL;\n";
1476 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1478 pr " /* Tokenize the next entry. */\n";
1479 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1480 pr " if (r == -1) {\n";
1481 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1482 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1483 pr " free (ret);\n";
1484 pr " free (out);\n";
1485 pr " return NULL;\n";
1492 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1494 pr " free (out);\n";
1495 pr " return ret;\n";
1498 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1500 (* Generate a lot of different functions for guestfish. *)
1501 and generate_fish_cmds () =
1502 generate_header CStyle GPLv2;
1506 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1508 let all_functions_sorted =
1510 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1511 ) all_functions_sorted in
1513 pr "#include <stdio.h>\n";
1514 pr "#include <stdlib.h>\n";
1515 pr "#include <string.h>\n";
1516 pr "#include <inttypes.h>\n";
1518 pr "#include <guestfs.h>\n";
1519 pr "#include \"fish.h\"\n";
1522 (* list_commands function, which implements guestfish -h *)
1523 pr "void list_commands (void)\n";
1525 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1526 pr " list_builtin_commands ();\n";
1528 fun (name, _, _, flags, shortdesc, _) ->
1529 let name = replace_char name '_' '-' in
1530 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1532 ) all_functions_sorted;
1533 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1537 (* display_command function, which implements guestfish -h cmd *)
1538 pr "void display_command (const char *cmd)\n";
1541 fun (name, style, _, flags, shortdesc, longdesc) ->
1542 let name2 = replace_char name '_' '-' in
1544 try find_map (function FishAlias n -> Some n | _ -> None) flags
1545 with Not_found -> name in
1546 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1548 match snd style with
1552 name2 (String.concat "> <" (map_args name_of_argt args)) in
1555 if List.mem ProtocolLimitWarning flags then
1556 "\n\nBecause of the message protocol, there is a transfer limit
1557 of somewhere between 2MB and 4MB. To transfer large files you should use
1561 let describe_alias =
1562 if name <> alias then
1563 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1567 pr "strcasecmp (cmd, \"%s\") == 0" name;
1568 if name <> name2 then
1569 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1570 if name <> alias then
1571 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1573 pr " pod2text (\"%s - %s\", %S);\n"
1575 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1578 pr " display_builtin_command (cmd);\n";
1582 (* print_{pv,vg,lv}_list functions *)
1586 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1593 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1595 pr " printf (\"%s: \");\n" name;
1596 pr " for (i = 0; i < 32; ++i)\n";
1597 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1598 pr " printf (\"\\n\");\n"
1600 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1602 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1603 | name, `OptPercent ->
1604 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1605 typ name name typ name;
1606 pr " else printf (\"%s: \\n\");\n" name
1610 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1615 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1616 pr " print_%s (&%ss->val[i]);\n" typ typ;
1619 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1621 (* run_<action> actions *)
1623 fun (name, style, _, flags, _, _) ->
1624 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1626 (match fst style with
1629 | RBool _ -> pr " int r;\n"
1630 | RConstString _ -> pr " const char *r;\n"
1631 | RString _ -> pr " char *r;\n"
1632 | RStringList _ -> pr " char **r;\n"
1633 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1634 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1635 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1636 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1640 | String n -> pr " const char *%s;\n" n
1641 | OptString n -> pr " const char *%s;\n" n
1642 | Bool n -> pr " int %s;\n" n
1643 | Int n -> pr " int %s;\n" n
1646 (* Check and convert parameters. *)
1647 let argc_expected = nr_args (snd style) in
1648 pr " if (argc != %d) {\n" argc_expected;
1649 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1651 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1657 | String name -> pr " %s = argv[%d];\n" name i
1659 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1662 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1664 pr " %s = atoi (argv[%d]);\n" name i
1667 (* Call C API function. *)
1669 try find_map (function FishAction n -> Some n | _ -> None) flags
1670 with Not_found -> sprintf "guestfs_%s" name in
1672 generate_call_args ~handle:"g" style;
1675 (* Check return value for errors and display command results. *)
1676 (match fst style with
1677 | Err -> pr " return r;\n"
1679 pr " if (r == -1) return -1;\n";
1680 pr " if (r) printf (\"%%d\\n\", r);\n";
1683 pr " if (r == -1) return -1;\n";
1684 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1687 pr " if (r == NULL) return -1;\n";
1688 pr " printf (\"%%s\\n\", r);\n";
1691 pr " if (r == NULL) return -1;\n";
1692 pr " printf (\"%%s\\n\", r);\n";
1696 pr " if (r == NULL) return -1;\n";
1697 pr " print_strings (r);\n";
1698 pr " free_strings (r);\n";
1701 pr " if (r == NULL) return -1;\n";
1702 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1703 pr " r->b ? \"true\" : \"false\");\n";
1704 pr " guestfs_free_int_bool (r);\n";
1707 pr " if (r == NULL) return -1;\n";
1708 pr " print_pv_list (r);\n";
1709 pr " guestfs_free_lvm_pv_list (r);\n";
1712 pr " if (r == NULL) return -1;\n";
1713 pr " print_vg_list (r);\n";
1714 pr " guestfs_free_lvm_vg_list (r);\n";
1717 pr " if (r == NULL) return -1;\n";
1718 pr " print_lv_list (r);\n";
1719 pr " guestfs_free_lvm_lv_list (r);\n";
1726 (* run_action function *)
1727 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1730 fun (name, _, _, flags, _, _) ->
1731 let name2 = replace_char name '_' '-' in
1733 try find_map (function FishAlias n -> Some n | _ -> None) flags
1734 with Not_found -> name in
1736 pr "strcasecmp (cmd, \"%s\") == 0" name;
1737 if name <> name2 then
1738 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1739 if name <> alias then
1740 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1742 pr " return run_%s (cmd, argc, argv);\n" name;
1746 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1753 (* Generate the POD documentation for guestfish. *)
1754 and generate_fish_actions_pod () =
1755 let all_functions_sorted =
1757 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1758 ) all_functions_sorted in
1761 fun (name, style, _, flags, _, longdesc) ->
1762 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1763 let name = replace_char name '_' '-' in
1765 try find_map (function FishAlias n -> Some n | _ -> None) flags
1766 with Not_found -> name in
1768 pr "=head2 %s" name;
1769 if name <> alias then
1776 | String n -> pr " %s" n
1777 | OptString n -> pr " %s" n
1778 | Bool _ -> pr " true|false"
1779 | Int n -> pr " %s" n
1783 pr "%s\n\n" longdesc
1784 ) all_functions_sorted
1786 (* Generate a C function prototype. *)
1787 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1788 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1790 ?handle name style =
1791 if extern then pr "extern ";
1792 if static then pr "static ";
1793 (match fst style with
1795 | RInt _ -> pr "int "
1796 | RBool _ -> pr "int "
1797 | RConstString _ -> pr "const char *"
1798 | RString _ -> pr "char *"
1799 | RStringList _ -> pr "char **"
1801 if not in_daemon then pr "struct guestfs_int_bool *"
1802 else pr "guestfs_%s_ret *" name
1804 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1805 else pr "guestfs_lvm_int_pv_list *"
1807 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1808 else pr "guestfs_lvm_int_vg_list *"
1810 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1811 else pr "guestfs_lvm_int_lv_list *"
1813 pr "%s%s (" prefix name;
1814 if handle = None && nr_args (snd style) = 0 then
1817 let comma = ref false in
1820 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1824 if single_line then pr ", " else pr ",\n\t\t"
1830 | String n -> next (); pr "const char *%s" n
1831 | OptString n -> next (); pr "const char *%s" n
1832 | Bool n -> next (); pr "int %s" n
1833 | Int n -> next (); pr "int %s" n
1837 if semicolon then pr ";";
1838 if newline then pr "\n"
1840 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1841 and generate_call_args ?handle style =
1843 let comma = ref false in
1846 | Some handle -> pr "%s" handle; comma := true
1850 if !comma then pr ", ";
1853 | String n -> pr "%s" n
1854 | OptString n -> pr "%s" n
1855 | Bool n -> pr "%s" n
1856 | Int n -> pr "%s" n
1860 (* Generate the OCaml bindings interface. *)
1861 and generate_ocaml_mli () =
1862 generate_header OCamlStyle LGPLv2;
1865 (** For API documentation you should refer to the C API
1866 in the guestfs(3) manual page. The OCaml API uses almost
1867 exactly the same calls. *)
1870 (** A [guestfs_h] handle. *)
1872 exception Error of string
1873 (** This exception is raised when there is an error. *)
1875 val create : unit -> t
1877 val close : t -> unit
1878 (** Handles are closed by the garbage collector when they become
1879 unreferenced, but callers can also call this in order to
1880 provide predictable cleanup. *)
1883 generate_ocaml_lvm_structure_decls ();
1887 fun (name, style, _, _, shortdesc, _) ->
1888 generate_ocaml_prototype name style;
1889 pr "(** %s *)\n" shortdesc;
1893 (* Generate the OCaml bindings implementation. *)
1894 and generate_ocaml_ml () =
1895 generate_header OCamlStyle LGPLv2;
1899 exception Error of string
1900 external create : unit -> t = \"ocaml_guestfs_create\"
1901 external close : t -> unit = \"ocaml_guestfs_close\"
1904 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1908 generate_ocaml_lvm_structure_decls ();
1912 fun (name, style, _, _, shortdesc, _) ->
1913 generate_ocaml_prototype ~is_external:true name style;
1916 (* Generate the OCaml bindings C implementation. *)
1917 and generate_ocaml_c () =
1918 generate_header CStyle LGPLv2;
1920 pr "#include <stdio.h>\n";
1921 pr "#include <stdlib.h>\n";
1922 pr "#include <string.h>\n";
1924 pr "#include <caml/config.h>\n";
1925 pr "#include <caml/alloc.h>\n";
1926 pr "#include <caml/callback.h>\n";
1927 pr "#include <caml/fail.h>\n";
1928 pr "#include <caml/memory.h>\n";
1929 pr "#include <caml/mlvalues.h>\n";
1930 pr "#include <caml/signals.h>\n";
1932 pr "#include <guestfs.h>\n";
1934 pr "#include \"guestfs_c.h\"\n";
1937 (* LVM struct copy functions. *)
1940 let has_optpercent_col =
1941 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1943 pr "static CAMLprim value\n";
1944 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1946 pr " CAMLparam0 ();\n";
1947 if has_optpercent_col then
1948 pr " CAMLlocal3 (rv, v, v2);\n"
1950 pr " CAMLlocal2 (rv, v);\n";
1952 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1957 pr " v = caml_copy_string (%s->%s);\n" typ name
1959 pr " v = caml_alloc_string (32);\n";
1960 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
1963 pr " v = caml_copy_int64 (%s->%s);\n" typ name
1964 | name, `OptPercent ->
1965 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
1966 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
1967 pr " v = caml_alloc (1, 0);\n";
1968 pr " Store_field (v, 0, v2);\n";
1969 pr " } else /* None */\n";
1970 pr " v = Val_int (0);\n";
1972 pr " Store_field (rv, %d, v);\n" i
1974 pr " CAMLreturn (rv);\n";
1978 pr "static CAMLprim value\n";
1979 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
1982 pr " CAMLparam0 ();\n";
1983 pr " CAMLlocal2 (rv, v);\n";
1986 pr " if (%ss->len == 0)\n" typ;
1987 pr " CAMLreturn (Atom (0));\n";
1989 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
1990 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
1991 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
1992 pr " caml_modify (&Field (rv, i), v);\n";
1994 pr " CAMLreturn (rv);\n";
1998 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2001 fun (name, style, _, _, _, _) ->
2002 pr "CAMLprim value\n";
2003 pr "ocaml_guestfs_%s (value gv" name;
2005 fun arg -> pr ", value %sv" (name_of_argt arg)
2009 pr " CAMLparam%d (gv" (1 + (nr_args (snd style)));
2011 fun arg -> pr ", %sv" (name_of_argt arg)
2014 pr " CAMLlocal1 (rv);\n";
2017 pr " guestfs_h *g = Guestfs_val (gv);\n";
2018 pr " if (g == NULL)\n";
2019 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2025 pr " const char *%s = String_val (%sv);\n" n n
2027 pr " const char *%s =\n" n;
2028 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2031 pr " int %s = Bool_val (%sv);\n" n n
2033 pr " int %s = Int_val (%sv);\n" n n
2036 match fst style with
2037 | Err -> pr " int r;\n"; "-1"
2038 | RInt _ -> pr " int r;\n"; "-1"
2039 | RBool _ -> pr " int r;\n"; "-1"
2040 | RConstString _ -> pr " const char *r;\n"; "NULL"
2041 | RString _ -> pr " char *r;\n"; "NULL"
2047 pr " struct guestfs_int_bool *r;\n";
2050 pr " struct guestfs_lvm_pv_list *r;\n";
2053 pr " struct guestfs_lvm_vg_list *r;\n";
2056 pr " struct guestfs_lvm_lv_list *r;\n";
2060 pr " caml_enter_blocking_section ();\n";
2061 pr " r = guestfs_%s " name;
2062 generate_call_args ~handle:"g" style;
2064 pr " caml_leave_blocking_section ();\n";
2065 pr " if (r == %s)\n" error_code;
2066 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2069 (match fst style with
2070 | Err -> pr " rv = Val_unit;\n"
2071 | RInt _ -> pr " rv = Val_int (r);\n"
2072 | RBool _ -> pr " rv = Val_bool (r);\n"
2073 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2075 pr " rv = caml_copy_string (r);\n";
2078 pr " rv = caml_copy_string_array ((const char **) r);\n";
2079 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2082 pr " rv = caml_alloc (2, 0);\n";
2083 pr " Store_field (rv, 0, Val_int (r->i));\n";
2084 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2085 pr " guestfs_free_int_bool (r);\n";
2087 pr " rv = copy_lvm_pv_list (r);\n";
2088 pr " guestfs_free_lvm_pv_list (r);\n";
2090 pr " rv = copy_lvm_vg_list (r);\n";
2091 pr " guestfs_free_lvm_vg_list (r);\n";
2093 pr " rv = copy_lvm_lv_list (r);\n";
2094 pr " guestfs_free_lvm_lv_list (r);\n";
2097 pr " CAMLreturn (rv);\n";
2102 and generate_ocaml_lvm_structure_decls () =
2105 pr "type lvm_%s = {\n" typ;
2108 | name, `String -> pr " %s : string;\n" name
2109 | name, `UUID -> pr " %s : string;\n" name
2110 | name, `Bytes -> pr " %s : int64;\n" name
2111 | name, `Int -> pr " %s : int64;\n" name
2112 | name, `OptPercent -> pr " %s : float option;\n" name
2116 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2118 and generate_ocaml_prototype ?(is_external = false) name style =
2119 if is_external then pr "external " else pr "val ";
2120 pr "%s : t -> " name;
2123 | String _ -> pr "string -> "
2124 | OptString _ -> pr "string option -> "
2125 | Bool _ -> pr "bool -> "
2126 | Int _ -> pr "int -> "
2128 (match fst style with
2129 | Err -> pr "unit" (* all errors are turned into exceptions *)
2130 | RInt _ -> pr "int"
2131 | RBool _ -> pr "bool"
2132 | RConstString _ -> pr "string"
2133 | RString _ -> pr "string"
2134 | RStringList _ -> pr "string array"
2135 | RIntBool _ -> pr "int * bool"
2136 | RPVList _ -> pr "lvm_pv array"
2137 | RVGList _ -> pr "lvm_vg array"
2138 | RLVList _ -> pr "lvm_lv array"
2140 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2143 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2144 and generate_perl_xs () =
2145 generate_header CStyle LGPLv2;
2148 #include \"EXTERN.h\"
2152 #include <guestfs.h>
2155 #define PRId64 \"lld\"
2159 my_newSVll(long long val) {
2160 #ifdef USE_64_BIT_ALL
2161 return newSViv(val);
2165 len = snprintf(buf, 100, \"%%\" PRId64, val);
2166 return newSVpv(buf, len);
2171 #define PRIu64 \"llu\"
2175 my_newSVull(unsigned long long val) {
2176 #ifdef USE_64_BIT_ALL
2177 return newSVuv(val);
2181 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2182 return newSVpv(buf, len);
2186 /* XXX Not thread-safe, and in general not safe if the caller is
2187 * issuing multiple requests in parallel (on different guestfs
2188 * handles). We should use the guestfs_h handle passed to the
2189 * error handle to distinguish these cases.
2191 static char *last_error = NULL;
2194 error_handler (guestfs_h *g,
2198 if (last_error != NULL) free (last_error);
2199 last_error = strdup (msg);
2202 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2207 RETVAL = guestfs_create ();
2209 croak (\"could not create guestfs handle\");
2210 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2223 fun (name, style, _, _, _, _) ->
2224 (match fst style with
2225 | Err -> pr "void\n"
2226 | RInt _ -> pr "SV *\n"
2227 | RBool _ -> pr "SV *\n"
2228 | RConstString _ -> pr "SV *\n"
2229 | RString _ -> pr "SV *\n"
2232 | RPVList _ | RVGList _ | RLVList _ ->
2233 pr "void\n" (* all lists returned implictly on the stack *)
2235 (* Call and arguments. *)
2237 generate_call_args ~handle:"g" style;
2239 pr " guestfs_h *g;\n";
2242 | String n -> pr " char *%s;\n" n
2243 | OptString n -> pr " char *%s;\n" n
2244 | Bool n -> pr " int %s;\n" n
2245 | Int n -> pr " int %s;\n" n
2248 (match fst style with
2251 pr " if (guestfs_%s " name;
2252 generate_call_args ~handle:"g" style;
2254 pr " croak (\"%s: %%s\", last_error);\n" name
2260 pr " %s = guestfs_%s " n name;
2261 generate_call_args ~handle:"g" style;
2263 pr " if (%s == -1)\n" n;
2264 pr " croak (\"%s: %%s\", last_error);\n" name;
2265 pr " RETVAL = newSViv (%s);\n" n;
2270 pr " const char *%s;\n" n;
2272 pr " %s = guestfs_%s " n name;
2273 generate_call_args ~handle:"g" style;
2275 pr " if (%s == NULL)\n" n;
2276 pr " croak (\"%s: %%s\", last_error);\n" name;
2277 pr " RETVAL = newSVpv (%s, 0);\n" n;
2282 pr " char *%s;\n" n;
2284 pr " %s = guestfs_%s " n name;
2285 generate_call_args ~handle:"g" style;
2287 pr " if (%s == NULL)\n" n;
2288 pr " croak (\"%s: %%s\", last_error);\n" name;
2289 pr " RETVAL = newSVpv (%s, 0);\n" n;
2290 pr " free (%s);\n" n;
2295 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 " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2304 pr " EXTEND (SP, n);\n";
2305 pr " for (i = 0; i < n; ++i) {\n";
2306 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2307 pr " free (%s[i]);\n" n;
2309 pr " free (%s);\n" n;
2312 pr " struct guestfs_int_bool *r;\n";
2314 pr " r = guestfs_%s " name;
2315 generate_call_args ~handle:"g" style;
2317 pr " if (r == NULL)\n";
2318 pr " croak (\"%s: %%s\", last_error);\n" name;
2319 pr " EXTEND (SP, 2);\n";
2320 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2321 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2322 pr " guestfs_free_int_bool (r);\n";
2324 generate_perl_lvm_code "pv" pv_cols name style n;
2326 generate_perl_lvm_code "vg" vg_cols name style n;
2328 generate_perl_lvm_code "lv" lv_cols name style n;
2333 and generate_perl_lvm_code typ cols name style n =
2335 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2339 pr " %s = guestfs_%s " n name;
2340 generate_call_args ~handle:"g" style;
2342 pr " if (%s == NULL)\n" n;
2343 pr " croak (\"%s: %%s\", last_error);\n" name;
2344 pr " EXTEND (SP, %s->len);\n" n;
2345 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2346 pr " hv = newHV ();\n";
2350 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2351 name (String.length name) n name
2353 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2354 name (String.length name) n name
2356 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2357 name (String.length name) n name
2359 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2360 name (String.length name) n name
2361 | name, `OptPercent ->
2362 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2363 name (String.length name) n name
2365 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2367 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2369 (* Generate Sys/Guestfs.pm. *)
2370 and generate_perl_pm () =
2371 generate_header HashStyle LGPLv2;
2378 Sys::Guestfs - Perl bindings for libguestfs
2384 my $h = Sys::Guestfs->new ();
2385 $h->add_drive ('guest.img');
2388 $h->mount ('/dev/sda1', '/');
2389 $h->touch ('/hello');
2394 The C<Sys::Guestfs> module provides a Perl XS binding to the
2395 libguestfs API for examining and modifying virtual machine
2398 Amongst the things this is good for: making batch configuration
2399 changes to guests, getting disk used/free statistics (see also:
2400 virt-df), migrating between virtualization systems (see also:
2401 virt-p2v), performing partial backups, performing partial guest
2402 clones, cloning guests and changing registry/UUID/hostname info, and
2405 Libguestfs uses Linux kernel and qemu code, and can access any type of
2406 guest filesystem that Linux and qemu can, including but not limited
2407 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2408 schemes, qcow, qcow2, vmdk.
2410 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2411 LVs, what filesystem is in each LV, etc.). It can also run commands
2412 in the context of the guest. Also you can access filesystems over FTP.
2416 All errors turn into calls to C<croak> (see L<Carp(3)>).
2424 package Sys::Guestfs;
2430 XSLoader::load ('Sys::Guestfs');
2432 =item $h = Sys::Guestfs->new ();
2434 Create a new guestfs handle.
2440 my $class = ref ($proto) || $proto;
2442 my $self = Sys::Guestfs::_create ();
2443 bless $self, $class;
2449 (* Actions. We only need to print documentation for these as
2450 * they are pulled in from the XS code automatically.
2453 fun (name, style, _, flags, _, longdesc) ->
2454 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2456 generate_perl_prototype name style;
2458 pr "%s\n\n" longdesc;
2459 if List.mem ProtocolLimitWarning flags then
2460 pr "Because of the message protocol, there is a transfer limit
2461 of somewhere between 2MB and 4MB. To transfer large files you should use
2463 ) all_functions_sorted;
2475 Copyright (C) 2009 Red Hat Inc.
2479 Please see the file COPYING.LIB for the full license.
2483 L<guestfs(3)>, L<guestfish(1)>.
2488 and generate_perl_prototype name style =
2489 (match fst style with
2494 | RString n -> pr "$%s = " n
2495 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2499 | RLVList n -> pr "@%s = " n
2502 let comma = ref false in
2505 if !comma then pr ", ";
2507 pr "%s" (name_of_argt arg)
2511 let output_to filename =
2512 let filename_new = filename ^ ".new" in
2513 chan := open_out filename_new;
2517 Unix.rename filename_new filename;
2518 printf "written %s\n%!" filename;
2526 let close = output_to "src/guestfs_protocol.x" in
2530 let close = output_to "src/guestfs-structs.h" in
2531 generate_structs_h ();
2534 let close = output_to "src/guestfs-actions.h" in
2535 generate_actions_h ();
2538 let close = output_to "src/guestfs-actions.c" in
2539 generate_client_actions ();
2542 let close = output_to "daemon/actions.h" in
2543 generate_daemon_actions_h ();
2546 let close = output_to "daemon/stubs.c" in
2547 generate_daemon_actions ();
2550 let close = output_to "fish/cmds.c" in
2551 generate_fish_cmds ();
2554 let close = output_to "guestfs-structs.pod" in
2555 generate_structs_pod ();
2558 let close = output_to "guestfs-actions.pod" in
2559 generate_actions_pod ();
2562 let close = output_to "guestfish-actions.pod" in
2563 generate_fish_actions_pod ();
2566 let close = output_to "ocaml/guestfs.mli" in
2567 generate_ocaml_mli ();
2570 let close = output_to "ocaml/guestfs.ml" in
2571 generate_ocaml_ml ();
2574 let close = output_to "ocaml/guestfs_c_actions.c" in
2575 generate_ocaml_c ();
2578 let close = output_to "perl/Guestfs.xs" in
2579 generate_perl_xs ();
2582 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2583 generate_perl_pm ();