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.");
315 let all_functions = non_daemon_functions @ daemon_functions
317 (* In some places we want the functions to be displayed sorted
318 * alphabetically, so this is useful:
320 let all_functions_sorted =
321 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
323 (* Column names and types from LVM PVs/VGs/LVs. *)
332 "pv_attr", `String (* XXX *);
334 "pv_pe_alloc_count", `Int;
337 "pv_mda_count", `Int;
338 "pv_mda_free", `Bytes;
340 "pv_mda_size", `Bytes;
347 "vg_attr", `String (* XXX *);
351 "vg_extent_size", `Bytes;
352 "vg_extent_count", `Int;
353 "vg_free_count", `Int;
361 "vg_mda_count", `Int;
362 "vg_mda_free", `Bytes;
364 "vg_mda_size", `Bytes;
370 "lv_attr", `String (* XXX *);
373 "lv_kernel_major", `Int;
374 "lv_kernel_minor", `Int;
378 "snap_percent", `OptPercent;
379 "copy_percent", `OptPercent;
382 "mirror_log", `String;
387 * Note we don't want to use any external OCaml libraries which
388 * makes this a bit harder than it should be.
390 let failwithf fs = ksprintf failwith fs
392 let replace_char s c1 c2 =
393 let s2 = String.copy s in
395 for i = 0 to String.length s2 - 1 do
396 if String.unsafe_get s2 i = c1 then (
397 String.unsafe_set s2 i c2;
401 if not !r then s else s2
404 let len = String.length s in
405 let sublen = String.length sub in
407 if i <= len-sublen then (
410 if s.[i+j] = sub.[j] then loop2 (j+1)
416 if r = -1 then loop (i+1) else r
422 let rec replace_str s s1 s2 =
423 let len = String.length s in
424 let sublen = String.length s1 in
428 let s' = String.sub s 0 i in
429 let s'' = String.sub s (i+sublen) (len-i-sublen) in
430 s' ^ s2 ^ replace_str s'' s1 s2
433 let rec find_map f = function
434 | [] -> raise Not_found
438 | None -> find_map f xs
440 (* 'pr' prints to the current output file. *)
441 let chan = ref stdout
442 let pr fs = ksprintf (output_string !chan) fs
444 let iter_args f = function
447 | P2 (arg1, arg2) -> f arg1; f arg2
449 let iteri_args f = function
451 | P1 arg1 -> f 0 arg1
452 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
454 let map_args f = function
456 | P1 arg1 -> [f arg1]
457 | P2 (arg1, arg2) -> [f arg1; f arg2]
459 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
461 (* Check function names etc. for consistency. *)
462 let check_functions () =
464 fun (name, _, _, _, _, longdesc) ->
465 if String.contains name '-' then
466 failwithf "function name '%s' should not contain '-', use '_' instead."
468 if longdesc.[String.length longdesc-1] = '\n' then
469 failwithf "long description of %s should not end with \\n." name
473 fun (name, _, proc_nr, _, _, _) ->
475 failwithf "daemon function %s should have proc_nr > 0" name
479 fun (name, _, proc_nr, _, _, _) ->
480 if proc_nr <> -1 then
481 failwithf "non-daemon function %s should have proc_nr -1" name
482 ) non_daemon_functions;
485 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
488 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
489 let rec loop = function
492 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
494 | (name1,nr1) :: (name2,nr2) :: _ ->
495 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
500 type comment_style = CStyle | HashStyle | OCamlStyle
501 type license = GPLv2 | LGPLv2
503 (* Generate a header block in a number of standard styles. *)
504 let rec generate_header comment license =
505 let c = match comment with
506 | CStyle -> pr "/* "; " *"
507 | HashStyle -> pr "# "; "#"
508 | OCamlStyle -> pr "(* "; " *" in
509 pr "libguestfs generated file\n";
510 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
511 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
513 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
517 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
518 pr "%s it under the terms of the GNU General Public License as published by\n" c;
519 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
520 pr "%s (at your option) any later version.\n" c;
522 pr "%s This program is distributed in the hope that it will be useful,\n" c;
523 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
524 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
525 pr "%s GNU General Public License for more details.\n" c;
527 pr "%s You should have received a copy of the GNU General Public License along\n" c;
528 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
529 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
532 pr "%s This library is free software; you can redistribute it and/or\n" c;
533 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
534 pr "%s License as published by the Free Software Foundation; either\n" c;
535 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
537 pr "%s This library is distributed in the hope that it will be useful,\n" c;
538 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
539 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
540 pr "%s Lesser General Public License for more details.\n" c;
542 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
543 pr "%s License along with this library; if not, write to the Free Software\n" c;
544 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
547 | CStyle -> pr " */\n"
549 | OCamlStyle -> pr " *)\n"
553 (* Generate the pod documentation for the C API. *)
554 and generate_actions_pod () =
556 fun (shortname, style, _, flags, _, longdesc) ->
557 let name = "guestfs_" ^ shortname in
558 pr "=head2 %s\n\n" name;
560 generate_prototype ~extern:false ~handle:"handle" name style;
562 pr "%s\n\n" longdesc;
563 (match fst style with
565 pr "This function returns 0 on success or -1 on error.\n\n"
567 pr "This function returns a C truth value on success or -1 on error.\n\n"
569 pr "This function returns a string or NULL on error.
570 The string is owned by the guest handle and must I<not> be freed.\n\n"
572 pr "This function returns a string or NULL on error.
573 I<The caller must free the returned string after use>.\n\n"
575 pr "This function returns a NULL-terminated array of strings
576 (like L<environ(3)>), or NULL if there was an error.
577 I<The caller must free the strings and the array after use>.\n\n"
579 pr "This function returns a C<struct guestfs_lvm_pv_list>.
580 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
582 pr "This function returns a C<struct guestfs_lvm_vg_list>.
583 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
585 pr "This function returns a C<struct guestfs_lvm_lv_list>.
586 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
588 if List.mem ProtocolLimitWarning flags then
589 pr "Because of the message protocol, there is a transfer limit
590 of somewhere between 2MB and 4MB. To transfer large files you should use
592 ) all_functions_sorted
594 and generate_structs_pod () =
595 (* LVM structs documentation. *)
598 pr "=head2 guestfs_lvm_%s\n" typ;
600 pr " struct guestfs_lvm_%s {\n" typ;
603 | name, `String -> pr " char *%s;\n" name
605 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
606 pr " char %s[32];\n" name
607 | name, `Bytes -> pr " uint64_t %s;\n" name
608 | name, `Int -> pr " int64_t %s;\n" name
609 | name, `OptPercent ->
610 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
611 pr " float %s;\n" name
614 pr " struct guestfs_lvm_%s_list {\n" typ;
615 pr " uint32_t len; /* Number of elements in list. */\n";
616 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
619 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
622 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
624 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
625 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
626 * have to use an underscore instead of a dash because otherwise
627 * rpcgen generates incorrect code.
629 * This header is NOT exported to clients, but see also generate_structs_h.
631 and generate_xdr () =
632 generate_header CStyle LGPLv2;
634 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
635 pr "typedef string str<>;\n";
638 (* LVM internal structures. *)
642 pr "struct guestfs_lvm_int_%s {\n" typ;
644 | name, `String -> pr " string %s<>;\n" name
645 | name, `UUID -> pr " opaque %s[32];\n" name
646 | name, `Bytes -> pr " hyper %s;\n" name
647 | name, `Int -> pr " hyper %s;\n" name
648 | name, `OptPercent -> pr " float %s;\n" name
652 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
654 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
657 fun(shortname, style, _, _, _, _) ->
658 let name = "guestfs_" ^ shortname in
659 pr "/* %s */\n\n" name;
660 (match snd style with
663 pr "struct %s_args {\n" name;
666 | String name -> pr " string %s<>;\n" name
667 | OptString name -> pr " string *%s<>;\n" name
668 | Bool name -> pr " bool %s;\n" name
672 (match fst style with
675 pr "struct %s_ret {\n" name;
679 failwithf "RConstString cannot be returned from a daemon function"
681 pr "struct %s_ret {\n" name;
682 pr " string %s<>;\n" n;
685 pr "struct %s_ret {\n" name;
689 pr "struct %s_ret {\n" name;
690 pr " guestfs_lvm_int_pv_list %s;\n" n;
693 pr "struct %s_ret {\n" name;
694 pr " guestfs_lvm_int_vg_list %s;\n" n;
697 pr "struct %s_ret {\n" name;
698 pr " guestfs_lvm_int_lv_list %s;\n" n;
703 (* Table of procedure numbers. *)
704 pr "enum guestfs_procedure {\n";
706 fun (shortname, _, proc_nr, _, _, _) ->
707 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
709 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
713 (* Having to choose a maximum message size is annoying for several
714 * reasons (it limits what we can do in the API), but it (a) makes
715 * the protocol a lot simpler, and (b) provides a bound on the size
716 * of the daemon which operates in limited memory space. For large
717 * file transfers you should use FTP.
719 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
722 (* Message header, etc. *)
724 const GUESTFS_PROGRAM = 0x2000F5F5;
725 const GUESTFS_PROTOCOL_VERSION = 1;
727 enum guestfs_message_direction {
728 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
729 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
732 enum guestfs_message_status {
733 GUESTFS_STATUS_OK = 0,
734 GUESTFS_STATUS_ERROR = 1
737 const GUESTFS_ERROR_LEN = 256;
739 struct guestfs_message_error {
740 string error<GUESTFS_ERROR_LEN>; /* error message */
743 struct guestfs_message_header {
744 unsigned prog; /* GUESTFS_PROGRAM */
745 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
746 guestfs_procedure proc; /* GUESTFS_PROC_x */
747 guestfs_message_direction direction;
748 unsigned serial; /* message serial number */
749 guestfs_message_status status;
753 (* Generate the guestfs-structs.h file. *)
754 and generate_structs_h () =
755 generate_header CStyle LGPLv2;
757 (* This is a public exported header file containing various
758 * structures. The structures are carefully written to have
759 * exactly the same in-memory format as the XDR structures that
760 * we use on the wire to the daemon. The reason for creating
761 * copies of these structures here is just so we don't have to
762 * export the whole of guestfs_protocol.h (which includes much
763 * unrelated and XDR-dependent stuff that we don't want to be
764 * public, or required by clients).
766 * To reiterate, we will pass these structures to and from the
767 * client with a simple assignment or memcpy, so the format
768 * must be identical to what rpcgen / the RFC defines.
771 (* LVM public structures. *)
775 pr "struct guestfs_lvm_%s {\n" typ;
778 | name, `String -> pr " char *%s;\n" name
779 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
780 | name, `Bytes -> pr " uint64_t %s;\n" name
781 | name, `Int -> pr " int64_t %s;\n" name
782 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
786 pr "struct guestfs_lvm_%s_list {\n" typ;
787 pr " uint32_t len;\n";
788 pr " struct guestfs_lvm_%s *val;\n" typ;
791 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
793 (* Generate the guestfs-actions.h file. *)
794 and generate_actions_h () =
795 generate_header CStyle LGPLv2;
797 fun (shortname, style, _, _, _, _) ->
798 let name = "guestfs_" ^ shortname in
799 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
803 (* Generate the client-side dispatch stubs. *)
804 and generate_client_actions () =
805 generate_header CStyle LGPLv2;
807 (* Client-side stubs for each function. *)
809 fun (shortname, style, _, _, _, _) ->
810 let name = "guestfs_" ^ shortname in
812 (* Generate the return value struct. *)
813 pr "struct %s_rv {\n" shortname;
814 pr " int cb_done; /* flag to indicate callback was called */\n";
815 pr " struct guestfs_message_header hdr;\n";
816 pr " struct guestfs_message_error err;\n";
817 (match fst style with
820 failwithf "RConstString cannot be returned from a daemon function"
821 | RBool _ | RString _ | RStringList _
822 | RPVList _ | RVGList _ | RLVList _ ->
823 pr " struct %s_ret ret;\n" name
827 (* Generate the callback function. *)
828 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
830 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
832 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
833 pr " error (g, \"%s: failed to parse reply header\");\n" name;
836 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
837 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
838 pr " error (g, \"%s: failed to parse reply error\");\n" name;
844 (match fst style with
847 failwithf "RConstString cannot be returned from a daemon function"
848 | RBool _ | RString _ | RStringList _
849 | RPVList _ | RVGList _ | RLVList _ ->
850 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
851 pr " error (g, \"%s: failed to parse reply\");\n" name;
857 pr " rv->cb_done = 1;\n";
858 pr " main_loop.main_loop_quit (g);\n";
861 (* Generate the action stub. *)
862 generate_prototype ~extern:false ~semicolon:false ~newline:true
863 ~handle:"g" name style;
867 | Err | RBool _ -> "-1"
869 failwithf "RConstString cannot be returned from a daemon function"
870 | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
875 (match snd style with
877 | _ -> pr " struct %s_args args;\n" name
880 pr " struct %s_rv rv;\n" shortname;
883 pr " if (g->state != READY) {\n";
884 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
887 pr " return %s;\n" error_code;
890 pr " memset (&rv, 0, sizeof rv);\n";
893 (match snd style with
895 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
896 (String.uppercase shortname)
901 pr " args.%s = (char *) %s;\n" name name
903 pr " args.%s = %s ? *%s : NULL;\n" name name name
905 pr " args.%s = %s;\n" name name
907 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
908 (String.uppercase shortname);
909 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
912 pr " if (serial == -1)\n";
913 pr " return %s;\n" error_code;
916 pr " rv.cb_done = 0;\n";
917 pr " g->reply_cb_internal = %s_cb;\n" shortname;
918 pr " g->reply_cb_internal_data = &rv;\n";
919 pr " main_loop.main_loop_run (g);\n";
920 pr " g->reply_cb_internal = NULL;\n";
921 pr " g->reply_cb_internal_data = NULL;\n";
922 pr " if (!rv.cb_done) {\n";
923 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
924 pr " return %s;\n" error_code;
928 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
929 (String.uppercase shortname);
930 pr " return %s;\n" error_code;
933 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
934 pr " error (g, \"%%s\", rv.err.error);\n";
935 pr " return %s;\n" error_code;
939 (match fst style with
940 | Err -> pr " return 0;\n"
941 | RBool n -> pr " return rv.ret.%s;\n" n
943 failwithf "RConstString cannot be returned from a daemon function"
945 pr " return rv.ret.%s; /* caller will free */\n" n
947 pr " /* caller will free this, but we need to add a NULL entry */\n";
948 pr " rv.ret.%s.%s_val =" n n;
949 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
950 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
952 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
953 pr " return rv.ret.%s.%s_val;\n" n n
955 pr " /* caller will free this */\n";
956 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
958 pr " /* caller will free this */\n";
959 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
961 pr " /* caller will free this */\n";
962 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
968 (* Generate daemon/actions.h. *)
969 and generate_daemon_actions_h () =
970 generate_header CStyle GPLv2;
972 pr "#include \"../src/guestfs_protocol.h\"\n";
976 fun (name, style, _, _, _, _) ->
978 ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
981 (* Generate the server-side stubs. *)
982 and generate_daemon_actions () =
983 generate_header CStyle GPLv2;
985 pr "#define _GNU_SOURCE // for strchrnul\n";
987 pr "#include <stdio.h>\n";
988 pr "#include <stdlib.h>\n";
989 pr "#include <string.h>\n";
990 pr "#include <inttypes.h>\n";
991 pr "#include <ctype.h>\n";
992 pr "#include <rpc/types.h>\n";
993 pr "#include <rpc/xdr.h>\n";
995 pr "#include \"daemon.h\"\n";
996 pr "#include \"../src/guestfs_protocol.h\"\n";
997 pr "#include \"actions.h\"\n";
1001 fun (name, style, _, _, _, _) ->
1002 (* Generate server-side stubs. *)
1003 pr "static void %s_stub (XDR *xdr_in)\n" name;
1006 match fst style with
1007 | Err -> pr " int r;\n"; "-1"
1008 | RBool _ -> pr " int r;\n"; "-1"
1010 failwithf "RConstString cannot be returned from a daemon function"
1011 | RString _ -> pr " char *r;\n"; "NULL"
1012 | RStringList _ -> pr " char **r;\n"; "NULL"
1013 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1014 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1015 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1017 (match snd style with
1020 pr " struct guestfs_%s_args args;\n" name;
1024 | OptString name -> pr " const char *%s;\n" name
1025 | Bool name -> pr " int %s;\n" name
1030 (match snd style with
1033 pr " memset (&args, 0, sizeof args);\n";
1035 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1036 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
1041 | String name -> pr " %s = args.%s;\n" name name
1042 | OptString name -> pr " %s = args.%s;\n" name name (* XXX? *)
1043 | Bool name -> pr " %s = args.%s;\n" name name
1048 pr " r = do_%s " name;
1049 generate_call_args style;
1052 pr " if (r == %s)\n" error_code;
1053 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1057 (match fst style with
1058 | Err -> pr " reply (NULL, NULL);\n"
1060 pr " struct guestfs_%s_ret ret;\n" name;
1061 pr " ret.%s = r;\n" n;
1062 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1064 failwithf "RConstString cannot be returned from a daemon function"
1066 pr " struct guestfs_%s_ret ret;\n" name;
1067 pr " ret.%s = r;\n" n;
1068 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1071 pr " struct guestfs_%s_ret ret;\n" name;
1072 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1073 pr " ret.%s.%s_val = r;\n" n n;
1074 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1075 pr " free_strings (r);\n"
1077 pr " struct guestfs_%s_ret ret;\n" name;
1078 pr " ret.%s = *r;\n" n;
1079 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1080 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1082 pr " struct guestfs_%s_ret ret;\n" name;
1083 pr " ret.%s = *r;\n" n;
1084 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1085 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1087 pr " struct guestfs_%s_ret ret;\n" name;
1088 pr " ret.%s = *r;\n" n;
1089 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1090 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1096 (* Dispatch function. *)
1097 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1099 pr " switch (proc_nr) {\n";
1102 fun (name, style, _, _, _, _) ->
1103 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1104 pr " %s_stub (xdr_in);\n" name;
1109 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1114 (* LVM columns and tokenization functions. *)
1115 (* XXX This generates crap code. We should rethink how we
1121 pr "static const char *lvm_%s_cols = \"%s\";\n"
1122 typ (String.concat "," (List.map fst cols));
1125 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1127 pr " char *tok, *p, *next;\n";
1131 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1134 pr " if (!str) {\n";
1135 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1138 pr " if (!*str || isspace (*str)) {\n";
1139 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1144 fun (name, coltype) ->
1145 pr " if (!tok) {\n";
1146 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1149 pr " p = strchrnul (tok, ',');\n";
1150 pr " if (*p) next = p+1; else next = NULL;\n";
1151 pr " *p = '\\0';\n";
1154 pr " r->%s = strdup (tok);\n" name;
1155 pr " if (r->%s == NULL) {\n" name;
1156 pr " perror (\"strdup\");\n";
1160 pr " for (i = j = 0; i < 32; ++j) {\n";
1161 pr " if (tok[j] == '\\0') {\n";
1162 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1164 pr " } else if (tok[j] != '-')\n";
1165 pr " r->%s[i++] = tok[j];\n" name;
1168 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1169 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1173 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1174 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1178 pr " if (tok[0] == '\\0')\n";
1179 pr " r->%s = -1;\n" name;
1180 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1181 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1185 pr " tok = next;\n";
1188 pr " if (tok != NULL) {\n";
1189 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1196 pr "guestfs_lvm_int_%s_list *\n" typ;
1197 pr "parse_command_line_%ss (void)\n" typ;
1199 pr " char *out, *err;\n";
1200 pr " char *p, *pend;\n";
1202 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1203 pr " void *newp;\n";
1205 pr " ret = malloc (sizeof *ret);\n";
1206 pr " if (!ret) {\n";
1207 pr " reply_with_perror (\"malloc\");\n";
1208 pr " return NULL;\n";
1211 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1212 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1214 pr " r = command (&out, &err,\n";
1215 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1216 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1217 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1218 pr " if (r == -1) {\n";
1219 pr " reply_with_error (\"%%s\", err);\n";
1220 pr " free (out);\n";
1221 pr " free (err);\n";
1222 pr " return NULL;\n";
1225 pr " free (err);\n";
1227 pr " /* Tokenize each line of the output. */\n";
1230 pr " while (p) {\n";
1231 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1232 pr " if (pend) {\n";
1233 pr " *pend = '\\0';\n";
1237 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1240 pr " if (!*p) { /* Empty line? Skip it. */\n";
1245 pr " /* Allocate some space to store this next entry. */\n";
1246 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1247 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1248 pr " if (newp == NULL) {\n";
1249 pr " reply_with_perror (\"realloc\");\n";
1250 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1251 pr " free (ret);\n";
1252 pr " free (out);\n";
1253 pr " return NULL;\n";
1255 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1257 pr " /* Tokenize the next entry. */\n";
1258 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1259 pr " if (r == -1) {\n";
1260 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1261 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1262 pr " free (ret);\n";
1263 pr " free (out);\n";
1264 pr " return NULL;\n";
1271 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1273 pr " free (out);\n";
1274 pr " return ret;\n";
1277 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1279 (* Generate a lot of different functions for guestfish. *)
1280 and generate_fish_cmds () =
1281 generate_header CStyle GPLv2;
1285 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1287 let all_functions_sorted =
1289 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1290 ) all_functions_sorted in
1292 pr "#include <stdio.h>\n";
1293 pr "#include <stdlib.h>\n";
1294 pr "#include <string.h>\n";
1295 pr "#include <inttypes.h>\n";
1297 pr "#include <guestfs.h>\n";
1298 pr "#include \"fish.h\"\n";
1301 (* list_commands function, which implements guestfish -h *)
1302 pr "void list_commands (void)\n";
1304 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1305 pr " list_builtin_commands ();\n";
1307 fun (name, _, _, flags, shortdesc, _) ->
1308 let name = replace_char name '_' '-' in
1309 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1311 ) all_functions_sorted;
1312 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1316 (* display_command function, which implements guestfish -h cmd *)
1317 pr "void display_command (const char *cmd)\n";
1320 fun (name, style, _, flags, shortdesc, longdesc) ->
1321 let name2 = replace_char name '_' '-' in
1323 try find_map (function FishAlias n -> Some n | _ -> None) flags
1324 with Not_found -> name in
1325 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1327 match snd style with
1332 String.concat "> <" (
1334 | String n | OptString n | Bool n -> n) args
1339 if List.mem ProtocolLimitWarning flags then
1340 "\n\nBecause of the message protocol, there is a transfer limit
1341 of somewhere between 2MB and 4MB. To transfer large files you should use
1345 let describe_alias =
1346 if name <> alias then
1347 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1351 pr "strcasecmp (cmd, \"%s\") == 0" name;
1352 if name <> name2 then
1353 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1354 if name <> alias then
1355 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1357 pr " pod2text (\"%s - %s\", %S);\n"
1359 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1362 pr " display_builtin_command (cmd);\n";
1366 (* print_{pv,vg,lv}_list functions *)
1370 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1377 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1379 pr " printf (\"%s: \");\n" name;
1380 pr " for (i = 0; i < 32; ++i)\n";
1381 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1382 pr " printf (\"\\n\");\n"
1384 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1386 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1387 | name, `OptPercent ->
1388 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1389 typ name name typ name;
1390 pr " else printf (\"%s: \\n\");\n" name
1394 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1399 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1400 pr " print_%s (&%ss->val[i]);\n" typ typ;
1403 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1405 (* run_<action> actions *)
1407 fun (name, style, _, flags, _, _) ->
1408 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1410 (match fst style with
1412 | RBool _ -> pr " int r;\n"
1413 | RConstString _ -> pr " const char *r;\n"
1414 | RString _ -> pr " char *r;\n"
1415 | RStringList _ -> pr " char **r;\n"
1416 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1417 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1418 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1422 | String name -> pr " const char *%s;\n" name
1423 | OptString name -> pr " const char *%s;\n" name
1424 | Bool name -> pr " int %s;\n" name
1427 (* Check and convert parameters. *)
1428 let argc_expected = nr_args (snd style) in
1429 pr " if (argc != %d) {\n" argc_expected;
1430 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1432 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1438 | String name -> pr " %s = argv[%d];\n" name i
1440 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1443 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1446 (* Call C API function. *)
1448 try find_map (function FishAction n -> Some n | _ -> None) flags
1449 with Not_found -> sprintf "guestfs_%s" name in
1451 generate_call_args ~handle:"g" style;
1454 (* Check return value for errors and display command results. *)
1455 (match fst style with
1456 | Err -> pr " return r;\n"
1458 pr " if (r == -1) return -1;\n";
1459 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1462 pr " if (r == NULL) return -1;\n";
1463 pr " printf (\"%%s\\n\", r);\n";
1466 pr " if (r == NULL) return -1;\n";
1467 pr " printf (\"%%s\\n\", r);\n";
1471 pr " if (r == NULL) return -1;\n";
1472 pr " print_strings (r);\n";
1473 pr " free_strings (r);\n";
1476 pr " if (r == NULL) return -1;\n";
1477 pr " print_pv_list (r);\n";
1478 pr " guestfs_free_lvm_pv_list (r);\n";
1481 pr " if (r == NULL) return -1;\n";
1482 pr " print_vg_list (r);\n";
1483 pr " guestfs_free_lvm_vg_list (r);\n";
1486 pr " if (r == NULL) return -1;\n";
1487 pr " print_lv_list (r);\n";
1488 pr " guestfs_free_lvm_lv_list (r);\n";
1495 (* run_action function *)
1496 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1499 fun (name, _, _, flags, _, _) ->
1500 let name2 = replace_char name '_' '-' in
1502 try find_map (function FishAlias n -> Some n | _ -> None) flags
1503 with Not_found -> name in
1505 pr "strcasecmp (cmd, \"%s\") == 0" name;
1506 if name <> name2 then
1507 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1508 if name <> alias then
1509 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1511 pr " return run_%s (cmd, argc, argv);\n" name;
1515 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1522 (* Generate the POD documentation for guestfish. *)
1523 and generate_fish_actions_pod () =
1524 let all_functions_sorted =
1526 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1527 ) all_functions_sorted in
1530 fun (name, style, _, flags, _, longdesc) ->
1531 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1532 let name = replace_char name '_' '-' in
1534 try find_map (function FishAlias n -> Some n | _ -> None) flags
1535 with Not_found -> name in
1537 pr "=head2 %s" name;
1538 if name <> alias then
1545 | String n -> pr " %s" n
1546 | OptString n -> pr " %s" n
1547 | Bool _ -> pr " true|false"
1551 pr "%s\n\n" longdesc
1552 ) all_functions_sorted
1554 (* Generate a C function prototype. *)
1555 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1556 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1557 ?handle name style =
1558 if extern then pr "extern ";
1559 if static then pr "static ";
1560 (match fst style with
1562 | RBool _ -> pr "int "
1563 | RConstString _ -> pr "const char *"
1564 | RString _ -> pr "char *"
1565 | RStringList _ -> pr "char **"
1567 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1568 else pr "guestfs_lvm_int_pv_list *"
1570 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1571 else pr "guestfs_lvm_int_vg_list *"
1573 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1574 else pr "guestfs_lvm_int_lv_list *"
1577 let comma = ref false in
1580 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1584 if single_line then pr ", " else pr ",\n\t\t"
1590 | String name -> next (); pr "const char *%s" name
1591 | OptString name -> next (); pr "const char *%s" name
1592 | Bool name -> next (); pr "int %s" name
1595 if semicolon then pr ";";
1596 if newline then pr "\n"
1598 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1599 and generate_call_args ?handle style =
1601 let comma = ref false in
1604 | Some handle -> pr "%s" handle; comma := true
1608 if !comma then pr ", ";
1611 | String name -> pr "%s" name
1612 | OptString name -> pr "%s" name
1613 | Bool name -> pr "%s" name
1617 (* Generate the OCaml bindings interface. *)
1618 and generate_ocaml_mli () =
1619 generate_header OCamlStyle LGPLv2;
1622 (** For API documentation you should refer to the C API
1623 in the guestfs(3) manual page. The OCaml API uses almost
1624 exactly the same calls. *)
1627 (** A [guestfs_h] handle. *)
1629 exception Error of string
1630 (** This exception is raised when there is an error. *)
1632 val create : unit -> t
1634 val close : t -> unit
1635 (** Handles are closed by the garbage collector when they become
1636 unreferenced, but callers can also call this in order to
1637 provide predictable cleanup. *)
1640 generate_ocaml_lvm_structure_decls ();
1644 fun (name, style, _, _, shortdesc, _) ->
1645 generate_ocaml_prototype name style;
1646 pr "(** %s *)\n" shortdesc;
1650 (* Generate the OCaml bindings implementation. *)
1651 and generate_ocaml_ml () =
1652 generate_header OCamlStyle LGPLv2;
1656 exception Error of string
1657 external create : unit -> t = \"ocaml_guestfs_create\"
1658 external close : t -> unit = \"ocaml_guestfs_create\"
1661 generate_ocaml_lvm_structure_decls ();
1665 fun (name, style, _, _, shortdesc, _) ->
1666 generate_ocaml_prototype ~is_external:true name style;
1669 (* Generate the OCaml bindings C implementation. *)
1670 and generate_ocaml_c () =
1671 generate_header CStyle LGPLv2;
1673 pr "#include <stdio.h>\n";
1674 pr "#include <stdlib.h>\n";
1676 pr "#include <guestfs.h>\n";
1678 pr "#include <caml/config.h>\n";
1679 pr "#include <caml/alloc.h>\n";
1680 pr "#include <caml/callback.h>\n";
1681 pr "#include <caml/fail.h>\n";
1682 pr "#include <caml/memory.h>\n";
1683 pr "#include <caml/mlvalues.h>\n";
1685 pr "#include \"guestfs_c.h\"\n";
1689 fun (name, style, _, _, _, _) ->
1690 pr "CAMLprim value\n";
1691 pr "ocaml_guestfs_%s (value hv /* XXX */)\n" name;
1693 pr " CAMLparam1 (hv); /* XXX */\n";
1694 pr "/* XXX write something here */\n";
1695 pr " CAMLreturn (Val_unit); /* XXX */\n";
1700 and generate_ocaml_lvm_structure_decls () =
1703 pr "type lvm_%s = {\n" typ;
1706 | name, `String -> pr " %s : string;\n" name
1707 | name, `UUID -> pr " %s : string;\n" name
1708 | name, `Bytes -> pr " %s : int64;\n" name
1709 | name, `Int -> pr " %s : int64;\n" name
1710 | name, `OptPercent -> pr " %s : float option;\n" name
1714 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1716 and generate_ocaml_prototype ?(is_external = false) name style =
1717 if is_external then pr "external " else pr "val ";
1718 pr "%s : t -> " name;
1721 | String _ -> pr "string -> "
1722 | OptString _ -> pr "string option -> "
1723 | Bool _ -> pr "bool -> "
1725 (match fst style with
1726 | Err -> pr "unit" (* all errors are turned into exceptions *)
1727 | RBool _ -> pr "bool"
1728 | RConstString _ -> pr "string"
1729 | RString _ -> pr "string"
1730 | RStringList _ -> pr "string list"
1731 | RPVList _ -> pr "lvm_pv list"
1732 | RVGList _ -> pr "lvm_vg list"
1733 | RLVList _ -> pr "lvm_lv list"
1735 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
1738 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
1739 and generate_perl_xs () =
1740 generate_header CStyle LGPLv2;
1743 #include \"EXTERN.h\"
1747 #include <guestfs.h>
1750 #define PRId64 \"lld\"
1754 my_newSVll(long long val) {
1755 #ifdef USE_64_BIT_ALL
1756 return newSViv(val);
1760 len = snprintf(buf, 100, \"%%\" PRId64, val);
1761 return newSVpv(buf, len);
1766 #define PRIu64 \"llu\"
1770 my_newSVull(unsigned long long val) {
1771 #ifdef USE_64_BIT_ALL
1772 return newSVuv(val);
1776 len = snprintf(buf, 100, \"%%\" PRIu64, val);
1777 return newSVpv(buf, len);
1781 /* XXX Not thread-safe, and in general not safe if the caller is
1782 * issuing multiple requests in parallel (on different guestfs
1783 * handles). We should use the guestfs_h handle passed to the
1784 * error handle to distinguish these cases.
1786 static char *last_error = NULL;
1789 error_handler (guestfs_h *g,
1793 if (last_error != NULL) free (last_error);
1794 last_error = strdup (msg);
1797 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
1802 RETVAL = guestfs_create ();
1804 croak (\"could not create guestfs handle\");
1805 guestfs_set_error_handler (RETVAL, error_handler, NULL);
1818 fun (name, style, _, _, _, _) ->
1819 (match fst style with
1820 | Err -> pr "void\n"
1821 | RBool _ -> pr "SV *\n"
1822 | RConstString _ -> pr "SV *\n"
1823 | RString _ -> pr "SV *\n"
1825 | RPVList _ | RVGList _ | RLVList _ ->
1826 pr "void\n" (* all lists returned implictly on the stack *)
1828 (* Call and arguments. *)
1830 generate_call_args ~handle:"g" style;
1832 pr " guestfs_h *g;\n";
1835 | String n -> pr " char *%s;\n" n
1836 | OptString n -> pr " char *%s;\n" n
1837 | Bool n -> pr " int %s;\n" n
1840 (match fst style with
1843 pr " if (guestfs_%s " name;
1844 generate_call_args ~handle:"g" style;
1846 pr " croak (\"%s: %%s\", last_error);\n" name
1849 pr " const char *%s;\n" n;
1851 pr " %s = guestfs_%s " n name;
1852 generate_call_args ~handle:"g" style;
1854 pr " if (%s == NULL)\n" n;
1855 pr " croak (\"%s: %%s\", last_error);\n" name;
1856 pr " RETVAL = newSVpv (%s, 0);\n" n;
1861 pr " char *%s;\n" n;
1863 pr " %s = guestfs_%s " n name;
1864 generate_call_args ~handle:"g" style;
1866 pr " if (%s == NULL)\n" n;
1867 pr " croak (\"%s: %%s\", last_error);\n" name;
1868 pr " RETVAL = newSVpv (%s, 0);\n" n;
1869 pr " free (%s);\n" n;
1876 pr " %s = guestfs_%s " n name;
1877 generate_call_args ~handle:"g" style;
1879 pr " if (%s == -1)\n" n;
1880 pr " croak (\"%s: %%s\", last_error);\n" name;
1881 pr " RETVAL = newSViv (%s);\n" n;
1886 pr " char **%s;\n" n;
1889 pr " %s = guestfs_%s " n name;
1890 generate_call_args ~handle:"g" style;
1892 pr " if (%s == NULL)\n" n;
1893 pr " croak (\"%s: %%s\", last_error);\n" name;
1894 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
1895 pr " EXTEND (SP, n);\n";
1896 pr " for (i = 0; i < n; ++i) {\n";
1897 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
1898 pr " free (%s[i]);\n" n;
1900 pr " free (%s);\n" n;
1902 generate_perl_lvm_code "pv" pv_cols name style n;
1904 generate_perl_lvm_code "vg" vg_cols name style n;
1906 generate_perl_lvm_code "lv" lv_cols name style n;
1911 and generate_perl_lvm_code typ cols name style n =
1913 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
1917 pr " %s = guestfs_%s " n name;
1918 generate_call_args ~handle:"g" style;
1920 pr " if (%s == NULL)\n" n;
1921 pr " croak (\"%s: %%s\", last_error);\n" name;
1922 pr " EXTEND (SP, %s->len);\n" n;
1923 pr " for (i = 0; i < %s->len; ++i) {\n" n;
1924 pr " hv = newHV ();\n";
1928 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
1929 name (String.length name) n name
1931 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
1932 name (String.length name) n name
1934 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
1935 name (String.length name) n name
1937 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
1938 name (String.length name) n name
1939 | name, `OptPercent ->
1940 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
1941 name (String.length name) n name
1943 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
1945 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
1947 (* Generate Sys/Guestfs.pm. *)
1948 and generate_perl_pm () =
1949 generate_header HashStyle LGPLv2;
1956 Sys::Guestfs - Perl bindings for libguestfs
1962 my $h = Sys::Guestfs->new ();
1963 $h->add_drive ('guest.img');
1966 $h->mount ('/dev/sda1', '/');
1967 $h->touch ('/hello');
1972 The C<Sys::Guestfs> module provides a Perl XS binding to the
1973 libguestfs API for examining and modifying virtual machine
1976 Amongst the things this is good for: making batch configuration
1977 changes to guests, getting disk used/free statistics (see also:
1978 virt-df), migrating between virtualization systems (see also:
1979 virt-p2v), performing partial backups, performing partial guest
1980 clones, cloning guests and changing registry/UUID/hostname info, and
1983 Libguestfs uses Linux kernel and qemu code, and can access any type of
1984 guest filesystem that Linux and qemu can, including but not limited
1985 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
1986 schemes, qcow, qcow2, vmdk.
1988 Libguestfs provides ways to enumerate guest storage (eg. partitions,
1989 LVs, what filesystem is in each LV, etc.). It can also run commands
1990 in the context of the guest. Also you can access filesystems over FTP.
1994 All errors turn into calls to C<croak> (see L<Carp(3)>).
2002 package Sys::Guestfs;
2008 XSLoader::load ('Sys::Guestfs');
2010 =item $h = Sys::Guestfs->new ();
2012 Create a new guestfs handle.
2018 my $class = ref ($proto) || $proto;
2020 my $self = Sys::Guestfs::_create ();
2021 bless $self, $class;
2027 (* Actions. We only need to print documentation for these as
2028 * they are pulled in from the XS code automatically.
2031 fun (name, style, _, flags, _, longdesc) ->
2032 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2034 generate_perl_prototype name style;
2036 pr "%s\n\n" longdesc;
2037 if List.mem ProtocolLimitWarning flags then
2038 pr "Because of the message protocol, there is a transfer limit
2039 of somewhere between 2MB and 4MB. To transfer large files you should use
2041 ) all_functions_sorted;
2053 Copyright (C) 2009 Red Hat Inc.
2057 Please see the file COPYING.LIB for the full license.
2061 L<guestfs(3)>, L<guestfish(1)>.
2066 and generate_perl_prototype name style =
2067 (match fst style with
2071 | RString n -> pr "$%s = " n
2075 | RLVList n -> pr "@%s = " n
2078 let comma = ref false in
2081 if !comma then pr ", ";
2084 | String n -> pr "%s" n
2085 | OptString n -> pr "%s" n
2086 | Bool n -> pr "%s" n
2090 let output_to filename =
2091 let filename_new = filename ^ ".new" in
2092 chan := open_out filename_new;
2096 Unix.rename filename_new filename;
2097 printf "written %s\n%!" filename;
2105 let close = output_to "src/guestfs_protocol.x" in
2109 let close = output_to "src/guestfs-structs.h" in
2110 generate_structs_h ();
2113 let close = output_to "src/guestfs-actions.h" in
2114 generate_actions_h ();
2117 let close = output_to "src/guestfs-actions.c" in
2118 generate_client_actions ();
2121 let close = output_to "daemon/actions.h" in
2122 generate_daemon_actions_h ();
2125 let close = output_to "daemon/stubs.c" in
2126 generate_daemon_actions ();
2129 let close = output_to "fish/cmds.c" in
2130 generate_fish_cmds ();
2133 let close = output_to "guestfs-structs.pod" in
2134 generate_structs_pod ();
2137 let close = output_to "guestfs-actions.pod" in
2138 generate_actions_pod ();
2141 let close = output_to "guestfish-actions.pod" in
2142 generate_fish_actions_pod ();
2145 let close = output_to "ocaml/guestfs.mli" in
2146 generate_ocaml_mli ();
2149 let close = output_to "ocaml/guestfs.ml" in
2150 generate_ocaml_ml ();
2153 let close = output_to "ocaml/guestfs_c_actions.c" in
2154 generate_ocaml_c ();
2157 let close = output_to "perl/Guestfs.xs" in
2158 generate_perl_xs ();
2161 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2162 generate_perl_pm ();