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
441 let rec loop i = function
443 | x :: xs -> f i x; loop (i+1) xs
447 (* 'pr' prints to the current output file. *)
448 let chan = ref stdout
449 let pr fs = ksprintf (output_string !chan) fs
451 let iter_args f = function
454 | P2 (arg1, arg2) -> f arg1; f arg2
456 let iteri_args f = function
458 | P1 arg1 -> f 0 arg1
459 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
461 let map_args f = function
463 | P1 arg1 -> [f arg1]
464 | P2 (arg1, arg2) -> [f arg1; f arg2]
466 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
468 (* Check function names etc. for consistency. *)
469 let check_functions () =
471 fun (name, _, _, _, _, longdesc) ->
472 if String.contains name '-' then
473 failwithf "function name '%s' should not contain '-', use '_' instead."
475 if longdesc.[String.length longdesc-1] = '\n' then
476 failwithf "long description of %s should not end with \\n." name
480 fun (name, _, proc_nr, _, _, _) ->
482 failwithf "daemon function %s should have proc_nr > 0" name
486 fun (name, _, proc_nr, _, _, _) ->
487 if proc_nr <> -1 then
488 failwithf "non-daemon function %s should have proc_nr -1" name
489 ) non_daemon_functions;
492 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
495 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
496 let rec loop = function
499 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
501 | (name1,nr1) :: (name2,nr2) :: _ ->
502 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
507 type comment_style = CStyle | HashStyle | OCamlStyle
508 type license = GPLv2 | LGPLv2
510 (* Generate a header block in a number of standard styles. *)
511 let rec generate_header comment license =
512 let c = match comment with
513 | CStyle -> pr "/* "; " *"
514 | HashStyle -> pr "# "; "#"
515 | OCamlStyle -> pr "(* "; " *" in
516 pr "libguestfs generated file\n";
517 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
518 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
520 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
524 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
525 pr "%s it under the terms of the GNU General Public License as published by\n" c;
526 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
527 pr "%s (at your option) any later version.\n" c;
529 pr "%s This program is distributed in the hope that it will be useful,\n" c;
530 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
531 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
532 pr "%s GNU General Public License for more details.\n" c;
534 pr "%s You should have received a copy of the GNU General Public License along\n" c;
535 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
536 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
539 pr "%s This library is free software; you can redistribute it and/or\n" c;
540 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
541 pr "%s License as published by the Free Software Foundation; either\n" c;
542 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
544 pr "%s This library is distributed in the hope that it will be useful,\n" c;
545 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
546 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
547 pr "%s Lesser General Public License for more details.\n" c;
549 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
550 pr "%s License along with this library; if not, write to the Free Software\n" c;
551 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
554 | CStyle -> pr " */\n"
556 | OCamlStyle -> pr " *)\n"
560 (* Generate the pod documentation for the C API. *)
561 and generate_actions_pod () =
563 fun (shortname, style, _, flags, _, longdesc) ->
564 let name = "guestfs_" ^ shortname in
565 pr "=head2 %s\n\n" name;
567 generate_prototype ~extern:false ~handle:"handle" name style;
569 pr "%s\n\n" longdesc;
570 (match fst style with
572 pr "This function returns 0 on success or -1 on error.\n\n"
574 pr "This function returns a C truth value on success or -1 on error.\n\n"
576 pr "This function returns a string or NULL on error.
577 The string is owned by the guest handle and must I<not> be freed.\n\n"
579 pr "This function returns a string or NULL on error.
580 I<The caller must free the returned string after use>.\n\n"
582 pr "This function returns a NULL-terminated array of strings
583 (like L<environ(3)>), or NULL if there was an error.
584 I<The caller must free the strings and the array after use>.\n\n"
586 pr "This function returns a C<struct guestfs_lvm_pv_list>.
587 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
589 pr "This function returns a C<struct guestfs_lvm_vg_list>.
590 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
592 pr "This function returns a C<struct guestfs_lvm_lv_list>.
593 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
595 if List.mem ProtocolLimitWarning flags then
596 pr "Because of the message protocol, there is a transfer limit
597 of somewhere between 2MB and 4MB. To transfer large files you should use
599 ) all_functions_sorted
601 and generate_structs_pod () =
602 (* LVM structs documentation. *)
605 pr "=head2 guestfs_lvm_%s\n" typ;
607 pr " struct guestfs_lvm_%s {\n" typ;
610 | name, `String -> pr " char *%s;\n" name
612 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
613 pr " char %s[32];\n" name
614 | name, `Bytes -> pr " uint64_t %s;\n" name
615 | name, `Int -> pr " int64_t %s;\n" name
616 | name, `OptPercent ->
617 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
618 pr " float %s;\n" name
621 pr " struct guestfs_lvm_%s_list {\n" typ;
622 pr " uint32_t len; /* Number of elements in list. */\n";
623 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
626 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
629 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
631 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
632 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
633 * have to use an underscore instead of a dash because otherwise
634 * rpcgen generates incorrect code.
636 * This header is NOT exported to clients, but see also generate_structs_h.
638 and generate_xdr () =
639 generate_header CStyle LGPLv2;
641 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
642 pr "typedef string str<>;\n";
645 (* LVM internal structures. *)
649 pr "struct guestfs_lvm_int_%s {\n" typ;
651 | name, `String -> pr " string %s<>;\n" name
652 | name, `UUID -> pr " opaque %s[32];\n" name
653 | name, `Bytes -> pr " hyper %s;\n" name
654 | name, `Int -> pr " hyper %s;\n" name
655 | name, `OptPercent -> pr " float %s;\n" name
659 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
661 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
664 fun(shortname, style, _, _, _, _) ->
665 let name = "guestfs_" ^ shortname in
666 pr "/* %s */\n\n" name;
667 (match snd style with
670 pr "struct %s_args {\n" name;
673 | String name -> pr " string %s<>;\n" name
674 | OptString name -> pr " string *%s<>;\n" name
675 | Bool name -> pr " bool %s;\n" name
679 (match fst style with
682 pr "struct %s_ret {\n" name;
686 failwithf "RConstString cannot be returned from a daemon function"
688 pr "struct %s_ret {\n" name;
689 pr " string %s<>;\n" n;
692 pr "struct %s_ret {\n" name;
696 pr "struct %s_ret {\n" name;
697 pr " guestfs_lvm_int_pv_list %s;\n" n;
700 pr "struct %s_ret {\n" name;
701 pr " guestfs_lvm_int_vg_list %s;\n" n;
704 pr "struct %s_ret {\n" name;
705 pr " guestfs_lvm_int_lv_list %s;\n" n;
710 (* Table of procedure numbers. *)
711 pr "enum guestfs_procedure {\n";
713 fun (shortname, _, proc_nr, _, _, _) ->
714 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
716 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
720 (* Having to choose a maximum message size is annoying for several
721 * reasons (it limits what we can do in the API), but it (a) makes
722 * the protocol a lot simpler, and (b) provides a bound on the size
723 * of the daemon which operates in limited memory space. For large
724 * file transfers you should use FTP.
726 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
729 (* Message header, etc. *)
731 const GUESTFS_PROGRAM = 0x2000F5F5;
732 const GUESTFS_PROTOCOL_VERSION = 1;
734 enum guestfs_message_direction {
735 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
736 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
739 enum guestfs_message_status {
740 GUESTFS_STATUS_OK = 0,
741 GUESTFS_STATUS_ERROR = 1
744 const GUESTFS_ERROR_LEN = 256;
746 struct guestfs_message_error {
747 string error<GUESTFS_ERROR_LEN>; /* error message */
750 struct guestfs_message_header {
751 unsigned prog; /* GUESTFS_PROGRAM */
752 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
753 guestfs_procedure proc; /* GUESTFS_PROC_x */
754 guestfs_message_direction direction;
755 unsigned serial; /* message serial number */
756 guestfs_message_status status;
760 (* Generate the guestfs-structs.h file. *)
761 and generate_structs_h () =
762 generate_header CStyle LGPLv2;
764 (* This is a public exported header file containing various
765 * structures. The structures are carefully written to have
766 * exactly the same in-memory format as the XDR structures that
767 * we use on the wire to the daemon. The reason for creating
768 * copies of these structures here is just so we don't have to
769 * export the whole of guestfs_protocol.h (which includes much
770 * unrelated and XDR-dependent stuff that we don't want to be
771 * public, or required by clients).
773 * To reiterate, we will pass these structures to and from the
774 * client with a simple assignment or memcpy, so the format
775 * must be identical to what rpcgen / the RFC defines.
778 (* LVM public structures. *)
782 pr "struct guestfs_lvm_%s {\n" typ;
785 | name, `String -> pr " char *%s;\n" name
786 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
787 | name, `Bytes -> pr " uint64_t %s;\n" name
788 | name, `Int -> pr " int64_t %s;\n" name
789 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
793 pr "struct guestfs_lvm_%s_list {\n" typ;
794 pr " uint32_t len;\n";
795 pr " struct guestfs_lvm_%s *val;\n" typ;
798 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
800 (* Generate the guestfs-actions.h file. *)
801 and generate_actions_h () =
802 generate_header CStyle LGPLv2;
804 fun (shortname, style, _, _, _, _) ->
805 let name = "guestfs_" ^ shortname in
806 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
810 (* Generate the client-side dispatch stubs. *)
811 and generate_client_actions () =
812 generate_header CStyle LGPLv2;
814 (* Client-side stubs for each function. *)
816 fun (shortname, style, _, _, _, _) ->
817 let name = "guestfs_" ^ shortname in
819 (* Generate the return value struct. *)
820 pr "struct %s_rv {\n" shortname;
821 pr " int cb_done; /* flag to indicate callback was called */\n";
822 pr " struct guestfs_message_header hdr;\n";
823 pr " struct guestfs_message_error err;\n";
824 (match fst style with
827 failwithf "RConstString cannot be returned from a daemon function"
828 | RBool _ | RString _ | RStringList _
829 | RPVList _ | RVGList _ | RLVList _ ->
830 pr " struct %s_ret ret;\n" name
834 (* Generate the callback function. *)
835 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
837 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
839 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
840 pr " error (g, \"%s: failed to parse reply header\");\n" name;
843 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
844 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
845 pr " error (g, \"%s: failed to parse reply error\");\n" name;
851 (match fst style with
854 failwithf "RConstString cannot be returned from a daemon function"
855 | RBool _ | RString _ | RStringList _
856 | RPVList _ | RVGList _ | RLVList _ ->
857 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
858 pr " error (g, \"%s: failed to parse reply\");\n" name;
864 pr " rv->cb_done = 1;\n";
865 pr " main_loop.main_loop_quit (g);\n";
868 (* Generate the action stub. *)
869 generate_prototype ~extern:false ~semicolon:false ~newline:true
870 ~handle:"g" name style;
874 | Err | RBool _ -> "-1"
876 failwithf "RConstString cannot be returned from a daemon function"
877 | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
882 (match snd style with
884 | _ -> pr " struct %s_args args;\n" name
887 pr " struct %s_rv rv;\n" shortname;
890 pr " if (g->state != READY) {\n";
891 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
894 pr " return %s;\n" error_code;
897 pr " memset (&rv, 0, sizeof rv);\n";
900 (match snd style with
902 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
903 (String.uppercase shortname)
908 pr " args.%s = (char *) %s;\n" name name
910 pr " args.%s = %s ? *%s : NULL;\n" name name name
912 pr " args.%s = %s;\n" name name
914 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
915 (String.uppercase shortname);
916 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
919 pr " if (serial == -1)\n";
920 pr " return %s;\n" error_code;
923 pr " rv.cb_done = 0;\n";
924 pr " g->reply_cb_internal = %s_cb;\n" shortname;
925 pr " g->reply_cb_internal_data = &rv;\n";
926 pr " main_loop.main_loop_run (g);\n";
927 pr " g->reply_cb_internal = NULL;\n";
928 pr " g->reply_cb_internal_data = NULL;\n";
929 pr " if (!rv.cb_done) {\n";
930 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
931 pr " return %s;\n" error_code;
935 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
936 (String.uppercase shortname);
937 pr " return %s;\n" error_code;
940 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
941 pr " error (g, \"%%s\", rv.err.error);\n";
942 pr " return %s;\n" error_code;
946 (match fst style with
947 | Err -> pr " return 0;\n"
948 | RBool n -> pr " return rv.ret.%s;\n" n
950 failwithf "RConstString cannot be returned from a daemon function"
952 pr " return rv.ret.%s; /* caller will free */\n" n
954 pr " /* caller will free this, but we need to add a NULL entry */\n";
955 pr " rv.ret.%s.%s_val =" n n;
956 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
957 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
959 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
960 pr " return rv.ret.%s.%s_val;\n" n n
962 pr " /* caller will free this */\n";
963 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
965 pr " /* caller will free this */\n";
966 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
968 pr " /* caller will free this */\n";
969 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
975 (* Generate daemon/actions.h. *)
976 and generate_daemon_actions_h () =
977 generate_header CStyle GPLv2;
979 pr "#include \"../src/guestfs_protocol.h\"\n";
983 fun (name, style, _, _, _, _) ->
985 ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
988 (* Generate the server-side stubs. *)
989 and generate_daemon_actions () =
990 generate_header CStyle GPLv2;
992 pr "#define _GNU_SOURCE // for strchrnul\n";
994 pr "#include <stdio.h>\n";
995 pr "#include <stdlib.h>\n";
996 pr "#include <string.h>\n";
997 pr "#include <inttypes.h>\n";
998 pr "#include <ctype.h>\n";
999 pr "#include <rpc/types.h>\n";
1000 pr "#include <rpc/xdr.h>\n";
1002 pr "#include \"daemon.h\"\n";
1003 pr "#include \"../src/guestfs_protocol.h\"\n";
1004 pr "#include \"actions.h\"\n";
1008 fun (name, style, _, _, _, _) ->
1009 (* Generate server-side stubs. *)
1010 pr "static void %s_stub (XDR *xdr_in)\n" name;
1013 match fst style with
1014 | Err -> pr " int r;\n"; "-1"
1015 | RBool _ -> pr " int r;\n"; "-1"
1017 failwithf "RConstString cannot be returned from a daemon function"
1018 | RString _ -> pr " char *r;\n"; "NULL"
1019 | RStringList _ -> pr " char **r;\n"; "NULL"
1020 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1021 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1022 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1024 (match snd style with
1027 pr " struct guestfs_%s_args args;\n" name;
1031 | OptString name -> pr " const char *%s;\n" name
1032 | Bool name -> pr " int %s;\n" name
1037 (match snd style with
1040 pr " memset (&args, 0, sizeof args);\n";
1042 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1043 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
1048 | String name -> pr " %s = args.%s;\n" name name
1049 | OptString name -> pr " %s = args.%s;\n" name name (* XXX? *)
1050 | Bool name -> pr " %s = args.%s;\n" name name
1055 pr " r = do_%s " name;
1056 generate_call_args style;
1059 pr " if (r == %s)\n" error_code;
1060 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
1064 (match fst style with
1065 | Err -> pr " reply (NULL, NULL);\n"
1067 pr " struct guestfs_%s_ret ret;\n" name;
1068 pr " ret.%s = r;\n" n;
1069 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1071 failwithf "RConstString cannot be returned from a daemon function"
1073 pr " struct guestfs_%s_ret ret;\n" name;
1074 pr " ret.%s = r;\n" n;
1075 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1078 pr " struct guestfs_%s_ret ret;\n" name;
1079 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1080 pr " ret.%s.%s_val = r;\n" n n;
1081 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1082 pr " free_strings (r);\n"
1084 pr " struct guestfs_%s_ret ret;\n" name;
1085 pr " ret.%s = *r;\n" n;
1086 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1087 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1089 pr " struct guestfs_%s_ret ret;\n" name;
1090 pr " ret.%s = *r;\n" n;
1091 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1092 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1094 pr " struct guestfs_%s_ret ret;\n" name;
1095 pr " ret.%s = *r;\n" n;
1096 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1097 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1103 (* Dispatch function. *)
1104 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1106 pr " switch (proc_nr) {\n";
1109 fun (name, style, _, _, _, _) ->
1110 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1111 pr " %s_stub (xdr_in);\n" name;
1116 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1121 (* LVM columns and tokenization functions. *)
1122 (* XXX This generates crap code. We should rethink how we
1128 pr "static const char *lvm_%s_cols = \"%s\";\n"
1129 typ (String.concat "," (List.map fst cols));
1132 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1134 pr " char *tok, *p, *next;\n";
1138 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1141 pr " if (!str) {\n";
1142 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1145 pr " if (!*str || isspace (*str)) {\n";
1146 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1151 fun (name, coltype) ->
1152 pr " if (!tok) {\n";
1153 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1156 pr " p = strchrnul (tok, ',');\n";
1157 pr " if (*p) next = p+1; else next = NULL;\n";
1158 pr " *p = '\\0';\n";
1161 pr " r->%s = strdup (tok);\n" name;
1162 pr " if (r->%s == NULL) {\n" name;
1163 pr " perror (\"strdup\");\n";
1167 pr " for (i = j = 0; i < 32; ++j) {\n";
1168 pr " if (tok[j] == '\\0') {\n";
1169 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1171 pr " } else if (tok[j] != '-')\n";
1172 pr " r->%s[i++] = tok[j];\n" name;
1175 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1176 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1180 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1181 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1185 pr " if (tok[0] == '\\0')\n";
1186 pr " r->%s = -1;\n" name;
1187 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1188 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1192 pr " tok = next;\n";
1195 pr " if (tok != NULL) {\n";
1196 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1203 pr "guestfs_lvm_int_%s_list *\n" typ;
1204 pr "parse_command_line_%ss (void)\n" typ;
1206 pr " char *out, *err;\n";
1207 pr " char *p, *pend;\n";
1209 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1210 pr " void *newp;\n";
1212 pr " ret = malloc (sizeof *ret);\n";
1213 pr " if (!ret) {\n";
1214 pr " reply_with_perror (\"malloc\");\n";
1215 pr " return NULL;\n";
1218 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1219 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1221 pr " r = command (&out, &err,\n";
1222 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1223 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1224 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1225 pr " if (r == -1) {\n";
1226 pr " reply_with_error (\"%%s\", err);\n";
1227 pr " free (out);\n";
1228 pr " free (err);\n";
1229 pr " return NULL;\n";
1232 pr " free (err);\n";
1234 pr " /* Tokenize each line of the output. */\n";
1237 pr " while (p) {\n";
1238 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1239 pr " if (pend) {\n";
1240 pr " *pend = '\\0';\n";
1244 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1247 pr " if (!*p) { /* Empty line? Skip it. */\n";
1252 pr " /* Allocate some space to store this next entry. */\n";
1253 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1254 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1255 pr " if (newp == NULL) {\n";
1256 pr " reply_with_perror (\"realloc\");\n";
1257 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1258 pr " free (ret);\n";
1259 pr " free (out);\n";
1260 pr " return NULL;\n";
1262 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1264 pr " /* Tokenize the next entry. */\n";
1265 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1266 pr " if (r == -1) {\n";
1267 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1268 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1269 pr " free (ret);\n";
1270 pr " free (out);\n";
1271 pr " return NULL;\n";
1278 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1280 pr " free (out);\n";
1281 pr " return ret;\n";
1284 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1286 (* Generate a lot of different functions for guestfish. *)
1287 and generate_fish_cmds () =
1288 generate_header CStyle GPLv2;
1292 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1294 let all_functions_sorted =
1296 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1297 ) all_functions_sorted in
1299 pr "#include <stdio.h>\n";
1300 pr "#include <stdlib.h>\n";
1301 pr "#include <string.h>\n";
1302 pr "#include <inttypes.h>\n";
1304 pr "#include <guestfs.h>\n";
1305 pr "#include \"fish.h\"\n";
1308 (* list_commands function, which implements guestfish -h *)
1309 pr "void list_commands (void)\n";
1311 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1312 pr " list_builtin_commands ();\n";
1314 fun (name, _, _, flags, shortdesc, _) ->
1315 let name = replace_char name '_' '-' in
1316 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1318 ) all_functions_sorted;
1319 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1323 (* display_command function, which implements guestfish -h cmd *)
1324 pr "void display_command (const char *cmd)\n";
1327 fun (name, style, _, flags, shortdesc, longdesc) ->
1328 let name2 = replace_char name '_' '-' in
1330 try find_map (function FishAlias n -> Some n | _ -> None) flags
1331 with Not_found -> name in
1332 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1334 match snd style with
1339 String.concat "> <" (
1341 | String n | OptString n | Bool n -> n) args
1346 if List.mem ProtocolLimitWarning flags then
1347 "\n\nBecause of the message protocol, there is a transfer limit
1348 of somewhere between 2MB and 4MB. To transfer large files you should use
1352 let describe_alias =
1353 if name <> alias then
1354 sprintf "\n\nYou can use '%s' as an alias for this command." alias
1358 pr "strcasecmp (cmd, \"%s\") == 0" name;
1359 if name <> name2 then
1360 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1361 if name <> alias then
1362 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1364 pr " pod2text (\"%s - %s\", %S);\n"
1366 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
1369 pr " display_builtin_command (cmd);\n";
1373 (* print_{pv,vg,lv}_list functions *)
1377 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1384 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1386 pr " printf (\"%s: \");\n" name;
1387 pr " for (i = 0; i < 32; ++i)\n";
1388 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1389 pr " printf (\"\\n\");\n"
1391 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1393 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1394 | name, `OptPercent ->
1395 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1396 typ name name typ name;
1397 pr " else printf (\"%s: \\n\");\n" name
1401 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1406 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1407 pr " print_%s (&%ss->val[i]);\n" typ typ;
1410 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1412 (* run_<action> actions *)
1414 fun (name, style, _, flags, _, _) ->
1415 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1417 (match fst style with
1419 | RBool _ -> pr " int r;\n"
1420 | RConstString _ -> pr " const char *r;\n"
1421 | RString _ -> pr " char *r;\n"
1422 | RStringList _ -> pr " char **r;\n"
1423 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1424 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1425 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1429 | String name -> pr " const char *%s;\n" name
1430 | OptString name -> pr " const char *%s;\n" name
1431 | Bool name -> pr " int %s;\n" name
1434 (* Check and convert parameters. *)
1435 let argc_expected = nr_args (snd style) in
1436 pr " if (argc != %d) {\n" argc_expected;
1437 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1439 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1445 | String name -> pr " %s = argv[%d];\n" name i
1447 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
1450 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
1453 (* Call C API function. *)
1455 try find_map (function FishAction n -> Some n | _ -> None) flags
1456 with Not_found -> sprintf "guestfs_%s" name in
1458 generate_call_args ~handle:"g" style;
1461 (* Check return value for errors and display command results. *)
1462 (match fst style with
1463 | Err -> pr " return r;\n"
1465 pr " if (r == -1) return -1;\n";
1466 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
1469 pr " if (r == NULL) return -1;\n";
1470 pr " printf (\"%%s\\n\", r);\n";
1473 pr " if (r == NULL) return -1;\n";
1474 pr " printf (\"%%s\\n\", r);\n";
1478 pr " if (r == NULL) return -1;\n";
1479 pr " print_strings (r);\n";
1480 pr " free_strings (r);\n";
1483 pr " if (r == NULL) return -1;\n";
1484 pr " print_pv_list (r);\n";
1485 pr " guestfs_free_lvm_pv_list (r);\n";
1488 pr " if (r == NULL) return -1;\n";
1489 pr " print_vg_list (r);\n";
1490 pr " guestfs_free_lvm_vg_list (r);\n";
1493 pr " if (r == NULL) return -1;\n";
1494 pr " print_lv_list (r);\n";
1495 pr " guestfs_free_lvm_lv_list (r);\n";
1502 (* run_action function *)
1503 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1506 fun (name, _, _, flags, _, _) ->
1507 let name2 = replace_char name '_' '-' in
1509 try find_map (function FishAlias n -> Some n | _ -> None) flags
1510 with Not_found -> name in
1512 pr "strcasecmp (cmd, \"%s\") == 0" name;
1513 if name <> name2 then
1514 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1515 if name <> alias then
1516 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
1518 pr " return run_%s (cmd, argc, argv);\n" name;
1522 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1529 (* Generate the POD documentation for guestfish. *)
1530 and generate_fish_actions_pod () =
1531 let all_functions_sorted =
1533 fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
1534 ) all_functions_sorted in
1537 fun (name, style, _, flags, _, longdesc) ->
1538 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1539 let name = replace_char name '_' '-' in
1541 try find_map (function FishAlias n -> Some n | _ -> None) flags
1542 with Not_found -> name in
1544 pr "=head2 %s" name;
1545 if name <> alias then
1552 | String n -> pr " %s" n
1553 | OptString n -> pr " %s" n
1554 | Bool _ -> pr " true|false"
1558 pr "%s\n\n" longdesc
1559 ) all_functions_sorted
1561 (* Generate a C function prototype. *)
1562 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1563 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1564 ?handle name style =
1565 if extern then pr "extern ";
1566 if static then pr "static ";
1567 (match fst style with
1569 | RBool _ -> pr "int "
1570 | RConstString _ -> pr "const char *"
1571 | RString _ -> pr "char *"
1572 | RStringList _ -> pr "char **"
1574 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1575 else pr "guestfs_lvm_int_pv_list *"
1577 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1578 else pr "guestfs_lvm_int_vg_list *"
1580 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1581 else pr "guestfs_lvm_int_lv_list *"
1584 let comma = ref false in
1587 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1591 if single_line then pr ", " else pr ",\n\t\t"
1597 | String name -> next (); pr "const char *%s" name
1598 | OptString name -> next (); pr "const char *%s" name
1599 | Bool name -> next (); pr "int %s" name
1602 if semicolon then pr ";";
1603 if newline then pr "\n"
1605 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1606 and generate_call_args ?handle style =
1608 let comma = ref false in
1611 | Some handle -> pr "%s" handle; comma := true
1615 if !comma then pr ", ";
1618 | String name -> pr "%s" name
1619 | OptString name -> pr "%s" name
1620 | Bool name -> pr "%s" name
1624 (* Generate the OCaml bindings interface. *)
1625 and generate_ocaml_mli () =
1626 generate_header OCamlStyle LGPLv2;
1629 (** For API documentation you should refer to the C API
1630 in the guestfs(3) manual page. The OCaml API uses almost
1631 exactly the same calls. *)
1634 (** A [guestfs_h] handle. *)
1636 exception Error of string
1637 (** This exception is raised when there is an error. *)
1639 val create : unit -> t
1641 val close : t -> unit
1642 (** Handles are closed by the garbage collector when they become
1643 unreferenced, but callers can also call this in order to
1644 provide predictable cleanup. *)
1647 generate_ocaml_lvm_structure_decls ();
1651 fun (name, style, _, _, shortdesc, _) ->
1652 generate_ocaml_prototype name style;
1653 pr "(** %s *)\n" shortdesc;
1657 (* Generate the OCaml bindings implementation. *)
1658 and generate_ocaml_ml () =
1659 generate_header OCamlStyle LGPLv2;
1663 exception Error of string
1664 external create : unit -> t = \"ocaml_guestfs_create\"
1665 external close : t -> unit = \"ocaml_guestfs_close\"
1668 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
1672 generate_ocaml_lvm_structure_decls ();
1676 fun (name, style, _, _, shortdesc, _) ->
1677 generate_ocaml_prototype ~is_external:true name style;
1680 (* Generate the OCaml bindings C implementation. *)
1681 and generate_ocaml_c () =
1682 generate_header CStyle LGPLv2;
1684 pr "#include <stdio.h>\n";
1685 pr "#include <stdlib.h>\n";
1686 pr "#include <string.h>\n";
1688 pr "#include <caml/config.h>\n";
1689 pr "#include <caml/alloc.h>\n";
1690 pr "#include <caml/callback.h>\n";
1691 pr "#include <caml/fail.h>\n";
1692 pr "#include <caml/memory.h>\n";
1693 pr "#include <caml/mlvalues.h>\n";
1694 pr "#include <caml/signals.h>\n";
1696 pr "#include <guestfs.h>\n";
1698 pr "#include \"guestfs_c.h\"\n";
1701 (* LVM struct copy functions. *)
1704 let has_optpercent_col =
1705 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
1707 pr "static CAMLprim value\n";
1708 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
1710 pr " CAMLparam0 ();\n";
1711 if has_optpercent_col then
1712 pr " CAMLlocal3 (rv, v, v2);\n"
1714 pr " CAMLlocal2 (rv, v);\n";
1716 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
1721 pr " v = caml_copy_string (%s->%s);\n" typ name
1723 pr " v = caml_alloc_string (32);\n";
1724 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
1727 pr " v = caml_copy_int64 (%s->%s);\n" typ name
1728 | name, `OptPercent ->
1729 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
1730 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
1731 pr " v = caml_alloc (1, 0);\n";
1732 pr " Store_field (v, 0, v2);\n";
1733 pr " } else /* None */\n";
1734 pr " v = Val_int (0);\n";
1736 pr " Store_field (rv, %d, v);\n" i
1738 pr " CAMLreturn (rv);\n";
1742 pr "static CAMLprim value\n";
1743 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
1746 pr " CAMLparam0 ();\n";
1747 pr " CAMLlocal2 (rv, v);\n";
1750 pr " if (%ss->len == 0)\n" typ;
1751 pr " CAMLreturn (Atom (0));\n";
1753 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
1754 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
1755 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
1756 pr " caml_modify (&Field (rv, i), v);\n";
1758 pr " CAMLreturn (rv);\n";
1762 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1765 fun (name, style, _, _, _, _) ->
1766 pr "CAMLprim value\n";
1767 pr "ocaml_guestfs_%s (value gv" name;
1770 | String n | OptString n | Bool n -> pr ", value %sv" n
1774 pr " CAMLparam%d (gv" (1 + (nr_args (snd style)));
1777 | String n | OptString n | Bool n -> pr ", %sv" n
1780 pr " CAMLlocal1 (rv);\n";
1783 pr " guestfs_h *g = Guestfs_val (gv);\n";
1784 pr " if (g == NULL)\n";
1785 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
1791 pr " const char *%s = String_val (%sv);\n" n n
1793 pr " const char *%s =\n" n;
1794 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
1797 pr " int %s = Bool_val (%sv);\n" n n
1800 match fst style with
1801 | Err -> pr " int r;\n"; "-1"
1802 | RBool _ -> pr " int r;\n"; "-1"
1803 | RConstString _ -> pr " const char *r;\n"; "NULL"
1804 | RString _ -> pr " char *r;\n"; "NULL"
1810 pr " struct guestfs_lvm_pv_list *r;\n";
1813 pr " struct guestfs_lvm_vg_list *r;\n";
1816 pr " struct guestfs_lvm_lv_list *r;\n";
1820 pr " caml_enter_blocking_section ();\n";
1821 pr " r = guestfs_%s " name;
1822 generate_call_args ~handle:"g" style;
1824 pr " caml_leave_blocking_section ();\n";
1825 pr " if (r == %s)\n" error_code;
1826 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
1829 (match fst style with
1830 | Err -> pr " rv = Val_unit;\n"
1831 | RBool _ -> pr " rv = r ? Val_true : Val_false;\n"
1832 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
1834 pr " rv = caml_copy_string (r);\n";
1837 pr " rv = caml_copy_string_array ((const char **) r);\n";
1838 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
1841 pr " rv = copy_lvm_pv_list (r);\n";
1842 pr " guestfs_free_lvm_pv_list (r);\n";
1844 pr " rv = copy_lvm_vg_list (r);\n";
1845 pr " guestfs_free_lvm_vg_list (r);\n";
1847 pr " rv = copy_lvm_lv_list (r);\n";
1848 pr " guestfs_free_lvm_lv_list (r);\n";
1851 pr " CAMLreturn (rv);\n";
1856 and generate_ocaml_lvm_structure_decls () =
1859 pr "type lvm_%s = {\n" typ;
1862 | name, `String -> pr " %s : string;\n" name
1863 | name, `UUID -> pr " %s : string;\n" name
1864 | name, `Bytes -> pr " %s : int64;\n" name
1865 | name, `Int -> pr " %s : int64;\n" name
1866 | name, `OptPercent -> pr " %s : float option;\n" name
1870 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1872 and generate_ocaml_prototype ?(is_external = false) name style =
1873 if is_external then pr "external " else pr "val ";
1874 pr "%s : t -> " name;
1877 | String _ -> pr "string -> "
1878 | OptString _ -> pr "string option -> "
1879 | Bool _ -> pr "bool -> "
1881 (match fst style with
1882 | Err -> pr "unit" (* all errors are turned into exceptions *)
1883 | RBool _ -> pr "bool"
1884 | RConstString _ -> pr "string"
1885 | RString _ -> pr "string"
1886 | RStringList _ -> pr "string array"
1887 | RPVList _ -> pr "lvm_pv array"
1888 | RVGList _ -> pr "lvm_vg array"
1889 | RLVList _ -> pr "lvm_lv array"
1891 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
1894 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
1895 and generate_perl_xs () =
1896 generate_header CStyle LGPLv2;
1899 #include \"EXTERN.h\"
1903 #include <guestfs.h>
1906 #define PRId64 \"lld\"
1910 my_newSVll(long long val) {
1911 #ifdef USE_64_BIT_ALL
1912 return newSViv(val);
1916 len = snprintf(buf, 100, \"%%\" PRId64, val);
1917 return newSVpv(buf, len);
1922 #define PRIu64 \"llu\"
1926 my_newSVull(unsigned long long val) {
1927 #ifdef USE_64_BIT_ALL
1928 return newSVuv(val);
1932 len = snprintf(buf, 100, \"%%\" PRIu64, val);
1933 return newSVpv(buf, len);
1937 /* XXX Not thread-safe, and in general not safe if the caller is
1938 * issuing multiple requests in parallel (on different guestfs
1939 * handles). We should use the guestfs_h handle passed to the
1940 * error handle to distinguish these cases.
1942 static char *last_error = NULL;
1945 error_handler (guestfs_h *g,
1949 if (last_error != NULL) free (last_error);
1950 last_error = strdup (msg);
1953 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
1958 RETVAL = guestfs_create ();
1960 croak (\"could not create guestfs handle\");
1961 guestfs_set_error_handler (RETVAL, error_handler, NULL);
1974 fun (name, style, _, _, _, _) ->
1975 (match fst style with
1976 | Err -> pr "void\n"
1977 | RBool _ -> pr "SV *\n"
1978 | RConstString _ -> pr "SV *\n"
1979 | RString _ -> pr "SV *\n"
1981 | RPVList _ | RVGList _ | RLVList _ ->
1982 pr "void\n" (* all lists returned implictly on the stack *)
1984 (* Call and arguments. *)
1986 generate_call_args ~handle:"g" style;
1988 pr " guestfs_h *g;\n";
1991 | String n -> pr " char *%s;\n" n
1992 | OptString n -> pr " char *%s;\n" n
1993 | Bool n -> pr " int %s;\n" n
1996 (match fst style with
1999 pr " if (guestfs_%s " name;
2000 generate_call_args ~handle:"g" style;
2002 pr " croak (\"%s: %%s\", last_error);\n" name
2005 pr " const char *%s;\n" n;
2007 pr " %s = guestfs_%s " n name;
2008 generate_call_args ~handle:"g" style;
2010 pr " if (%s == NULL)\n" n;
2011 pr " croak (\"%s: %%s\", last_error);\n" name;
2012 pr " RETVAL = newSVpv (%s, 0);\n" n;
2017 pr " char *%s;\n" n;
2019 pr " %s = guestfs_%s " n name;
2020 generate_call_args ~handle:"g" style;
2022 pr " if (%s == NULL)\n" n;
2023 pr " croak (\"%s: %%s\", last_error);\n" name;
2024 pr " RETVAL = newSVpv (%s, 0);\n" n;
2025 pr " free (%s);\n" n;
2032 pr " %s = guestfs_%s " n name;
2033 generate_call_args ~handle:"g" style;
2035 pr " if (%s == -1)\n" n;
2036 pr " croak (\"%s: %%s\", last_error);\n" name;
2037 pr " RETVAL = newSViv (%s);\n" n;
2042 pr " char **%s;\n" n;
2045 pr " %s = guestfs_%s " n name;
2046 generate_call_args ~handle:"g" style;
2048 pr " if (%s == NULL)\n" n;
2049 pr " croak (\"%s: %%s\", last_error);\n" name;
2050 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
2051 pr " EXTEND (SP, n);\n";
2052 pr " for (i = 0; i < n; ++i) {\n";
2053 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
2054 pr " free (%s[i]);\n" n;
2056 pr " free (%s);\n" n;
2058 generate_perl_lvm_code "pv" pv_cols name style n;
2060 generate_perl_lvm_code "vg" vg_cols name style n;
2062 generate_perl_lvm_code "lv" lv_cols name style n;
2067 and generate_perl_lvm_code typ cols name style n =
2069 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
2073 pr " %s = guestfs_%s " n name;
2074 generate_call_args ~handle:"g" style;
2076 pr " if (%s == NULL)\n" n;
2077 pr " croak (\"%s: %%s\", last_error);\n" name;
2078 pr " EXTEND (SP, %s->len);\n" n;
2079 pr " for (i = 0; i < %s->len; ++i) {\n" n;
2080 pr " hv = newHV ();\n";
2084 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
2085 name (String.length name) n name
2087 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
2088 name (String.length name) n name
2090 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
2091 name (String.length name) n name
2093 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
2094 name (String.length name) n name
2095 | name, `OptPercent ->
2096 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
2097 name (String.length name) n name
2099 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
2101 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
2103 (* Generate Sys/Guestfs.pm. *)
2104 and generate_perl_pm () =
2105 generate_header HashStyle LGPLv2;
2112 Sys::Guestfs - Perl bindings for libguestfs
2118 my $h = Sys::Guestfs->new ();
2119 $h->add_drive ('guest.img');
2122 $h->mount ('/dev/sda1', '/');
2123 $h->touch ('/hello');
2128 The C<Sys::Guestfs> module provides a Perl XS binding to the
2129 libguestfs API for examining and modifying virtual machine
2132 Amongst the things this is good for: making batch configuration
2133 changes to guests, getting disk used/free statistics (see also:
2134 virt-df), migrating between virtualization systems (see also:
2135 virt-p2v), performing partial backups, performing partial guest
2136 clones, cloning guests and changing registry/UUID/hostname info, and
2139 Libguestfs uses Linux kernel and qemu code, and can access any type of
2140 guest filesystem that Linux and qemu can, including but not limited
2141 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
2142 schemes, qcow, qcow2, vmdk.
2144 Libguestfs provides ways to enumerate guest storage (eg. partitions,
2145 LVs, what filesystem is in each LV, etc.). It can also run commands
2146 in the context of the guest. Also you can access filesystems over FTP.
2150 All errors turn into calls to C<croak> (see L<Carp(3)>).
2158 package Sys::Guestfs;
2164 XSLoader::load ('Sys::Guestfs');
2166 =item $h = Sys::Guestfs->new ();
2168 Create a new guestfs handle.
2174 my $class = ref ($proto) || $proto;
2176 my $self = Sys::Guestfs::_create ();
2177 bless $self, $class;
2183 (* Actions. We only need to print documentation for these as
2184 * they are pulled in from the XS code automatically.
2187 fun (name, style, _, flags, _, longdesc) ->
2188 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
2190 generate_perl_prototype name style;
2192 pr "%s\n\n" longdesc;
2193 if List.mem ProtocolLimitWarning flags then
2194 pr "Because of the message protocol, there is a transfer limit
2195 of somewhere between 2MB and 4MB. To transfer large files you should use
2197 ) all_functions_sorted;
2209 Copyright (C) 2009 Red Hat Inc.
2213 Please see the file COPYING.LIB for the full license.
2217 L<guestfs(3)>, L<guestfish(1)>.
2222 and generate_perl_prototype name style =
2223 (match fst style with
2227 | RString n -> pr "$%s = " n
2231 | RLVList n -> pr "@%s = " n
2234 let comma = ref false in
2237 if !comma then pr ", ";
2240 | String n -> pr "%s" n
2241 | OptString n -> pr "%s" n
2242 | Bool n -> pr "%s" n
2246 let output_to filename =
2247 let filename_new = filename ^ ".new" in
2248 chan := open_out filename_new;
2252 Unix.rename filename_new filename;
2253 printf "written %s\n%!" filename;
2261 let close = output_to "src/guestfs_protocol.x" in
2265 let close = output_to "src/guestfs-structs.h" in
2266 generate_structs_h ();
2269 let close = output_to "src/guestfs-actions.h" in
2270 generate_actions_h ();
2273 let close = output_to "src/guestfs-actions.c" in
2274 generate_client_actions ();
2277 let close = output_to "daemon/actions.h" in
2278 generate_daemon_actions_h ();
2281 let close = output_to "daemon/stubs.c" in
2282 generate_daemon_actions ();
2285 let close = output_to "fish/cmds.c" in
2286 generate_fish_cmds ();
2289 let close = output_to "guestfs-structs.pod" in
2290 generate_structs_pod ();
2293 let close = output_to "guestfs-actions.pod" in
2294 generate_actions_pod ();
2297 let close = output_to "guestfish-actions.pod" in
2298 generate_fish_actions_pod ();
2301 let close = output_to "ocaml/guestfs.mli" in
2302 generate_ocaml_mli ();
2305 let close = output_to "ocaml/guestfs.ml" in
2306 generate_ocaml_ml ();
2309 let close = output_to "ocaml/guestfs_c_actions.c" in
2310 generate_ocaml_c ();
2313 let close = output_to "perl/Guestfs.xs" in
2314 generate_perl_xs ();
2317 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2318 generate_perl_pm ();