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
477 ("aug_ls", (RStringList "matches", P1 (String "path")), 28, [],
478 "list Augeas nodes under a path",
480 This is just a shortcut for listing C<guestfs_aug_match>
481 C<path/*> and sorting the resulting nodes into alphabetical order.");
484 let all_functions = non_daemon_functions @ daemon_functions
486 (* In some places we want the functions to be displayed sorted
487 * alphabetically, so this is useful:
489 let all_functions_sorted =
490 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
492 (* Column names and types from LVM PVs/VGs/LVs. *)
501 "pv_attr", `String (* XXX *);
503 "pv_pe_alloc_count", `Int;
506 "pv_mda_count", `Int;
507 "pv_mda_free", `Bytes;
509 "pv_mda_size", `Bytes;
516 "vg_attr", `String (* XXX *);
520 "vg_extent_size", `Bytes;
521 "vg_extent_count", `Int;
522 "vg_free_count", `Int;
530 "vg_mda_count", `Int;
531 "vg_mda_free", `Bytes;
533 "vg_mda_size", `Bytes;
539 "lv_attr", `String (* XXX *);
542 "lv_kernel_major", `Int;
543 "lv_kernel_minor", `Int;
547 "snap_percent", `OptPercent;
548 "copy_percent", `OptPercent;
551 "mirror_log", `String;
556 * Note we don't want to use any external OCaml libraries which
557 * makes this a bit harder than it should be.
559 let failwithf fs = ksprintf failwith fs
561 let replace_char s c1 c2 =
562 let s2 = String.copy s in
564 for i = 0 to String.length s2 - 1 do
565 if String.unsafe_get s2 i = c1 then (
566 String.unsafe_set s2 i c2;
570 if not !r then s else s2
573 let len = String.length s in
574 let sublen = String.length sub in
576 if i <= len-sublen then (
579 if s.[i+j] = sub.[j] then loop2 (j+1)
585 if r = -1 then loop (i+1) else r
591 let rec replace_str s s1 s2 =
592 let len = String.length s in
593 let sublen = String.length s1 in
597 let s' = String.sub s 0 i in
598 let s'' = String.sub s (i+sublen) (len-i-sublen) in
599 s' ^ s2 ^ replace_str s'' s1 s2
602 let rec find_map f = function
603 | [] -> raise Not_found
607 | None -> find_map f xs
610 let rec loop i = function
612 | x :: xs -> f i x; loop (i+1) xs
616 (* 'pr' prints to the current output file. *)
617 let chan = ref stdout
618 let pr fs = ksprintf (output_string !chan) fs
620 let iter_args f = function
623 | P2 (arg1, arg2) -> f arg1; f arg2
624 | P3 (arg1, arg2, arg3) -> f arg1; f arg2; f arg3
626 let iteri_args f = function
628 | P1 arg1 -> f 0 arg1
629 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
630 | P3 (arg1, arg2, arg3) -> f 0 arg1; f 1 arg2; f 2 arg3
632 let map_args f = function
634 | P1 arg1 -> [f arg1]
636 let n1 = f arg1 in let n2 = f arg2 in [n1; n2]
637 | P3 (arg1, arg2, arg3) ->
638 let n1 = f arg1 in let n2 = f arg2 in let n3 = f arg3 in [n1; n2; n3]
640 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2 | P3 _ -> 3
642 let name_of_argt = function String n | OptString n | Bool n | Int n -> n
644 (* Check function names etc. for consistency. *)
645 let check_functions () =
647 fun (name, _, _, _, _, longdesc) ->
648 if String.contains name '-' then
649 failwithf "function name '%s' should not contain '-', use '_' instead."
651 if longdesc.[String.length longdesc-1] = '\n' then
652 failwithf "long description of %s should not end with \\n." name
656 fun (name, _, proc_nr, _, _, _) ->
658 failwithf "daemon function %s should have proc_nr > 0" name
662 fun (name, _, proc_nr, _, _, _) ->
663 if proc_nr <> -1 then
664 failwithf "non-daemon function %s should have proc_nr -1" name
665 ) non_daemon_functions;
668 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
671 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
672 let rec loop = function
675 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
677 | (name1,nr1) :: (name2,nr2) :: _ ->
678 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
683 type comment_style = CStyle | HashStyle | OCamlStyle
684 type license = GPLv2 | LGPLv2
686 (* Generate a header block in a number of standard styles. *)
687 let rec generate_header comment license =
688 let c = match comment with
689 | CStyle -> pr "/* "; " *"
690 | HashStyle -> pr "# "; "#"
691 | OCamlStyle -> pr "(* "; " *" in
692 pr "libguestfs generated file\n";
693 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
694 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
696 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
700 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
701 pr "%s it under the terms of the GNU General Public License as published by\n" c;
702 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
703 pr "%s (at your option) any later version.\n" c;
705 pr "%s This program is distributed in the hope that it will be useful,\n" c;
706 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
707 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
708 pr "%s GNU General Public License for more details.\n" c;
710 pr "%s You should have received a copy of the GNU General Public License along\n" c;
711 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
712 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
715 pr "%s This library is free software; you can redistribute it and/or\n" c;
716 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
717 pr "%s License as published by the Free Software Foundation; either\n" c;
718 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
720 pr "%s This library is distributed in the hope that it will be useful,\n" c;
721 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
722 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
723 pr "%s Lesser General Public License for more details.\n" c;
725 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
726 pr "%s License along with this library; if not, write to the Free Software\n" c;
727 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
730 | CStyle -> pr " */\n"
732 | OCamlStyle -> pr " *)\n"
736 (* Generate the pod documentation for the C API. *)
737 and generate_actions_pod () =
739 fun (shortname, style, _, flags, _, longdesc) ->
740 let name = "guestfs_" ^ shortname in
741 pr "=head2 %s\n\n" name;
743 generate_prototype ~extern:false ~handle:"handle" name style;
745 pr "%s\n\n" longdesc;
746 (match fst style with
748 pr "This function returns 0 on success or -1 on error.\n\n"
750 pr "On error this function returns -1.\n\n"
752 pr "This function returns a C truth value on success or -1 on error.\n\n"
754 pr "This function returns a string or NULL on error.
755 The string is owned by the guest handle and must I<not> be freed.\n\n"
757 pr "This function returns a string or NULL on error.
758 I<The caller must free the returned string after use>.\n\n"
760 pr "This function returns a NULL-terminated array of strings
761 (like L<environ(3)>), or NULL if there was an error.
762 I<The caller must free the strings and the array after use>.\n\n"
764 pr "This function returns a C<struct guestfs_int_bool *>.
765 I<The caller must call C<guestfs_free_int_bool> after use.>.\n\n"
767 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
768 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
770 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
771 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
773 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
774 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
776 if List.mem ProtocolLimitWarning flags then
777 pr "Because of the message protocol, there is a transfer limit
778 of somewhere between 2MB and 4MB. To transfer large files you should use
780 ) all_functions_sorted
782 and generate_structs_pod () =
783 (* LVM structs documentation. *)
786 pr "=head2 guestfs_lvm_%s\n" typ;
788 pr " struct guestfs_lvm_%s {\n" typ;
791 | name, `String -> pr " char *%s;\n" name
793 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
794 pr " char %s[32];\n" name
795 | name, `Bytes -> pr " uint64_t %s;\n" name
796 | name, `Int -> pr " int64_t %s;\n" name
797 | name, `OptPercent ->
798 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
799 pr " float %s;\n" name
802 pr " struct guestfs_lvm_%s_list {\n" typ;
803 pr " uint32_t len; /* Number of elements in list. */\n";
804 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
807 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
810 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
812 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
813 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
814 * have to use an underscore instead of a dash because otherwise
815 * rpcgen generates incorrect code.
817 * This header is NOT exported to clients, but see also generate_structs_h.
819 and generate_xdr () =
820 generate_header CStyle LGPLv2;
822 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
823 pr "typedef string str<>;\n";
826 (* LVM internal structures. *)
830 pr "struct guestfs_lvm_int_%s {\n" typ;
832 | name, `String -> pr " string %s<>;\n" name
833 | name, `UUID -> pr " opaque %s[32];\n" name
834 | name, `Bytes -> pr " hyper %s;\n" name
835 | name, `Int -> pr " hyper %s;\n" name
836 | name, `OptPercent -> pr " float %s;\n" name
840 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
842 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
845 fun(shortname, style, _, _, _, _) ->
846 let name = "guestfs_" ^ shortname in
848 (match snd style with
851 pr "struct %s_args {\n" name;
854 | String n -> pr " string %s<>;\n" n
855 | OptString n -> pr " str *%s;\n" n
856 | Bool n -> pr " bool %s;\n" n
857 | Int n -> pr " int %s;\n" n
861 (match fst style with
864 pr "struct %s_ret {\n" name;
868 pr "struct %s_ret {\n" name;
872 failwithf "RConstString cannot be returned from a daemon function"
874 pr "struct %s_ret {\n" name;
875 pr " string %s<>;\n" n;
878 pr "struct %s_ret {\n" name;
882 pr "struct %s_ret {\n" name;
887 pr "struct %s_ret {\n" name;
888 pr " guestfs_lvm_int_pv_list %s;\n" n;
891 pr "struct %s_ret {\n" name;
892 pr " guestfs_lvm_int_vg_list %s;\n" n;
895 pr "struct %s_ret {\n" name;
896 pr " guestfs_lvm_int_lv_list %s;\n" n;
901 (* Table of procedure numbers. *)
902 pr "enum guestfs_procedure {\n";
904 fun (shortname, _, proc_nr, _, _, _) ->
905 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
907 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
911 (* Having to choose a maximum message size is annoying for several
912 * reasons (it limits what we can do in the API), but it (a) makes
913 * the protocol a lot simpler, and (b) provides a bound on the size
914 * of the daemon which operates in limited memory space. For large
915 * file transfers you should use FTP.
917 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
920 (* Message header, etc. *)
922 const GUESTFS_PROGRAM = 0x2000F5F5;
923 const GUESTFS_PROTOCOL_VERSION = 1;
925 enum guestfs_message_direction {
926 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
927 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
930 enum guestfs_message_status {
931 GUESTFS_STATUS_OK = 0,
932 GUESTFS_STATUS_ERROR = 1
935 const GUESTFS_ERROR_LEN = 256;
937 struct guestfs_message_error {
938 string error<GUESTFS_ERROR_LEN>; /* error message */
941 struct guestfs_message_header {
942 unsigned prog; /* GUESTFS_PROGRAM */
943 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
944 guestfs_procedure proc; /* GUESTFS_PROC_x */
945 guestfs_message_direction direction;
946 unsigned serial; /* message serial number */
947 guestfs_message_status status;
951 (* Generate the guestfs-structs.h file. *)
952 and generate_structs_h () =
953 generate_header CStyle LGPLv2;
955 (* This is a public exported header file containing various
956 * structures. The structures are carefully written to have
957 * exactly the same in-memory format as the XDR structures that
958 * we use on the wire to the daemon. The reason for creating
959 * copies of these structures here is just so we don't have to
960 * export the whole of guestfs_protocol.h (which includes much
961 * unrelated and XDR-dependent stuff that we don't want to be
962 * public, or required by clients).
964 * To reiterate, we will pass these structures to and from the
965 * client with a simple assignment or memcpy, so the format
966 * must be identical to what rpcgen / the RFC defines.
969 (* guestfs_int_bool structure. *)
970 pr "struct guestfs_int_bool {\n";
976 (* LVM public structures. *)
980 pr "struct guestfs_lvm_%s {\n" typ;
983 | name, `String -> pr " char *%s;\n" name
984 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
985 | name, `Bytes -> pr " uint64_t %s;\n" name
986 | name, `Int -> pr " int64_t %s;\n" name
987 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
991 pr "struct guestfs_lvm_%s_list {\n" typ;
992 pr " uint32_t len;\n";
993 pr " struct guestfs_lvm_%s *val;\n" typ;
996 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
998 (* Generate the guestfs-actions.h file. *)
999 and generate_actions_h () =
1000 generate_header CStyle LGPLv2;
1002 fun (shortname, style, _, _, _, _) ->
1003 let name = "guestfs_" ^ shortname in
1004 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1008 (* Generate the client-side dispatch stubs. *)
1009 and generate_client_actions () =
1010 generate_header CStyle LGPLv2;
1012 (* Client-side stubs for each function. *)
1014 fun (shortname, style, _, _, _, _) ->
1015 let name = "guestfs_" ^ shortname in
1017 (* Generate the return value struct. *)
1018 pr "struct %s_rv {\n" shortname;
1019 pr " int cb_done; /* flag to indicate callback was called */\n";
1020 pr " struct guestfs_message_header hdr;\n";
1021 pr " struct guestfs_message_error err;\n";
1022 (match fst style with
1025 failwithf "RConstString cannot be returned from a daemon function"
1027 | RBool _ | RString _ | RStringList _
1029 | RPVList _ | RVGList _ | RLVList _ ->
1030 pr " struct %s_ret ret;\n" name
1034 (* Generate the callback function. *)
1035 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1037 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1039 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1040 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1043 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1044 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1045 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1051 (match fst style with
1054 failwithf "RConstString cannot be returned from a daemon function"
1056 | RBool _ | RString _ | RStringList _
1058 | RPVList _ | RVGList _ | RLVList _ ->
1059 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1060 pr " error (g, \"%s: failed to parse reply\");\n" name;
1066 pr " rv->cb_done = 1;\n";
1067 pr " main_loop.main_loop_quit (g);\n";
1070 (* Generate the action stub. *)
1071 generate_prototype ~extern:false ~semicolon:false ~newline:true
1072 ~handle:"g" name style;
1075 match fst style with
1076 | Err | RInt _ | RBool _ -> "-1"
1078 failwithf "RConstString cannot be returned from a daemon function"
1079 | RString _ | RStringList _ | RIntBool _
1080 | RPVList _ | RVGList _ | RLVList _ ->
1085 (match snd style with
1087 | _ -> pr " struct %s_args args;\n" name
1090 pr " struct %s_rv rv;\n" shortname;
1091 pr " int serial;\n";
1093 pr " if (g->state != READY) {\n";
1094 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1097 pr " return %s;\n" error_code;
1100 pr " memset (&rv, 0, sizeof rv);\n";
1103 (match snd style with
1105 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1106 (String.uppercase shortname)
1111 pr " args.%s = (char *) %s;\n" n n
1113 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1115 pr " args.%s = %s;\n" n n
1117 pr " args.%s = %s;\n" n n
1119 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1120 (String.uppercase shortname);
1121 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1124 pr " if (serial == -1)\n";
1125 pr " return %s;\n" error_code;
1128 pr " rv.cb_done = 0;\n";
1129 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1130 pr " g->reply_cb_internal_data = &rv;\n";
1131 pr " main_loop.main_loop_run (g);\n";
1132 pr " g->reply_cb_internal = NULL;\n";
1133 pr " g->reply_cb_internal_data = NULL;\n";
1134 pr " if (!rv.cb_done) {\n";
1135 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1136 pr " return %s;\n" error_code;
1140 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1141 (String.uppercase shortname);
1142 pr " return %s;\n" error_code;
1145 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1146 pr " error (g, \"%%s\", rv.err.error);\n";
1147 pr " return %s;\n" error_code;
1151 (match fst style with
1152 | Err -> pr " return 0;\n"
1154 | RBool n -> pr " return rv.ret.%s;\n" n
1156 failwithf "RConstString cannot be returned from a daemon function"
1158 pr " return rv.ret.%s; /* caller will free */\n" n
1160 pr " /* caller will free this, but we need to add a NULL entry */\n";
1161 pr " rv.ret.%s.%s_val =" n n;
1162 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1163 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1165 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1166 pr " return rv.ret.%s.%s_val;\n" n n
1168 pr " /* caller with free this */\n";
1169 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1171 pr " /* caller will free this */\n";
1172 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1174 pr " /* caller will free this */\n";
1175 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1177 pr " /* caller will free this */\n";
1178 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1184 (* Generate daemon/actions.h. *)
1185 and generate_daemon_actions_h () =
1186 generate_header CStyle GPLv2;
1188 pr "#include \"../src/guestfs_protocol.h\"\n";
1192 fun (name, style, _, _, _, _) ->
1194 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1198 (* Generate the server-side stubs. *)
1199 and generate_daemon_actions () =
1200 generate_header CStyle GPLv2;
1202 pr "#define _GNU_SOURCE // for strchrnul\n";
1204 pr "#include <stdio.h>\n";
1205 pr "#include <stdlib.h>\n";
1206 pr "#include <string.h>\n";
1207 pr "#include <inttypes.h>\n";
1208 pr "#include <ctype.h>\n";
1209 pr "#include <rpc/types.h>\n";
1210 pr "#include <rpc/xdr.h>\n";
1212 pr "#include \"daemon.h\"\n";
1213 pr "#include \"../src/guestfs_protocol.h\"\n";
1214 pr "#include \"actions.h\"\n";
1218 fun (name, style, _, _, _, _) ->
1219 (* Generate server-side stubs. *)
1220 pr "static void %s_stub (XDR *xdr_in)\n" name;
1223 match fst style with
1224 | Err | RInt _ -> pr " int r;\n"; "-1"
1225 | RBool _ -> pr " int r;\n"; "-1"
1227 failwithf "RConstString cannot be returned from a daemon function"
1228 | RString _ -> pr " char *r;\n"; "NULL"
1229 | RStringList _ -> pr " char **r;\n"; "NULL"
1230 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1231 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1232 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1233 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1235 (match snd style with
1238 pr " struct guestfs_%s_args args;\n" name;
1242 | OptString n -> pr " const char *%s;\n" n
1243 | Bool n -> pr " int %s;\n" n
1244 | Int n -> pr " int %s;\n" n
1249 (match snd style with
1252 pr " memset (&args, 0, sizeof args);\n";
1254 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1255 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1260 | String n -> pr " %s = args.%s;\n" n n
1261 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1262 | Bool n -> pr " %s = args.%s;\n" n n
1263 | Int n -> pr " %s = args.%s;\n" n n
1268 pr " r = do_%s " name;
1269 generate_call_args style;
1272 pr " if (r == %s)\n" error_code;
1273 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1277 (match fst style with
1278 | Err -> pr " reply (NULL, NULL);\n"
1280 pr " struct guestfs_%s_ret ret;\n" name;
1281 pr " ret.%s = r;\n" n;
1282 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
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
1288 failwithf "RConstString cannot be returned from a daemon function"
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;
1295 pr " struct guestfs_%s_ret ret;\n" name;
1296 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1297 pr " ret.%s.%s_val = r;\n" n n;
1298 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1299 pr " free_strings (r);\n"
1301 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1302 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1304 pr " struct guestfs_%s_ret ret;\n" name;
1305 pr " ret.%s = *r;\n" n;
1306 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1307 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1309 pr " struct guestfs_%s_ret ret;\n" name;
1310 pr " ret.%s = *r;\n" n;
1311 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1312 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1314 pr " struct guestfs_%s_ret ret;\n" name;
1315 pr " ret.%s = *r;\n" n;
1316 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1317 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1323 (* Dispatch function. *)
1324 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1326 pr " switch (proc_nr) {\n";
1329 fun (name, style, _, _, _, _) ->
1330 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1331 pr " %s_stub (xdr_in);\n" name;
1336 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1341 (* LVM columns and tokenization functions. *)
1342 (* XXX This generates crap code. We should rethink how we
1348 pr "static const char *lvm_%s_cols = \"%s\";\n"
1349 typ (String.concat "," (List.map fst cols));
1352 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1354 pr " char *tok, *p, *next;\n";
1358 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1361 pr " if (!str) {\n";
1362 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1365 pr " if (!*str || isspace (*str)) {\n";
1366 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1371 fun (name, coltype) ->
1372 pr " if (!tok) {\n";
1373 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1376 pr " p = strchrnul (tok, ',');\n";
1377 pr " if (*p) next = p+1; else next = NULL;\n";
1378 pr " *p = '\\0';\n";
1381 pr " r->%s = strdup (tok);\n" name;
1382 pr " if (r->%s == NULL) {\n" name;
1383 pr " perror (\"strdup\");\n";
1387 pr " for (i = j = 0; i < 32; ++j) {\n";
1388 pr " if (tok[j] == '\\0') {\n";
1389 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1391 pr " } else if (tok[j] != '-')\n";
1392 pr " r->%s[i++] = tok[j];\n" name;
1395 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1396 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1400 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1401 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1405 pr " if (tok[0] == '\\0')\n";
1406 pr " r->%s = -1;\n" name;
1407 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1408 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1412 pr " tok = next;\n";
1415 pr " if (tok != NULL) {\n";
1416 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1423 pr "guestfs_lvm_int_%s_list *\n" typ;
1424 pr "parse_command_line_%ss (void)\n" typ;
1426 pr " char *out, *err;\n";
1427 pr " char *p, *pend;\n";
1429 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1430 pr " void *newp;\n";
1432 pr " ret = malloc (sizeof *ret);\n";
1433 pr " if (!ret) {\n";
1434 pr " reply_with_perror (\"malloc\");\n";
1435 pr " return NULL;\n";
1438 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1439 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1441 pr " r = command (&out, &err,\n";
1442 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1443 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1444 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1445 pr " if (r == -1) {\n";
1446 pr " reply_with_error (\"%%s\", err);\n";
1447 pr " free (out);\n";
1448 pr " free (err);\n";
1449 pr " return NULL;\n";
1452 pr " free (err);\n";
1454 pr " /* Tokenize each line of the output. */\n";
1457 pr " while (p) {\n";
1458 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1459 pr " if (pend) {\n";
1460 pr " *pend = '\\0';\n";
1464 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1467 pr " if (!*p) { /* Empty line? Skip it. */\n";
1472 pr " /* Allocate some space to store this next entry. */\n";
1473 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1474 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1475 pr " if (newp == NULL) {\n";
1476 pr " reply_with_perror (\"realloc\");\n";
1477 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1478 pr " free (ret);\n";
1479 pr " free (out);\n";
1480 pr " return NULL;\n";
1482 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1484 pr " /* Tokenize the next entry. */\n";
1485 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1486 pr " if (r == -1) {\n";
1487 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1488 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1489 pr " free (ret);\n";
1490 pr " free (out);\n";
1491 pr " return NULL;\n";
1498 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1500 pr " free (out);\n";
1501 pr " return ret;\n";
1504 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1506 (* Generate a lot of different functions for guestfish. *)
1507 and generate_fish_cmds () =
1508 generate_header CStyle GPLv2;
1512 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1514 let all_functions_sorted =
1516 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1517 ) all_functions_sorted in
1519 pr "#include <stdio.h>\n";
1520 pr "#include <stdlib.h>\n";
1521 pr "#include <string.h>\n";
1522 pr "#include <inttypes.h>\n";
1524 pr "#include <guestfs.h>\n";
1525 pr "#include \"fish.h\"\n";
1528 (* list_commands function, which implements guestfish -h *)
1529 pr "void list_commands (void)\n";
1531 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1532 pr " list_builtin_commands ();\n";
1534 fun (name, _, _, flags, shortdesc, _) ->
1535 let name = replace_char name '_' '-' in
1536 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1538 ) all_functions_sorted;
1539 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1543 (* display_command function, which implements guestfish -h cmd *)
1544 pr "void display_command (const char *cmd)\n";
1547 fun (name, style, _, flags, shortdesc, longdesc) ->
1548 let name2 = replace_char name '_' '-' in
1550 try find_map (function FishAlias n -> Some n | _ -> None) flags
1551 with Not_found -> name in
1552 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1554 match snd style with
1558 name2 (String.concat "> <" (map_args name_of_argt args)) in
1561 if List.mem ProtocolLimitWarning flags then
1562 "\n\nBecause of the message protocol, there is a transfer limit
1563 of somewhere between 2MB and 4MB. To transfer large files you should use
1567 let describe_alias =
1568 if name <> alias then
1569 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1573 pr "strcasecmp (cmd, \"%s\") == 0" name;
1574 if name <> name2 then
1575 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1576 if name <> alias then
1577 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1579 pr " pod2text (\"%s - %s\", %S);\n"
1581 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1584 pr " display_builtin_command (cmd);\n";
1588 (* print_{pv,vg,lv}_list functions *)
1592 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1599 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1601 pr " printf (\"%s: \");\n" name;
1602 pr " for (i = 0; i < 32; ++i)\n";
1603 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1604 pr " printf (\"\\n\");\n"
1606 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1608 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1609 | name, `OptPercent ->
1610 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1611 typ name name typ name;
1612 pr " else printf (\"%s: \\n\");\n" name
1616 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1621 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1622 pr " print_%s (&%ss->val[i]);\n" typ typ;
1625 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1627 (* run_<action> actions *)
1629 fun (name, style, _, flags, _, _) ->
1630 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1632 (match fst style with
1635 | RBool _ -> pr " int r;\n"
1636 | RConstString _ -> pr " const char *r;\n"
1637 | RString _ -> pr " char *r;\n"
1638 | RStringList _ -> pr " char **r;\n"
1639 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
1640 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1641 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1642 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1646 | String n -> pr " const char *%s;\n" n
1647 | OptString n -> pr " const char *%s;\n" n
1648 | Bool n -> pr " int %s;\n" n
1649 | Int n -> pr " int %s;\n" n
1652 (* Check and convert parameters. *)
1653 let argc_expected = nr_args (snd style) in
1654 pr " if (argc != %d) {\n" argc_expected;
1655 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1657 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1663 | String name -> pr " %s = argv[%d];\n" name i
1665 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1668 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1670 pr " %s = atoi (argv[%d]);\n" name i
1673 (* Call C API function. *)
1675 try find_map (function FishAction n -> Some n | _ -> None) flags
1676 with Not_found -> sprintf "guestfs_%s" name in
1678 generate_call_args ~handle:"g" style;
1681 (* Check return value for errors and display command results. *)
1682 (match fst style with
1683 | Err -> pr " return r;\n"
1685 pr " if (r == -1) return -1;\n";
1686 pr " if (r) printf (\"%%d\\n\", r);\n";
1689 pr " if (r == -1) return -1;\n";
1690 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1693 pr " if (r == NULL) return -1;\n";
1694 pr " printf (\"%%s\\n\", r);\n";
1697 pr " if (r == NULL) return -1;\n";
1698 pr " printf (\"%%s\\n\", r);\n";
1702 pr " if (r == NULL) return -1;\n";
1703 pr " print_strings (r);\n";
1704 pr " free_strings (r);\n";
1707 pr " if (r == NULL) return -1;\n";
1708 pr " printf (\"%%d, %%s\\n\", r->i,\n";
1709 pr " r->b ? \"true\" : \"false\");\n";
1710 pr " guestfs_free_int_bool (r);\n";
1713 pr " if (r == NULL) return -1;\n";
1714 pr " print_pv_list (r);\n";
1715 pr " guestfs_free_lvm_pv_list (r);\n";
1718 pr " if (r == NULL) return -1;\n";
1719 pr " print_vg_list (r);\n";
1720 pr " guestfs_free_lvm_vg_list (r);\n";
1723 pr " if (r == NULL) return -1;\n";
1724 pr " print_lv_list (r);\n";
1725 pr " guestfs_free_lvm_lv_list (r);\n";
1732 (* run_action function *)
1733 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1736 fun (name, _, _, flags, _, _) ->
1737 let name2 = replace_char name '_' '-' in
1739 try find_map (function FishAlias n -> Some n | _ -> None) flags
1740 with Not_found -> name in
1742 pr "strcasecmp (cmd, \"%s\") == 0" name;
1743 if name <> name2 then
1744 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1745 if name <> alias then
1746 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1748 pr " return run_%s (cmd, argc, argv);\n" name;
1752 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1759 (* Generate the POD documentation for guestfish. *)
1760 and generate_fish_actions_pod () =
1761 let all_functions_sorted =
1763 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1764 ) all_functions_sorted in
1767 fun (name, style, _, flags, _, longdesc) ->
1768 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1769 let name = replace_char name '_' '-' in
1771 try find_map (function FishAlias n -> Some n | _ -> None) flags
1772 with Not_found -> name in
1774 pr "=head2 %s" name;
1775 if name <> alias then
1782 | String n -> pr " %s" n
1783 | OptString n -> pr " %s" n
1784 | Bool _ -> pr " true|false"
1785 | Int n -> pr " %s" n
1789 pr "%s\n\n" longdesc
1790 ) all_functions_sorted
1792 (* Generate a C function prototype. *)
1793 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1794 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1796 ?handle name style =
1797 if extern then pr "extern ";
1798 if static then pr "static ";
1799 (match fst style with
1801 | RInt _ -> pr "int "
1802 | RBool _ -> pr "int "
1803 | RConstString _ -> pr "const char *"
1804 | RString _ -> pr "char *"
1805 | RStringList _ -> pr "char **"
1807 if not in_daemon then pr "struct guestfs_int_bool *"
1808 else pr "guestfs_%s_ret *" name
1810 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1811 else pr "guestfs_lvm_int_pv_list *"
1813 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1814 else pr "guestfs_lvm_int_vg_list *"
1816 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1817 else pr "guestfs_lvm_int_lv_list *"
1819 pr "%s%s (" prefix name;
1820 if handle = None && nr_args (snd style) = 0 then
1823 let comma = ref false in
1826 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1830 if single_line then pr ", " else pr ",\n\t\t"
1836 | String n -> next (); pr "const char *%s" n
1837 | OptString n -> next (); pr "const char *%s" n
1838 | Bool n -> next (); pr "int %s" n
1839 | Int n -> next (); pr "int %s" n
1843 if semicolon then pr ";";
1844 if newline then pr "\n"
1846 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1847 and generate_call_args ?handle style =
1849 let comma = ref false in
1852 | Some handle -> pr "%s" handle; comma := true
1856 if !comma then pr ", ";
1859 | String n -> pr "%s" n
1860 | OptString n -> pr "%s" n
1861 | Bool n -> pr "%s" n
1862 | Int n -> pr "%s" n
1866 (* Generate the OCaml bindings interface. *)
1867 and generate_ocaml_mli () =
1868 generate_header OCamlStyle LGPLv2;
1871 (** For API documentation you should refer to the C API
1872 in the guestfs(3) manual page. The OCaml API uses almost
1873 exactly the same calls. *)
1876 (** A [guestfs_h] handle. *)
1878 exception Error of string
1879 (** This exception is raised when there is an error. *)
1881 val create : unit -> t
1883 val close : t -> unit
1884 (** Handles are closed by the garbage collector when they become
1885 unreferenced, but callers can also call this in order to
1886 provide predictable cleanup. *)
1889 generate_ocaml_lvm_structure_decls ();
1893 fun (name, style, _, _, shortdesc, _) ->
1894 generate_ocaml_prototype name style;
1895 pr "(** %s *)\n" shortdesc;
1899 (* Generate the OCaml bindings implementation. *)
1900 and generate_ocaml_ml () =
1901 generate_header OCamlStyle LGPLv2;
1905 exception Error of string
1906 external create : unit -> t = \"ocaml_guestfs_create\"
1907 external close : t -> unit = \"ocaml_guestfs_close\"
1910 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1914 generate_ocaml_lvm_structure_decls ();
1918 fun (name, style, _, _, shortdesc, _) ->
1919 generate_ocaml_prototype ~is_external:true name style;
1922 (* Generate the OCaml bindings C implementation. *)
1923 and generate_ocaml_c () =
1924 generate_header CStyle LGPLv2;
1926 pr "#include <stdio.h>\n";
1927 pr "#include <stdlib.h>\n";
1928 pr "#include <string.h>\n";
1930 pr "#include <caml/config.h>\n";
1931 pr "#include <caml/alloc.h>\n";
1932 pr "#include <caml/callback.h>\n";
1933 pr "#include <caml/fail.h>\n";
1934 pr "#include <caml/memory.h>\n";
1935 pr "#include <caml/mlvalues.h>\n";
1936 pr "#include <caml/signals.h>\n";
1938 pr "#include <guestfs.h>\n";
1940 pr "#include \"guestfs_c.h\"\n";
1943 (* LVM struct copy functions. *)
1946 let has_optpercent_col =
1947 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1949 pr "static CAMLprim value\n";
1950 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1952 pr " CAMLparam0 ();\n";
1953 if has_optpercent_col then
1954 pr " CAMLlocal3 (rv, v, v2);\n"
1956 pr " CAMLlocal2 (rv, v);\n";
1958 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1963 pr " v = caml_copy_string (%s->%s);\n" typ name
1965 pr " v = caml_alloc_string (32);\n";
1966 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
1969 pr " v = caml_copy_int64 (%s->%s);\n" typ name
1970 | name, `OptPercent ->
1971 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
1972 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
1973 pr " v = caml_alloc (1, 0);\n";
1974 pr " Store_field (v, 0, v2);\n";
1975 pr " } else /* None */\n";
1976 pr " v = Val_int (0);\n";
1978 pr " Store_field (rv, %d, v);\n" i
1980 pr " CAMLreturn (rv);\n";
1984 pr "static CAMLprim value\n";
1985 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
1988 pr " CAMLparam0 ();\n";
1989 pr " CAMLlocal2 (rv, v);\n";
1992 pr " if (%ss->len == 0)\n" typ;
1993 pr " CAMLreturn (Atom (0));\n";
1995 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
1996 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
1997 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
1998 pr " caml_modify (&Field (rv, i), v);\n";
2000 pr " CAMLreturn (rv);\n";
2004 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2007 fun (name, style, _, _, _, _) ->
2008 pr "CAMLprim value\n";
2009 pr "ocaml_guestfs_%s (value gv" name;
2011 fun arg -> pr ", value %sv" (name_of_argt arg)
2015 pr " CAMLparam%d (gv" (1 + (nr_args (snd style)));
2017 fun arg -> pr ", %sv" (name_of_argt arg)
2020 pr " CAMLlocal1 (rv);\n";
2023 pr " guestfs_h *g = Guestfs_val (gv);\n";
2024 pr " if (g == NULL)\n";
2025 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
2031 pr " const char *%s = String_val (%sv);\n" n n
2033 pr " const char *%s =\n" n;
2034 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
2037 pr " int %s = Bool_val (%sv);\n" n n
2039 pr " int %s = Int_val (%sv);\n" n n
2042 match fst style with
2043 | Err -> pr " int r;\n"; "-1"
2044 | RInt _ -> pr " int r;\n"; "-1"
2045 | RBool _ -> pr " int r;\n"; "-1"
2046 | RConstString _ -> pr " const char *r;\n"; "NULL"
2047 | RString _ -> pr " char *r;\n"; "NULL"
2053 pr " struct guestfs_int_bool *r;\n";
2056 pr " struct guestfs_lvm_pv_list *r;\n";
2059 pr " struct guestfs_lvm_vg_list *r;\n";
2062 pr " struct guestfs_lvm_lv_list *r;\n";
2066 pr " caml_enter_blocking_section ();\n";
2067 pr " r = guestfs_%s " name;
2068 generate_call_args ~handle:"g" style;
2070 pr " caml_leave_blocking_section ();\n";
2071 pr " if (r == %s)\n" error_code;
2072 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
2075 (match fst style with
2076 | Err -> pr " rv = Val_unit;\n"
2077 | RInt _ -> pr " rv = Val_int (r);\n"
2078 | RBool _ -> pr " rv = Val_bool (r);\n"
2079 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
2081 pr " rv = caml_copy_string (r);\n";
2084 pr " rv = caml_copy_string_array ((const char **) r);\n";
2085 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
2088 pr " rv = caml_alloc (2, 0);\n";
2089 pr " Store_field (rv, 0, Val_int (r->i));\n";
2090 pr " Store_field (rv, 1, Val_bool (r->b));\n";
2091 pr " guestfs_free_int_bool (r);\n";
2093 pr " rv = copy_lvm_pv_list (r);\n";
2094 pr " guestfs_free_lvm_pv_list (r);\n";
2096 pr " rv = copy_lvm_vg_list (r);\n";
2097 pr " guestfs_free_lvm_vg_list (r);\n";
2099 pr " rv = copy_lvm_lv_list (r);\n";
2100 pr " guestfs_free_lvm_lv_list (r);\n";
2103 pr " CAMLreturn (rv);\n";
2108 and generate_ocaml_lvm_structure_decls () =
2111 pr "type lvm_%s = {\n" typ;
2114 | name, `String -> pr " %s : string;\n" name
2115 | name, `UUID -> pr " %s : string;\n" name
2116 | name, `Bytes -> pr " %s : int64;\n" name
2117 | name, `Int -> pr " %s : int64;\n" name
2118 | name, `OptPercent -> pr " %s : float option;\n" name
2122 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2124 and generate_ocaml_prototype ?(is_external = false) name style =
2125 if is_external then pr "external " else pr "val ";
2126 pr "%s : t -> " name;
2129 | String _ -> pr "string -> "
2130 | OptString _ -> pr "string option -> "
2131 | Bool _ -> pr "bool -> "
2132 | Int _ -> pr "int -> "
2134 (match fst style with
2135 | Err -> pr "unit" (* all errors are turned into exceptions *)
2136 | RInt _ -> pr "int"
2137 | RBool _ -> pr "bool"
2138 | RConstString _ -> pr "string"
2139 | RString _ -> pr "string"
2140 | RStringList _ -> pr "string array"
2141 | RIntBool _ -> pr "int * bool"
2142 | RPVList _ -> pr "lvm_pv array"
2143 | RVGList _ -> pr "lvm_vg array"
2144 | RLVList _ -> pr "lvm_lv array"
2146 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
2149 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
2150 and generate_perl_xs () =
2151 generate_header CStyle LGPLv2;
2154 #include \"EXTERN.h\"
2158 #include <guestfs.h>
2161 #define PRId64 \"lld\"
2165 my_newSVll(long long val) {
2166 #ifdef USE_64_BIT_ALL
2167 return newSViv(val);
2171 len = snprintf(buf, 100, \"%%\" PRId64, val);
2172 return newSVpv(buf, len);
2177 #define PRIu64 \"llu\"
2181 my_newSVull(unsigned long long val) {
2182 #ifdef USE_64_BIT_ALL
2183 return newSVuv(val);
2187 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2188 return newSVpv(buf, len);
2192 /* XXX Not thread-safe, and in general not safe if the caller is
2193 * issuing multiple requests in parallel (on different guestfs
2194 * handles). We should use the guestfs_h handle passed to the
2195 * error handle to distinguish these cases.
2197 static char *last_error = NULL;
2200 error_handler (guestfs_h *g,
2204 if (last_error != NULL) free (last_error);
2205 last_error = strdup (msg);
2208 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
2213 RETVAL = guestfs_create ();
2215 croak (\"could not create guestfs handle\");
2216 guestfs_set_error_handler (RETVAL, error_handler, NULL);
2229 fun (name, style, _, _, _, _) ->
2230 (match fst style with
2231 | Err -> pr "void\n"
2232 | RInt _ -> pr "SV *\n"
2233 | RBool _ -> pr "SV *\n"
2234 | RConstString _ -> pr "SV *\n"
2235 | RString _ -> pr "SV *\n"
2238 | RPVList _ | RVGList _ | RLVList _ ->
2239 pr "void\n" (* all lists returned implictly on the stack *)
2241 (* Call and arguments. *)
2243 generate_call_args ~handle:"g" style;
2245 pr " guestfs_h *g;\n";
2248 | String n -> pr " char *%s;\n" n
2249 | OptString n -> pr " char *%s;\n" n
2250 | Bool n -> pr " int %s;\n" n
2251 | Int n -> pr " int %s;\n" n
2254 (match fst style with
2257 pr " if (guestfs_%s " name;
2258 generate_call_args ~handle:"g" style;
2260 pr " croak (\"%s: %%s\", last_error);\n" name
2266 pr " %s = guestfs_%s " n name;
2267 generate_call_args ~handle:"g" style;
2269 pr " if (%s == -1)\n" n;
2270 pr " croak (\"%s: %%s\", last_error);\n" name;
2271 pr " RETVAL = newSViv (%s);\n" n;
2276 pr " const char *%s;\n" n;
2278 pr " %s = guestfs_%s " n name;
2279 generate_call_args ~handle:"g" style;
2281 pr " if (%s == NULL)\n" n;
2282 pr " croak (\"%s: %%s\", last_error);\n" name;
2283 pr " RETVAL = newSVpv (%s, 0);\n" n;
2288 pr " char *%s;\n" n;
2290 pr " %s = guestfs_%s " n name;
2291 generate_call_args ~handle:"g" style;
2293 pr " if (%s == NULL)\n" n;
2294 pr " croak (\"%s: %%s\", last_error);\n" name;
2295 pr " RETVAL = newSVpv (%s, 0);\n" n;
2296 pr " free (%s);\n" n;
2301 pr " char **%s;\n" n;
2304 pr " %s = guestfs_%s " n name;
2305 generate_call_args ~handle:"g" style;
2307 pr " if (%s == NULL)\n" n;
2308 pr " croak (\"%s: %%s\", last_error);\n" name;
2309 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2310 pr " EXTEND (SP, n);\n";
2311 pr " for (i = 0; i < n; ++i) {\n";
2312 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2313 pr " free (%s[i]);\n" n;
2315 pr " free (%s);\n" n;
2318 pr " struct guestfs_int_bool *r;\n";
2320 pr " r = guestfs_%s " name;
2321 generate_call_args ~handle:"g" style;
2323 pr " if (r == NULL)\n";
2324 pr " croak (\"%s: %%s\", last_error);\n" name;
2325 pr " EXTEND (SP, 2);\n";
2326 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
2327 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
2328 pr " guestfs_free_int_bool (r);\n";
2330 generate_perl_lvm_code "pv" pv_cols name style n;
2332 generate_perl_lvm_code "vg" vg_cols name style n;
2334 generate_perl_lvm_code "lv" lv_cols name style n;
2339 and generate_perl_lvm_code typ cols name style n =
2341 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2345 pr " %s = guestfs_%s " n name;
2346 generate_call_args ~handle:"g" style;
2348 pr " if (%s == NULL)\n" n;
2349 pr " croak (\"%s: %%s\", last_error);\n" name;
2350 pr " EXTEND (SP, %s->len);\n" n;
2351 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2352 pr " hv = newHV ();\n";
2356 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2357 name (String.length name) n name
2359 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2360 name (String.length name) n name
2362 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2363 name (String.length name) n name
2365 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2366 name (String.length name) n name
2367 | name, `OptPercent ->
2368 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2369 name (String.length name) n name
2371 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2373 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2375 (* Generate Sys/Guestfs.pm. *)
2376 and generate_perl_pm () =
2377 generate_header HashStyle LGPLv2;
2384 Sys::Guestfs - Perl bindings for libguestfs
2390 my $h = Sys::Guestfs->new ();
2391 $h->add_drive ('guest.img');
2394 $h->mount ('/dev/sda1', '/');
2395 $h->touch ('/hello');
2400 The C<Sys::Guestfs> module provides a Perl XS binding to the
2401 libguestfs API for examining and modifying virtual machine
2404 Amongst the things this is good for: making batch configuration
2405 changes to guests, getting disk used/free statistics (see also:
2406 virt-df), migrating between virtualization systems (see also:
2407 virt-p2v), performing partial backups, performing partial guest
2408 clones, cloning guests and changing registry/UUID/hostname info, and
2411 Libguestfs uses Linux kernel and qemu code, and can access any type of
2412 guest filesystem that Linux and qemu can, including but not limited
2413 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2414 schemes, qcow, qcow2, vmdk.
2416 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2417 LVs, what filesystem is in each LV, etc.). It can also run commands
2418 in the context of the guest. Also you can access filesystems over FTP.
2422 All errors turn into calls to C<croak> (see L<Carp(3)>).
2430 package Sys::Guestfs;
2436 XSLoader::load ('Sys::Guestfs');
2438 =item $h = Sys::Guestfs->new ();
2440 Create a new guestfs handle.
2446 my $class = ref ($proto) || $proto;
2448 my $self = Sys::Guestfs::_create ();
2449 bless $self, $class;
2455 (* Actions. We only need to print documentation for these as
2456 * they are pulled in from the XS code automatically.
2459 fun (name, style, _, flags, _, longdesc) ->
2460 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2462 generate_perl_prototype name style;
2464 pr "%s\n\n" longdesc;
2465 if List.mem ProtocolLimitWarning flags then
2466 pr "Because of the message protocol, there is a transfer limit
2467 of somewhere between 2MB and 4MB. To transfer large files you should use
2469 ) all_functions_sorted;
2481 Copyright (C) 2009 Red Hat Inc.
2485 Please see the file COPYING.LIB for the full license.
2489 L<guestfs(3)>, L<guestfish(1)>.
2494 and generate_perl_prototype name style =
2495 (match fst style with
2500 | RString n -> pr "$%s = " n
2501 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
2505 | RLVList n -> pr "@%s = " n
2508 let comma = ref false in
2511 if !comma then pr ", ";
2513 pr "%s" (name_of_argt arg)
2517 let output_to filename =
2518 let filename_new = filename ^ ".new" in
2519 chan := open_out filename_new;
2523 Unix.rename filename_new filename;
2524 printf "written %s\n%!" filename;
2532 let close = output_to "src/guestfs_protocol.x" in
2536 let close = output_to "src/guestfs-structs.h" in
2537 generate_structs_h ();
2540 let close = output_to "src/guestfs-actions.h" in
2541 generate_actions_h ();
2544 let close = output_to "src/guestfs-actions.c" in
2545 generate_client_actions ();
2548 let close = output_to "daemon/actions.h" in
2549 generate_daemon_actions_h ();
2552 let close = output_to "daemon/stubs.c" in
2553 generate_daemon_actions ();
2556 let close = output_to "fish/cmds.c" in
2557 generate_fish_cmds ();
2560 let close = output_to "guestfs-structs.pod" in
2561 generate_structs_pod ();
2564 let close = output_to "guestfs-actions.pod" in
2565 generate_actions_pod ();
2568 let close = output_to "guestfish-actions.pod" in
2569 generate_fish_actions_pod ();
2572 let close = output_to "ocaml/guestfs.mli" in
2573 generate_ocaml_mli ();
2576 let close = output_to "ocaml/guestfs.ml" in
2577 generate_ocaml_ml ();
2580 let close = output_to "ocaml/guestfs_c_actions.c" in
2581 generate_ocaml_c ();
2584 let close = output_to "perl/Guestfs.xs" in
2585 generate_perl_xs ();
2588 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2589 generate_perl_pm ();