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 (* "RBool" is a bool return value which can be true/false or
39 (* "RConstString" is a string that refers to a constant value.
40 * Try to avoid using this.
42 | RConstString of string
43 (* "RString" and "RStringList" are caller-frees. *)
45 | RStringList of string
46 (* LVM PVs, VGs and LVs. *)
51 (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
56 | String of string (* const char *name, cannot be NULL *)
57 | OptString of string (* const char *name, may be NULL *)
58 | Bool of string (* boolean *)
61 | ProtocolLimitWarning (* display warning about protocol size limits *)
62 | FishAlias of string (* provide an alias for this cmd in guestfish *)
63 | FishAction of string (* call this function in guestfish *)
64 | NotInFish (* do not export via guestfish *)
66 (* Note about long descriptions: When referring to another
67 * action, use the format C<guestfs_other> (ie. the full name of
68 * the C function). This will be replaced as appropriate in other
71 * Apart from that, long descriptions are just perldoc paragraphs.
74 let non_daemon_functions = [
75 ("launch", (Err, P0), -1, [FishAlias "run"; FishAction "launch"],
76 "launch the qemu subprocess",
78 Internally libguestfs is implemented by running a virtual machine
81 You should call this after configuring the handle
82 (eg. adding drives) but before performing any actions.");
84 ("wait_ready", (Err, P0), -1, [NotInFish],
85 "wait until the qemu subprocess launches",
87 Internally libguestfs is implemented by running a virtual machine
90 You should call this after C<guestfs_launch> to wait for the launch
93 ("kill_subprocess", (Err, P0), -1, [],
94 "kill the qemu subprocess",
96 This kills the qemu subprocess. You should never need to call this.");
98 ("add_drive", (Err, P1 (String "filename")), -1, [FishAlias "add"],
99 "add an image to examine or modify",
101 This function adds a virtual machine disk image C<filename> to the
102 guest. The first time you call this function, the disk appears as IDE
103 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
106 You don't necessarily need to be root when using libguestfs. However
107 you obviously do need sufficient permissions to access the filename
108 for whatever operations you want to perform (ie. read access if you
109 just want to read the image or write access if you want to modify the
112 This is equivalent to the qemu parameter C<-drive file=filename>.");
114 ("add_cdrom", (Err, P1 (String "filename")), -1, [FishAlias "cdrom"],
115 "add a CD-ROM disk image to examine",
117 This function adds a virtual CD-ROM disk image to the guest.
119 This is equivalent to the qemu parameter C<-cdrom filename>.");
121 ("config", (Err, P2 (String "qemuparam", OptString "qemuvalue")), -1, [],
122 "add qemu parameters",
124 This can be used to add arbitrary qemu command line parameters
125 of the form C<-param value>. Actually it's not quite arbitrary - we
126 prevent you from setting some parameters which would interfere with
127 parameters that we use.
129 The first character of C<param> string must be a C<-> (dash).
131 C<value> can be NULL.");
133 ("set_path", (Err, P1 (String "path")), -1, [FishAlias "path"],
134 "set the search path",
136 Set the path that libguestfs searches for kernel and initrd.img.
138 The default is C<$libdir/guestfs> unless overridden by setting
139 C<LIBGUESTFS_PATH> environment variable.
141 The string C<path> is stashed in the libguestfs handle, so the caller
142 must make sure it remains valid for the lifetime of the handle.
144 Setting C<path> to C<NULL> restores the default path.");
146 ("get_path", (RConstString "path", P0), -1, [],
147 "get the search path",
149 Return the current search path.
151 This is always non-NULL. If it wasn't set already, then this will
152 return the default path.");
154 ("set_autosync", (Err, P1 (Bool "autosync")), -1, [FishAlias "autosync"],
157 If C<autosync> is true, this enables autosync. Libguestfs will make a
158 best effort attempt to run C<guestfs_sync> when the handle is closed
159 (also if the program exits without closing handles).");
161 ("get_autosync", (RBool "autosync", P0), -1, [],
164 Get the autosync flag.");
166 ("set_verbose", (Err, P1 (Bool "verbose")), -1, [FishAlias "verbose"],
169 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
171 Verbose messages are disabled unless the environment variable
172 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
174 ("get_verbose", (RBool "verbose", P0), -1, [],
177 This returns the verbose messages flag.")
180 let daemon_functions = [
181 ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
182 "mount a guest disk at a position in the filesystem",
184 Mount a guest disk at a position in the filesystem. Block devices
185 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
186 the guest. If those block devices contain partitions, they will have
187 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
190 The rules are the same as for L<mount(2)>: A filesystem must
191 first be mounted on C</> before others can be mounted. Other
192 filesystems can only be mounted on directories which already
195 The mounted filesystem is writable, if we have sufficient permissions
196 on the underlying device.
198 The filesystem options C<sync> and C<noatime> are set with this
199 call, in order to improve reliability.");
201 ("sync", (Err, P0), 2, [],
202 "sync disks, writes are flushed through to the disk image",
204 This syncs the disk, so that any writes are flushed through to the
205 underlying disk image.
207 You should always call this if you have modified a disk image, before
208 closing the handle.");
210 ("touch", (Err, P1 (String "path")), 3, [],
211 "update file timestamps or create a new file",
213 Touch acts like the L<touch(1)> command. It can be used to
214 update the timestamps on a file, or, if the file does not exist,
215 to create a new zero-length file.");
217 ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
218 "list the contents of a file",
220 Return the contents of the file named C<path>.
222 Note that this function cannot correctly handle binary files
223 (specifically, files containing C<\\0> character which is treated
224 as end of string). For those you need to use the C<guestfs_read_file>
225 function which has a more complex interface.");
227 ("ll", (RString "listing", P1 (String "directory")), 5, [],
228 "list the files in a directory (long format)",
230 List the files in C<directory> (relative to the root directory,
231 there is no cwd) in the format of 'ls -la'.
233 This command is mostly useful for interactive sessions. It
234 is I<not> intended that you try to parse the output string.");
236 ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
237 "list the files in a directory",
239 List the files in C<directory> (relative to the root directory,
240 there is no cwd). The '.' and '..' entries are not returned, but
241 hidden files are shown.
243 This command is mostly useful for interactive sessions. Programs
244 should probably use C<guestfs_readdir> instead.");
246 ("list_devices", (RStringList "devices", P0), 7, [],
247 "list the block devices",
249 List all the block devices.
251 The full block device names are returned, eg. C</dev/sda>");
253 ("list_partitions", (RStringList "partitions", P0), 8, [],
254 "list the partitions",
256 List all the partitions detected on all block devices.
258 The full partition device names are returned, eg. C</dev/sda1>
260 This does not return logical volumes. For that you will need to
261 call C<guestfs_lvs>.");
263 ("pvs", (RStringList "physvols", P0), 9, [],
264 "list the LVM physical volumes (PVs)",
266 List all the physical volumes detected. This is the equivalent
267 of the L<pvs(8)> command.
269 This returns a list of just the device names that contain
270 PVs (eg. C</dev/sda2>).
272 See also C<guestfs_pvs_full>.");
274 ("vgs", (RStringList "volgroups", P0), 10, [],
275 "list the LVM volume groups (VGs)",
277 List all the volumes groups detected. This is the equivalent
278 of the L<vgs(8)> command.
280 This returns a list of just the volume group names that were
281 detected (eg. C<VolGroup00>).
283 See also C<guestfs_vgs_full>.");
285 ("lvs", (RStringList "logvols", P0), 11, [],
286 "list the LVM logical volumes (LVs)",
288 List all the logical volumes detected. This is the equivalent
289 of the L<lvs(8)> command.
291 This returns a list of the logical volume device names
292 (eg. C</dev/VolGroup00/LogVol00>).
294 See also C<guestfs_lvs_full>.");
296 ("pvs_full", (RPVList "physvols", P0), 12, [],
297 "list the LVM physical volumes (PVs)",
299 List all the physical volumes detected. This is the equivalent
300 of the L<pvs(8)> command. The \"full\" version includes all fields.");
302 ("vgs_full", (RVGList "volgroups", P0), 13, [],
303 "list the LVM volume groups (VGs)",
305 List all the volumes groups detected. This is the equivalent
306 of the L<vgs(8)> command. The \"full\" version includes all fields.");
308 ("lvs_full", (RLVList "logvols", P0), 14, [],
309 "list the LVM logical volumes (LVs)",
311 List all the logical volumes detected. This is the equivalent
312 of the L<lvs(8)> command. The \"full\" version includes all fields.");
314 ("read_lines", (RStringList "lines", P1 (String "path")), 15, [],
315 "read file as lines",
317 Return the contents of the file named C<path>.
319 The file contents are returned as a list of lines. Trailing
320 C<LF> and C<CRLF> character sequences are I<not> returned.
322 Note that this function cannot correctly handle binary files
323 (specifically, files containing C<\\0> character which is treated
324 as end of line). For those you need to use the C<guestfs_read_file>
325 function which has a more complex interface.");
328 let all_functions = non_daemon_functions @ daemon_functions
330 (* In some places we want the functions to be displayed sorted
331 * alphabetically, so this is useful:
333 let all_functions_sorted =
334 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
336 (* Column names and types from LVM PVs/VGs/LVs. *)
345 "pv_attr", `String (* XXX *);
347 "pv_pe_alloc_count", `Int;
350 "pv_mda_count", `Int;
351 "pv_mda_free", `Bytes;
353 "pv_mda_size", `Bytes;
360 "vg_attr", `String (* XXX *);
364 "vg_extent_size", `Bytes;
365 "vg_extent_count", `Int;
366 "vg_free_count", `Int;
374 "vg_mda_count", `Int;
375 "vg_mda_free", `Bytes;
377 "vg_mda_size", `Bytes;
383 "lv_attr", `String (* XXX *);
386 "lv_kernel_major", `Int;
387 "lv_kernel_minor", `Int;
391 "snap_percent", `OptPercent;
392 "copy_percent", `OptPercent;
395 "mirror_log", `String;
400 * Note we don't want to use any external OCaml libraries which
401 * makes this a bit harder than it should be.
403 let failwithf fs = ksprintf failwith fs
405 let replace_char s c1 c2 =
406 let s2 = String.copy s in
408 for i = 0 to String.length s2 - 1 do
409 if String.unsafe_get s2 i = c1 then (
410 String.unsafe_set s2 i c2;
414 if not !r then s else s2
417 let len = String.length s in
418 let sublen = String.length sub in
420 if i <= len-sublen then (
423 if s.[i+j] = sub.[j] then loop2 (j+1)
429 if r = -1 then loop (i+1) else r
435 let rec replace_str s s1 s2 =
436 let len = String.length s in
437 let sublen = String.length s1 in
441 let s' = String.sub s 0 i in
442 let s'' = String.sub s (i+sublen) (len-i-sublen) in
443 s' ^ s2 ^ replace_str s'' s1 s2
446 let rec find_map f = function
447 | [] -> raise Not_found
451 | None -> find_map f xs
454 let rec loop i = function
456 | x :: xs -> f i x; loop (i+1) xs
460 (* 'pr' prints to the current output file. *)
461 let chan = ref stdout
462 let pr fs = ksprintf (output_string !chan) fs
464 let iter_args f = function
467 | P2 (arg1, arg2) -> f arg1; f arg2
469 let iteri_args f = function
471 | P1 arg1 -> f 0 arg1
472 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
474 let map_args f = function
476 | P1 arg1 -> [f arg1]
477 | P2 (arg1, arg2) -> [f arg1; f arg2]
479 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
481 (* Check function names etc. for consistency. *)
482 let check_functions () =
484 fun (name, _, _, _, _, longdesc) ->
485 if String.contains name '-' then
486 failwithf "function name '%s' should not contain '-', use '_' instead."
488 if longdesc.[String.length longdesc-1] = '\n' then
489 failwithf "long description of %s should not end with \\n." name
493 fun (name, _, proc_nr, _, _, _) ->
495 failwithf "daemon function %s should have proc_nr > 0" name
499 fun (name, _, proc_nr, _, _, _) ->
500 if proc_nr <> -1 then
501 failwithf "non-daemon function %s should have proc_nr -1" name
502 ) non_daemon_functions;
505 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
508 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
509 let rec loop = function
512 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
514 | (name1,nr1) :: (name2,nr2) :: _ ->
515 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
520 type comment_style = CStyle | HashStyle | OCamlStyle
521 type license = GPLv2 | LGPLv2
523 (* Generate a header block in a number of standard styles. *)
524 let rec generate_header comment license =
525 let c = match comment with
526 | CStyle -> pr "/* "; " *"
527 | HashStyle -> pr "# "; "#"
528 | OCamlStyle -> pr "(* "; " *" in
529 pr "libguestfs generated file\n";
530 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
531 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
533 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
537 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
538 pr "%s it under the terms of the GNU General Public License as published by\n" c;
539 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
540 pr "%s (at your option) any later version.\n" c;
542 pr "%s This program is distributed in the hope that it will be useful,\n" c;
543 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
544 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
545 pr "%s GNU General Public License for more details.\n" c;
547 pr "%s You should have received a copy of the GNU General Public License along\n" c;
548 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
549 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
552 pr "%s This library is free software; you can redistribute it and/or\n" c;
553 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
554 pr "%s License as published by the Free Software Foundation; either\n" c;
555 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
557 pr "%s This library is distributed in the hope that it will be useful,\n" c;
558 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
559 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
560 pr "%s Lesser General Public License for more details.\n" c;
562 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
563 pr "%s License along with this library; if not, write to the Free Software\n" c;
564 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
567 | CStyle -> pr " */\n"
569 | OCamlStyle -> pr " *)\n"
573 (* Generate the pod documentation for the C API. *)
574 and generate_actions_pod () =
576 fun (shortname, style, _, flags, _, longdesc) ->
577 let name = "guestfs_" ^ shortname in
578 pr "=head2 %s\n\n" name;
580 generate_prototype ~extern:false ~handle:"handle" name style;
582 pr "%s\n\n" longdesc;
583 (match fst style with
585 pr "This function returns 0 on success or -1 on error.\n\n"
587 pr "This function returns a C truth value on success or -1 on error.\n\n"
589 pr "This function returns a string or NULL on error.
590 The string is owned by the guest handle and must I<not> be freed.\n\n"
592 pr "This function returns a string or NULL on error.
593 I<The caller must free the returned string after use>.\n\n"
595 pr "This function returns a NULL-terminated array of strings
596 (like L<environ(3)>), or NULL if there was an error.
597 I<The caller must free the strings and the array after use>.\n\n"
599 pr "This function returns a C<struct guestfs_lvm_pv_list>.
600 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
602 pr "This function returns a C<struct guestfs_lvm_vg_list>.
603 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
605 pr "This function returns a C<struct guestfs_lvm_lv_list>.
606 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
608 if List.mem ProtocolLimitWarning flags then
609 pr "Because of the message protocol, there is a transfer limit
610 of somewhere between 2MB and 4MB. To transfer large files you should use
612 ) all_functions_sorted
614 and generate_structs_pod () =
615 (* LVM structs documentation. *)
618 pr "=head2 guestfs_lvm_%s\n" typ;
620 pr " struct guestfs_lvm_%s {\n" typ;
623 | name, `String -> pr " char *%s;\n" name
625 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
626 pr " char %s[32];\n" name
627 | name, `Bytes -> pr " uint64_t %s;\n" name
628 | name, `Int -> pr " int64_t %s;\n" name
629 | name, `OptPercent ->
630 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
631 pr " float %s;\n" name
634 pr " struct guestfs_lvm_%s_list {\n" typ;
635 pr " uint32_t len; /* Number of elements in list. */\n";
636 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
639 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
642 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
644 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
645 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
646 * have to use an underscore instead of a dash because otherwise
647 * rpcgen generates incorrect code.
649 * This header is NOT exported to clients, but see also generate_structs_h.
651 and generate_xdr () =
652 generate_header CStyle LGPLv2;
654 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
655 pr "typedef string str<>;\n";
658 (* LVM internal structures. *)
662 pr "struct guestfs_lvm_int_%s {\n" typ;
664 | name, `String -> pr " string %s<>;\n" name
665 | name, `UUID -> pr " opaque %s[32];\n" name
666 | name, `Bytes -> pr " hyper %s;\n" name
667 | name, `Int -> pr " hyper %s;\n" name
668 | name, `OptPercent -> pr " float %s;\n" name
672 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
674 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
677 fun(shortname, style, _, _, _, _) ->
678 let name = "guestfs_" ^ shortname in
679 pr "/* %s */\n\n" name;
680 (match snd style with
683 pr "struct %s_args {\n" name;
686 | String name -> pr " string %s<>;\n" name
687 | OptString name -> pr " string *%s<>;\n" name
688 | Bool name -> pr " bool %s;\n" name
692 (match fst style with
695 pr "struct %s_ret {\n" name;
699 failwithf "RConstString cannot be returned from a daemon function"
701 pr "struct %s_ret {\n" name;
702 pr " string %s<>;\n" n;
705 pr "struct %s_ret {\n" name;
709 pr "struct %s_ret {\n" name;
710 pr " guestfs_lvm_int_pv_list %s;\n" n;
713 pr "struct %s_ret {\n" name;
714 pr " guestfs_lvm_int_vg_list %s;\n" n;
717 pr "struct %s_ret {\n" name;
718 pr " guestfs_lvm_int_lv_list %s;\n" n;
723 (* Table of procedure numbers. *)
724 pr "enum guestfs_procedure {\n";
726 fun (shortname, _, proc_nr, _, _, _) ->
727 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
729 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
733 (* Having to choose a maximum message size is annoying for several
734 * reasons (it limits what we can do in the API), but it (a) makes
735 * the protocol a lot simpler, and (b) provides a bound on the size
736 * of the daemon which operates in limited memory space. For large
737 * file transfers you should use FTP.
739 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
742 (* Message header, etc. *)
744 const GUESTFS_PROGRAM = 0x2000F5F5;
745 const GUESTFS_PROTOCOL_VERSION = 1;
747 enum guestfs_message_direction {
748 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
749 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
752 enum guestfs_message_status {
753 GUESTFS_STATUS_OK = 0,
754 GUESTFS_STATUS_ERROR = 1
757 const GUESTFS_ERROR_LEN = 256;
759 struct guestfs_message_error {
760 string error<GUESTFS_ERROR_LEN>; /* error message */
763 struct guestfs_message_header {
764 unsigned prog; /* GUESTFS_PROGRAM */
765 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
766 guestfs_procedure proc; /* GUESTFS_PROC_x */
767 guestfs_message_direction direction;
768 unsigned serial; /* message serial number */
769 guestfs_message_status status;
773 (* Generate the guestfs-structs.h file. *)
774 and generate_structs_h () =
775 generate_header CStyle LGPLv2;
777 (* This is a public exported header file containing various
778 * structures. The structures are carefully written to have
779 * exactly the same in-memory format as the XDR structures that
780 * we use on the wire to the daemon. The reason for creating
781 * copies of these structures here is just so we don't have to
782 * export the whole of guestfs_protocol.h (which includes much
783 * unrelated and XDR-dependent stuff that we don't want to be
784 * public, or required by clients).
786 * To reiterate, we will pass these structures to and from the
787 * client with a simple assignment or memcpy, so the format
788 * must be identical to what rpcgen / the RFC defines.
791 (* LVM public structures. *)
795 pr "struct guestfs_lvm_%s {\n" typ;
798 | name, `String -> pr " char *%s;\n" name
799 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
800 | name, `Bytes -> pr " uint64_t %s;\n" name
801 | name, `Int -> pr " int64_t %s;\n" name
802 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
806 pr "struct guestfs_lvm_%s_list {\n" typ;
807 pr " uint32_t len;\n";
808 pr " struct guestfs_lvm_%s *val;\n" typ;
811 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
813 (* Generate the guestfs-actions.h file. *)
814 and generate_actions_h () =
815 generate_header CStyle LGPLv2;
817 fun (shortname, style, _, _, _, _) ->
818 let name = "guestfs_" ^ shortname in
819 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
823 (* Generate the client-side dispatch stubs. *)
824 and generate_client_actions () =
825 generate_header CStyle LGPLv2;
827 (* Client-side stubs for each function. *)
829 fun (shortname, style, _, _, _, _) ->
830 let name = "guestfs_" ^ shortname in
832 (* Generate the return value struct. *)
833 pr "struct %s_rv {\n" shortname;
834 pr " int cb_done; /* flag to indicate callback was called */\n";
835 pr " struct guestfs_message_header hdr;\n";
836 pr " struct guestfs_message_error err;\n";
837 (match fst style with
840 failwithf "RConstString cannot be returned from a daemon function"
841 | RBool _ | RString _ | RStringList _
842 | RPVList _ | RVGList _ | RLVList _ ->
843 pr " struct %s_ret ret;\n" name
847 (* Generate the callback function. *)
848 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
850 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
852 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
853 pr " error (g, \"%s: failed to parse reply header\");\n" name;
856 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
857 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
858 pr " error (g, \"%s: failed to parse reply error\");\n" name;
864 (match fst style with
867 failwithf "RConstString cannot be returned from a daemon function"
868 | RBool _ | RString _ | RStringList _
869 | RPVList _ | RVGList _ | RLVList _ ->
870 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
871 pr " error (g, \"%s: failed to parse reply\");\n" name;
877 pr " rv->cb_done = 1;\n";
878 pr " main_loop.main_loop_quit (g);\n";
881 (* Generate the action stub. *)
882 generate_prototype ~extern:false ~semicolon:false ~newline:true
883 ~handle:"g" name style;
887 | Err | RBool _ -> "-1"
889 failwithf "RConstString cannot be returned from a daemon function"
890 | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
895 (match snd style with
897 | _ -> pr " struct %s_args args;\n" name
900 pr " struct %s_rv rv;\n" shortname;
903 pr " if (g->state != READY) {\n";
904 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
907 pr " return %s;\n" error_code;
910 pr " memset (&rv, 0, sizeof rv);\n";
913 (match snd style with
915 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
916 (String.uppercase shortname)
921 pr " args.%s = (char *) %s;\n" name name
923 pr " args.%s = %s ? *%s : NULL;\n" name name name
925 pr " args.%s = %s;\n" name name
927 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
928 (String.uppercase shortname);
929 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
932 pr " if (serial == -1)\n";
933 pr " return %s;\n" error_code;
936 pr " rv.cb_done = 0;\n";
937 pr " g->reply_cb_internal = %s_cb;\n" shortname;
938 pr " g->reply_cb_internal_data = &rv;\n";
939 pr " main_loop.main_loop_run (g);\n";
940 pr " g->reply_cb_internal = NULL;\n";
941 pr " g->reply_cb_internal_data = NULL;\n";
942 pr " if (!rv.cb_done) {\n";
943 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
944 pr " return %s;\n" error_code;
948 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
949 (String.uppercase shortname);
950 pr " return %s;\n" error_code;
953 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
954 pr " error (g, \"%%s\", rv.err.error);\n";
955 pr " return %s;\n" error_code;
959 (match fst style with
960 | Err -> pr " return 0;\n"
961 | RBool n -> pr " return rv.ret.%s;\n" n
963 failwithf "RConstString cannot be returned from a daemon function"
965 pr " return rv.ret.%s; /* caller will free */\n" n
967 pr " /* caller will free this, but we need to add a NULL entry */\n";
968 pr " rv.ret.%s.%s_val =" n n;
969 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
970 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
972 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
973 pr " return rv.ret.%s.%s_val;\n" n n
975 pr " /* caller will free this */\n";
976 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
978 pr " /* caller will free this */\n";
979 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
981 pr " /* caller will free this */\n";
982 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
988 (* Generate daemon/actions.h. *)
989 and generate_daemon_actions_h () =
990 generate_header CStyle GPLv2;
992 pr "#include \"../src/guestfs_protocol.h\"\n";
996 fun (name, style, _, _, _, _) ->
998 ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
1001 (* Generate the server-side stubs. *)
1002 and generate_daemon_actions () =
1003 generate_header CStyle GPLv2;
1005 pr "#define _GNU_SOURCE // for strchrnul\n";
1007 pr "#include <stdio.h>\n";
1008 pr "#include <stdlib.h>\n";
1009 pr "#include <string.h>\n";
1010 pr "#include <inttypes.h>\n";
1011 pr "#include <ctype.h>\n";
1012 pr "#include <rpc/types.h>\n";
1013 pr "#include <rpc/xdr.h>\n";
1015 pr "#include \"daemon.h\"\n";
1016 pr "#include \"../src/guestfs_protocol.h\"\n";
1017 pr "#include \"actions.h\"\n";
1021 fun (name, style, _, _, _, _) ->
1022 (* Generate server-side stubs. *)
1023 pr "static void %s_stub (XDR *xdr_in)\n" name;
1026 match fst style with
1027 | Err -> pr " int r;\n"; "-1"
1028 | RBool _ -> pr " int r;\n"; "-1"
1030 failwithf "RConstString cannot be returned from a daemon function"
1031 | RString _ -> pr " char *r;\n"; "NULL"
1032 | RStringList _ -> pr " char **r;\n"; "NULL"
1033 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1034 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1035 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1037 (match snd style with
1040 pr " struct guestfs_%s_args args;\n" name;
1044 | OptString name -> pr " const char *%s;\n" name
1045 | Bool name -> pr " int %s;\n" name
1050 (match snd style with
1053 pr " memset (&args, 0, sizeof args);\n";
1055 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1056 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
1061 | String name -> pr " %s = args.%s;\n" name name
1062 | OptString name -> pr " %s = args.%s;\n" name name (* XXX? *)
1063 | Bool name -> pr " %s = args.%s;\n" name name
1068 pr " r = do_%s " name;
1069 generate_call_args style;
1072 pr " if (r == %s)\n" error_code;
1073 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1077 (match fst style with
1078 | Err -> pr " reply (NULL, NULL);\n"
1080 pr " struct guestfs_%s_ret ret;\n" name;
1081 pr " ret.%s = r;\n" n;
1082 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1084 failwithf "RConstString cannot be returned from a daemon function"
1086 pr " struct guestfs_%s_ret ret;\n" name;
1087 pr " ret.%s = r;\n" n;
1088 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1091 pr " struct guestfs_%s_ret ret;\n" name;
1092 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1093 pr " ret.%s.%s_val = r;\n" n n;
1094 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1095 pr " free_strings (r);\n"
1097 pr " struct guestfs_%s_ret ret;\n" name;
1098 pr " ret.%s = *r;\n" n;
1099 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1100 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1102 pr " struct guestfs_%s_ret ret;\n" name;
1103 pr " ret.%s = *r;\n" n;
1104 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1105 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1107 pr " struct guestfs_%s_ret ret;\n" name;
1108 pr " ret.%s = *r;\n" n;
1109 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1110 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1116 (* Dispatch function. *)
1117 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1119 pr " switch (proc_nr) {\n";
1122 fun (name, style, _, _, _, _) ->
1123 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1124 pr " %s_stub (xdr_in);\n" name;
1129 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1134 (* LVM columns and tokenization functions. *)
1135 (* XXX This generates crap code. We should rethink how we
1141 pr "static const char *lvm_%s_cols = \"%s\";\n"
1142 typ (String.concat "," (List.map fst cols));
1145 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1147 pr " char *tok, *p, *next;\n";
1151 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1154 pr " if (!str) {\n";
1155 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1158 pr " if (!*str || isspace (*str)) {\n";
1159 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1164 fun (name, coltype) ->
1165 pr " if (!tok) {\n";
1166 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1169 pr " p = strchrnul (tok, ',');\n";
1170 pr " if (*p) next = p+1; else next = NULL;\n";
1171 pr " *p = '\\0';\n";
1174 pr " r->%s = strdup (tok);\n" name;
1175 pr " if (r->%s == NULL) {\n" name;
1176 pr " perror (\"strdup\");\n";
1180 pr " for (i = j = 0; i < 32; ++j) {\n";
1181 pr " if (tok[j] == '\\0') {\n";
1182 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1184 pr " } else if (tok[j] != '-')\n";
1185 pr " r->%s[i++] = tok[j];\n" name;
1188 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1189 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1193 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1194 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1198 pr " if (tok[0] == '\\0')\n";
1199 pr " r->%s = -1;\n" name;
1200 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1201 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1205 pr " tok = next;\n";
1208 pr " if (tok != NULL) {\n";
1209 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1216 pr "guestfs_lvm_int_%s_list *\n" typ;
1217 pr "parse_command_line_%ss (void)\n" typ;
1219 pr " char *out, *err;\n";
1220 pr " char *p, *pend;\n";
1222 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1223 pr " void *newp;\n";
1225 pr " ret = malloc (sizeof *ret);\n";
1226 pr " if (!ret) {\n";
1227 pr " reply_with_perror (\"malloc\");\n";
1228 pr " return NULL;\n";
1231 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1232 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1234 pr " r = command (&out, &err,\n";
1235 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1236 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1237 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1238 pr " if (r == -1) {\n";
1239 pr " reply_with_error (\"%%s\", err);\n";
1240 pr " free (out);\n";
1241 pr " free (err);\n";
1242 pr " return NULL;\n";
1245 pr " free (err);\n";
1247 pr " /* Tokenize each line of the output. */\n";
1250 pr " while (p) {\n";
1251 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1252 pr " if (pend) {\n";
1253 pr " *pend = '\\0';\n";
1257 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1260 pr " if (!*p) { /* Empty line? Skip it. */\n";
1265 pr " /* Allocate some space to store this next entry. */\n";
1266 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1267 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1268 pr " if (newp == NULL) {\n";
1269 pr " reply_with_perror (\"realloc\");\n";
1270 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1271 pr " free (ret);\n";
1272 pr " free (out);\n";
1273 pr " return NULL;\n";
1275 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1277 pr " /* Tokenize the next entry. */\n";
1278 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1279 pr " if (r == -1) {\n";
1280 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1281 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1282 pr " free (ret);\n";
1283 pr " free (out);\n";
1284 pr " return NULL;\n";
1291 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1293 pr " free (out);\n";
1294 pr " return ret;\n";
1297 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1299 (* Generate a lot of different functions for guestfish. *)
1300 and generate_fish_cmds () =
1301 generate_header CStyle GPLv2;
1305 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1307 let all_functions_sorted =
1309 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1310 ) all_functions_sorted in
1312 pr "#include <stdio.h>\n";
1313 pr "#include <stdlib.h>\n";
1314 pr "#include <string.h>\n";
1315 pr "#include <inttypes.h>\n";
1317 pr "#include <guestfs.h>\n";
1318 pr "#include \"fish.h\"\n";
1321 (* list_commands function, which implements guestfish -h *)
1322 pr "void list_commands (void)\n";
1324 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1325 pr " list_builtin_commands ();\n";
1327 fun (name, _, _, flags, shortdesc, _) ->
1328 let name = replace_char name '_' '-' in
1329 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1331 ) all_functions_sorted;
1332 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1336 (* display_command function, which implements guestfish -h cmd *)
1337 pr "void display_command (const char *cmd)\n";
1340 fun (name, style, _, flags, shortdesc, longdesc) ->
1341 let name2 = replace_char name '_' '-' in
1343 try find_map (function FishAlias n -> Some n | _ -> None) flags
1344 with Not_found -> name in
1345 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1347 match snd style with
1352 String.concat "> <" (
1354 | String n | OptString n | Bool n -> n) args
1359 if List.mem ProtocolLimitWarning flags then
1360 "\n\nBecause of the message protocol, there is a transfer limit
1361 of somewhere between 2MB and 4MB. To transfer large files you should use
1365 let describe_alias =
1366 if name <> alias then
1367 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1371 pr "strcasecmp (cmd, \"%s\") == 0" name;
1372 if name <> name2 then
1373 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1374 if name <> alias then
1375 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1377 pr " pod2text (\"%s - %s\", %S);\n"
1379 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1382 pr " display_builtin_command (cmd);\n";
1386 (* print_{pv,vg,lv}_list functions *)
1390 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1397 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1399 pr " printf (\"%s: \");\n" name;
1400 pr " for (i = 0; i < 32; ++i)\n";
1401 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1402 pr " printf (\"\\n\");\n"
1404 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1406 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1407 | name, `OptPercent ->
1408 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1409 typ name name typ name;
1410 pr " else printf (\"%s: \\n\");\n" name
1414 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1419 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1420 pr " print_%s (&%ss->val[i]);\n" typ typ;
1423 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1425 (* run_<action> actions *)
1427 fun (name, style, _, flags, _, _) ->
1428 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1430 (match fst style with
1432 | RBool _ -> pr " int r;\n"
1433 | RConstString _ -> pr " const char *r;\n"
1434 | RString _ -> pr " char *r;\n"
1435 | RStringList _ -> pr " char **r;\n"
1436 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1437 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1438 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1442 | String name -> pr " const char *%s;\n" name
1443 | OptString name -> pr " const char *%s;\n" name
1444 | Bool name -> pr " int %s;\n" name
1447 (* Check and convert parameters. *)
1448 let argc_expected = nr_args (snd style) in
1449 pr " if (argc != %d) {\n" argc_expected;
1450 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1452 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1458 | String name -> pr " %s = argv[%d];\n" name i
1460 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1463 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1466 (* Call C API function. *)
1468 try find_map (function FishAction n -> Some n | _ -> None) flags
1469 with Not_found -> sprintf "guestfs_%s" name in
1471 generate_call_args ~handle:"g" style;
1474 (* Check return value for errors and display command results. *)
1475 (match fst style with
1476 | Err -> pr " return r;\n"
1478 pr " if (r == -1) return -1;\n";
1479 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1482 pr " if (r == NULL) return -1;\n";
1483 pr " printf (\"%%s\\n\", r);\n";
1486 pr " if (r == NULL) return -1;\n";
1487 pr " printf (\"%%s\\n\", r);\n";
1491 pr " if (r == NULL) return -1;\n";
1492 pr " print_strings (r);\n";
1493 pr " free_strings (r);\n";
1496 pr " if (r == NULL) return -1;\n";
1497 pr " print_pv_list (r);\n";
1498 pr " guestfs_free_lvm_pv_list (r);\n";
1501 pr " if (r == NULL) return -1;\n";
1502 pr " print_vg_list (r);\n";
1503 pr " guestfs_free_lvm_vg_list (r);\n";
1506 pr " if (r == NULL) return -1;\n";
1507 pr " print_lv_list (r);\n";
1508 pr " guestfs_free_lvm_lv_list (r);\n";
1515 (* run_action function *)
1516 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1519 fun (name, _, _, flags, _, _) ->
1520 let name2 = replace_char name '_' '-' in
1522 try find_map (function FishAlias n -> Some n | _ -> None) flags
1523 with Not_found -> name in
1525 pr "strcasecmp (cmd, \"%s\") == 0" name;
1526 if name <> name2 then
1527 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1528 if name <> alias then
1529 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1531 pr " return run_%s (cmd, argc, argv);\n" name;
1535 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1542 (* Generate the POD documentation for guestfish. *)
1543 and generate_fish_actions_pod () =
1544 let all_functions_sorted =
1546 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1547 ) all_functions_sorted in
1550 fun (name, style, _, flags, _, longdesc) ->
1551 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1552 let name = replace_char name '_' '-' in
1554 try find_map (function FishAlias n -> Some n | _ -> None) flags
1555 with Not_found -> name in
1557 pr "=head2 %s" name;
1558 if name <> alias then
1565 | String n -> pr " %s" n
1566 | OptString n -> pr " %s" n
1567 | Bool _ -> pr " true|false"
1571 pr "%s\n\n" longdesc
1572 ) all_functions_sorted
1574 (* Generate a C function prototype. *)
1575 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1576 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1577 ?handle name style =
1578 if extern then pr "extern ";
1579 if static then pr "static ";
1580 (match fst style with
1582 | RBool _ -> pr "int "
1583 | RConstString _ -> pr "const char *"
1584 | RString _ -> pr "char *"
1585 | RStringList _ -> pr "char **"
1587 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1588 else pr "guestfs_lvm_int_pv_list *"
1590 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1591 else pr "guestfs_lvm_int_vg_list *"
1593 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1594 else pr "guestfs_lvm_int_lv_list *"
1597 let comma = ref false in
1600 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1604 if single_line then pr ", " else pr ",\n\t\t"
1610 | String name -> next (); pr "const char *%s" name
1611 | OptString name -> next (); pr "const char *%s" name
1612 | Bool name -> next (); pr "int %s" name
1615 if semicolon then pr ";";
1616 if newline then pr "\n"
1618 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1619 and generate_call_args ?handle style =
1621 let comma = ref false in
1624 | Some handle -> pr "%s" handle; comma := true
1628 if !comma then pr ", ";
1631 | String name -> pr "%s" name
1632 | OptString name -> pr "%s" name
1633 | Bool name -> pr "%s" name
1637 (* Generate the OCaml bindings interface. *)
1638 and generate_ocaml_mli () =
1639 generate_header OCamlStyle LGPLv2;
1642 (** For API documentation you should refer to the C API
1643 in the guestfs(3) manual page. The OCaml API uses almost
1644 exactly the same calls. *)
1647 (** A [guestfs_h] handle. *)
1649 exception Error of string
1650 (** This exception is raised when there is an error. *)
1652 val create : unit -> t
1654 val close : t -> unit
1655 (** Handles are closed by the garbage collector when they become
1656 unreferenced, but callers can also call this in order to
1657 provide predictable cleanup. *)
1660 generate_ocaml_lvm_structure_decls ();
1664 fun (name, style, _, _, shortdesc, _) ->
1665 generate_ocaml_prototype name style;
1666 pr "(** %s *)\n" shortdesc;
1670 (* Generate the OCaml bindings implementation. *)
1671 and generate_ocaml_ml () =
1672 generate_header OCamlStyle LGPLv2;
1676 exception Error of string
1677 external create : unit -> t = \"ocaml_guestfs_create\"
1678 external close : t -> unit = \"ocaml_guestfs_close\"
1681 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1685 generate_ocaml_lvm_structure_decls ();
1689 fun (name, style, _, _, shortdesc, _) ->
1690 generate_ocaml_prototype ~is_external:true name style;
1693 (* Generate the OCaml bindings C implementation. *)
1694 and generate_ocaml_c () =
1695 generate_header CStyle LGPLv2;
1697 pr "#include <stdio.h>\n";
1698 pr "#include <stdlib.h>\n";
1699 pr "#include <string.h>\n";
1701 pr "#include <caml/config.h>\n";
1702 pr "#include <caml/alloc.h>\n";
1703 pr "#include <caml/callback.h>\n";
1704 pr "#include <caml/fail.h>\n";
1705 pr "#include <caml/memory.h>\n";
1706 pr "#include <caml/mlvalues.h>\n";
1707 pr "#include <caml/signals.h>\n";
1709 pr "#include <guestfs.h>\n";
1711 pr "#include \"guestfs_c.h\"\n";
1714 (* LVM struct copy functions. *)
1717 let has_optpercent_col =
1718 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1720 pr "static CAMLprim value\n";
1721 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1723 pr " CAMLparam0 ();\n";
1724 if has_optpercent_col then
1725 pr " CAMLlocal3 (rv, v, v2);\n"
1727 pr " CAMLlocal2 (rv, v);\n";
1729 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1734 pr " v = caml_copy_string (%s->%s);\n" typ name
1736 pr " v = caml_alloc_string (32);\n";
1737 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
1740 pr " v = caml_copy_int64 (%s->%s);\n" typ name
1741 | name, `OptPercent ->
1742 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
1743 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
1744 pr " v = caml_alloc (1, 0);\n";
1745 pr " Store_field (v, 0, v2);\n";
1746 pr " } else /* None */\n";
1747 pr " v = Val_int (0);\n";
1749 pr " Store_field (rv, %d, v);\n" i
1751 pr " CAMLreturn (rv);\n";
1755 pr "static CAMLprim value\n";
1756 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
1759 pr " CAMLparam0 ();\n";
1760 pr " CAMLlocal2 (rv, v);\n";
1763 pr " if (%ss->len == 0)\n" typ;
1764 pr " CAMLreturn (Atom (0));\n";
1766 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
1767 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
1768 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
1769 pr " caml_modify (&Field (rv, i), v);\n";
1771 pr " CAMLreturn (rv);\n";
1775 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1778 fun (name, style, _, _, _, _) ->
1779 pr "CAMLprim value\n";
1780 pr "ocaml_guestfs_%s (value gv" name;
1783 | String n | OptString n | Bool n -> pr ", value %sv" n
1787 pr " CAMLparam%d (gv" (1 + (nr_args (snd style)));
1790 | String n | OptString n | Bool n -> pr ", %sv" n
1793 pr " CAMLlocal1 (rv);\n";
1796 pr " guestfs_h *g = Guestfs_val (gv);\n";
1797 pr " if (g == NULL)\n";
1798 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
1804 pr " const char *%s = String_val (%sv);\n" n n
1806 pr " const char *%s =\n" n;
1807 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
1810 pr " int %s = Bool_val (%sv);\n" n n
1813 match fst style with
1814 | Err -> pr " int r;\n"; "-1"
1815 | RBool _ -> pr " int r;\n"; "-1"
1816 | RConstString _ -> pr " const char *r;\n"; "NULL"
1817 | RString _ -> pr " char *r;\n"; "NULL"
1823 pr " struct guestfs_lvm_pv_list *r;\n";
1826 pr " struct guestfs_lvm_vg_list *r;\n";
1829 pr " struct guestfs_lvm_lv_list *r;\n";
1833 pr " caml_enter_blocking_section ();\n";
1834 pr " r = guestfs_%s " name;
1835 generate_call_args ~handle:"g" style;
1837 pr " caml_leave_blocking_section ();\n";
1838 pr " if (r == %s)\n" error_code;
1839 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
1842 (match fst style with
1843 | Err -> pr " rv = Val_unit;\n"
1844 | RBool _ -> pr " rv = r ? Val_true : Val_false;\n"
1845 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
1847 pr " rv = caml_copy_string (r);\n";
1850 pr " rv = caml_copy_string_array ((const char **) r);\n";
1851 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
1854 pr " rv = copy_lvm_pv_list (r);\n";
1855 pr " guestfs_free_lvm_pv_list (r);\n";
1857 pr " rv = copy_lvm_vg_list (r);\n";
1858 pr " guestfs_free_lvm_vg_list (r);\n";
1860 pr " rv = copy_lvm_lv_list (r);\n";
1861 pr " guestfs_free_lvm_lv_list (r);\n";
1864 pr " CAMLreturn (rv);\n";
1869 and generate_ocaml_lvm_structure_decls () =
1872 pr "type lvm_%s = {\n" typ;
1875 | name, `String -> pr " %s : string;\n" name
1876 | name, `UUID -> pr " %s : string;\n" name
1877 | name, `Bytes -> pr " %s : int64;\n" name
1878 | name, `Int -> pr " %s : int64;\n" name
1879 | name, `OptPercent -> pr " %s : float option;\n" name
1883 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1885 and generate_ocaml_prototype ?(is_external = false) name style =
1886 if is_external then pr "external " else pr "val ";
1887 pr "%s : t -> " name;
1890 | String _ -> pr "string -> "
1891 | OptString _ -> pr "string option -> "
1892 | Bool _ -> pr "bool -> "
1894 (match fst style with
1895 | Err -> pr "unit" (* all errors are turned into exceptions *)
1896 | RBool _ -> pr "bool"
1897 | RConstString _ -> pr "string"
1898 | RString _ -> pr "string"
1899 | RStringList _ -> pr "string array"
1900 | RPVList _ -> pr "lvm_pv array"
1901 | RVGList _ -> pr "lvm_vg array"
1902 | RLVList _ -> pr "lvm_lv array"
1904 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
1907 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
1908 and generate_perl_xs () =
1909 generate_header CStyle LGPLv2;
1912 #include \"EXTERN.h\"
1916 #include <guestfs.h>
1919 #define PRId64 \"lld\"
1923 my_newSVll(long long val) {
1924 #ifdef USE_64_BIT_ALL
1925 return newSViv(val);
1929 len = snprintf(buf, 100, \"%%\" PRId64, val);
1930 return newSVpv(buf, len);
1935 #define PRIu64 \"llu\"
1939 my_newSVull(unsigned long long val) {
1940 #ifdef USE_64_BIT_ALL
1941 return newSVuv(val);
1945 len = snprintf(buf, 100, \"%%\" PRIu64, val);
1946 return newSVpv(buf, len);
1950 /* XXX Not thread-safe, and in general not safe if the caller is
1951 * issuing multiple requests in parallel (on different guestfs
1952 * handles). We should use the guestfs_h handle passed to the
1953 * error handle to distinguish these cases.
1955 static char *last_error = NULL;
1958 error_handler (guestfs_h *g,
1962 if (last_error != NULL) free (last_error);
1963 last_error = strdup (msg);
1966 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
1971 RETVAL = guestfs_create ();
1973 croak (\"could not create guestfs handle\");
1974 guestfs_set_error_handler (RETVAL, error_handler, NULL);
1987 fun (name, style, _, _, _, _) ->
1988 (match fst style with
1989 | Err -> pr "void\n"
1990 | RBool _ -> pr "SV *\n"
1991 | RConstString _ -> pr "SV *\n"
1992 | RString _ -> pr "SV *\n"
1994 | RPVList _ | RVGList _ | RLVList _ ->
1995 pr "void\n" (* all lists returned implictly on the stack *)
1997 (* Call and arguments. *)
1999 generate_call_args ~handle:"g" style;
2001 pr " guestfs_h *g;\n";
2004 | String n -> pr " char *%s;\n" n
2005 | OptString n -> pr " char *%s;\n" n
2006 | Bool n -> pr " int %s;\n" n
2009 (match fst style with
2012 pr " if (guestfs_%s " name;
2013 generate_call_args ~handle:"g" style;
2015 pr " croak (\"%s: %%s\", last_error);\n" name
2018 pr " const char *%s;\n" n;
2020 pr " %s = guestfs_%s " n name;
2021 generate_call_args ~handle:"g" style;
2023 pr " if (%s == NULL)\n" n;
2024 pr " croak (\"%s: %%s\", last_error);\n" name;
2025 pr " RETVAL = newSVpv (%s, 0);\n" n;
2030 pr " char *%s;\n" n;
2032 pr " %s = guestfs_%s " n name;
2033 generate_call_args ~handle:"g" style;
2035 pr " if (%s == NULL)\n" n;
2036 pr " croak (\"%s: %%s\", last_error);\n" name;
2037 pr " RETVAL = newSVpv (%s, 0);\n" n;
2038 pr " free (%s);\n" n;
2045 pr " %s = guestfs_%s " n name;
2046 generate_call_args ~handle:"g" style;
2048 pr " if (%s == -1)\n" n;
2049 pr " croak (\"%s: %%s\", last_error);\n" name;
2050 pr " RETVAL = newSViv (%s);\n" n;
2055 pr " char **%s;\n" n;
2058 pr " %s = guestfs_%s " n name;
2059 generate_call_args ~handle:"g" style;
2061 pr " if (%s == NULL)\n" n;
2062 pr " croak (\"%s: %%s\", last_error);\n" name;
2063 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2064 pr " EXTEND (SP, n);\n";
2065 pr " for (i = 0; i < n; ++i) {\n";
2066 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2067 pr " free (%s[i]);\n" n;
2069 pr " free (%s);\n" n;
2071 generate_perl_lvm_code "pv" pv_cols name style n;
2073 generate_perl_lvm_code "vg" vg_cols name style n;
2075 generate_perl_lvm_code "lv" lv_cols name style n;
2080 and generate_perl_lvm_code typ cols name style n =
2082 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2086 pr " %s = guestfs_%s " n name;
2087 generate_call_args ~handle:"g" style;
2089 pr " if (%s == NULL)\n" n;
2090 pr " croak (\"%s: %%s\", last_error);\n" name;
2091 pr " EXTEND (SP, %s->len);\n" n;
2092 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2093 pr " hv = newHV ();\n";
2097 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2098 name (String.length name) n name
2100 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2101 name (String.length name) n name
2103 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2104 name (String.length name) n name
2106 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2107 name (String.length name) n name
2108 | name, `OptPercent ->
2109 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2110 name (String.length name) n name
2112 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2114 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2116 (* Generate Sys/Guestfs.pm. *)
2117 and generate_perl_pm () =
2118 generate_header HashStyle LGPLv2;
2125 Sys::Guestfs - Perl bindings for libguestfs
2131 my $h = Sys::Guestfs->new ();
2132 $h->add_drive ('guest.img');
2135 $h->mount ('/dev/sda1', '/');
2136 $h->touch ('/hello');
2141 The C<Sys::Guestfs> module provides a Perl XS binding to the
2142 libguestfs API for examining and modifying virtual machine
2145 Amongst the things this is good for: making batch configuration
2146 changes to guests, getting disk used/free statistics (see also:
2147 virt-df), migrating between virtualization systems (see also:
2148 virt-p2v), performing partial backups, performing partial guest
2149 clones, cloning guests and changing registry/UUID/hostname info, and
2152 Libguestfs uses Linux kernel and qemu code, and can access any type of
2153 guest filesystem that Linux and qemu can, including but not limited
2154 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2155 schemes, qcow, qcow2, vmdk.
2157 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2158 LVs, what filesystem is in each LV, etc.). It can also run commands
2159 in the context of the guest. Also you can access filesystems over FTP.
2163 All errors turn into calls to C<croak> (see L<Carp(3)>).
2171 package Sys::Guestfs;
2177 XSLoader::load ('Sys::Guestfs');
2179 =item $h = Sys::Guestfs->new ();
2181 Create a new guestfs handle.
2187 my $class = ref ($proto) || $proto;
2189 my $self = Sys::Guestfs::_create ();
2190 bless $self, $class;
2196 (* Actions. We only need to print documentation for these as
2197 * they are pulled in from the XS code automatically.
2200 fun (name, style, _, flags, _, longdesc) ->
2201 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2203 generate_perl_prototype name style;
2205 pr "%s\n\n" longdesc;
2206 if List.mem ProtocolLimitWarning flags then
2207 pr "Because of the message protocol, there is a transfer limit
2208 of somewhere between 2MB and 4MB. To transfer large files you should use
2210 ) all_functions_sorted;
2222 Copyright (C) 2009 Red Hat Inc.
2226 Please see the file COPYING.LIB for the full license.
2230 L<guestfs(3)>, L<guestfish(1)>.
2235 and generate_perl_prototype name style =
2236 (match fst style with
2240 | RString n -> pr "$%s = " n
2244 | RLVList n -> pr "@%s = " n
2247 let comma = ref false in
2250 if !comma then pr ", ";
2253 | String n -> pr "%s" n
2254 | OptString n -> pr "%s" n
2255 | Bool n -> pr "%s" n
2259 let output_to filename =
2260 let filename_new = filename ^ ".new" in
2261 chan := open_out filename_new;
2265 Unix.rename filename_new filename;
2266 printf "written %s\n%!" filename;
2274 let close = output_to "src/guestfs_protocol.x" in
2278 let close = output_to "src/guestfs-structs.h" in
2279 generate_structs_h ();
2282 let close = output_to "src/guestfs-actions.h" in
2283 generate_actions_h ();
2286 let close = output_to "src/guestfs-actions.c" in
2287 generate_client_actions ();
2290 let close = output_to "daemon/actions.h" in
2291 generate_daemon_actions_h ();
2294 let close = output_to "daemon/stubs.c" in
2295 generate_daemon_actions ();
2298 let close = output_to "fish/cmds.c" in
2299 generate_fish_cmds ();
2302 let close = output_to "guestfs-structs.pod" in
2303 generate_structs_pod ();
2306 let close = output_to "guestfs-actions.pod" in
2307 generate_actions_pod ();
2310 let close = output_to "guestfish-actions.pod" in
2311 generate_fish_actions_pod ();
2314 let close = output_to "ocaml/guestfs.mli" in
2315 generate_ocaml_mli ();
2318 let close = output_to "ocaml/guestfs.ml" in
2319 generate_ocaml_ml ();
2322 let close = output_to "ocaml/guestfs_c_actions.c" in
2323 generate_ocaml_c ();
2326 let close = output_to "perl/Guestfs.xs" in
2327 generate_perl_xs ();
2330 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2331 generate_perl_pm ();