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 (* "RString" and "RStringList" require special treatment because
36 * the caller must free them.
39 | RStringList of string
40 (* LVM PVs, VGs and LVs. *)
45 (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
50 | String of string (* const char *name, cannot be NULL *)
52 type flags = ProtocolLimitWarning
54 (* Note about long descriptions: When referring to another
55 * action, use the format C<guestfs_other> (ie. the full name of
56 * the C function). This will be replaced as appropriate in other
59 * Apart from that, long descriptions are just perldoc paragraphs.
63 ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
64 "mount a guest disk at a position in the filesystem",
66 Mount a guest disk at a position in the filesystem. Block devices
67 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
68 the guest. If those block devices contain partitions, they will have
69 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
72 The rules are the same as for L<mount(2)>: A filesystem must
73 first be mounted on C</> before others can be mounted. Other
74 filesystems can only be mounted on directories which already
77 The mounted filesystem is writable, if we have sufficient permissions
78 on the underlying device.
80 The filesystem options C<sync> and C<noatime> are set with this
81 call, in order to improve reliability.");
83 ("sync", (Err, P0), 2, [],
84 "sync disks, writes are flushed through to the disk image",
86 This syncs the disk, so that any writes are flushed through to the
87 underlying disk image.
89 You should always call this if you have modified a disk image, before
90 closing the handle.");
92 ("touch", (Err, P1 (String "path")), 3, [],
93 "update file timestamps or create a new file",
95 Touch acts like the L<touch(1)> command. It can be used to
96 update the timestamps on a file, or, if the file does not exist,
97 to create a new zero-length file.");
99 ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
100 "list the contents of a file",
102 Return the contents of the file named C<path>.
104 Note that this function cannot correctly handle binary files
105 (specifically, files containing C<\\0> character which is treated
106 as end of string). For those you need to use the C<guestfs_read_file>
107 function which has a more complex interface.");
109 ("ll", (RString "listing", P1 (String "directory")), 5, [],
110 "list the files in a directory (long format)",
112 List the files in C<directory> (relative to the root directory,
113 there is no cwd) in the format of 'ls -la'.
115 This command is mostly useful for interactive sessions. It
116 is I<not> intended that you try to parse the output string.");
118 ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
119 "list the files in a directory",
121 List the files in C<directory> (relative to the root directory,
122 there is no cwd). The '.' and '..' entries are not returned, but
123 hidden files are shown.
125 This command is mostly useful for interactive sessions. Programs
126 should probably use C<guestfs_readdir> instead.");
128 ("list_devices", (RStringList "devices", P0), 7, [],
129 "list the block devices",
131 List all the block devices.
133 The full block device names are returned, eg. C</dev/sda>");
135 ("list_partitions", (RStringList "partitions", P0), 8, [],
136 "list the partitions",
138 List all the partitions detected on all block devices.
140 The full partition device names are returned, eg. C</dev/sda1>
142 This does not return logical volumes. For that you will need to
143 call C<guestfs_lvs>.");
145 ("pvs", (RStringList "physvols", P0), 9, [],
146 "list the LVM physical volumes (PVs)",
148 List all the physical volumes detected. This is the equivalent
149 of the L<pvs(8)> command.
151 This returns a list of just the device names that contain
152 PVs (eg. C</dev/sda2>).
154 See also C<guestfs_pvs_full>.");
156 ("vgs", (RStringList "volgroups", P0), 10, [],
157 "list the LVM volume groups (VGs)",
159 List all the volumes groups detected. This is the equivalent
160 of the L<vgs(8)> command.
162 This returns a list of just the volume group names that were
163 detected (eg. C<VolGroup00>).
165 See also C<guestfs_vgs_full>.");
167 ("lvs", (RStringList "logvols", P0), 11, [],
168 "list the LVM logical volumes (LVs)",
170 List all the logical volumes detected. This is the equivalent
171 of the L<lvs(8)> command.
173 This returns a list of the logical volume device names
174 (eg. C</dev/VolGroup00/LogVol00>).
176 See also C<guestfs_lvs_full>.");
178 ("pvs_full", (RPVList "physvols", P0), 12, [],
179 "list the LVM physical volumes (PVs)",
181 List all the physical volumes detected. This is the equivalent
182 of the L<pvs(8)> command. The \"full\" version includes all fields.");
184 ("vgs_full", (RVGList "volgroups", P0), 13, [],
185 "list the LVM volume groups (VGs)",
187 List all the volumes groups detected. This is the equivalent
188 of the L<vgs(8)> command. The \"full\" version includes all fields.");
190 ("lvs_full", (RLVList "logvols", P0), 14, [],
191 "list the LVM logical volumes (LVs)",
193 List all the logical volumes detected. This is the equivalent
194 of the L<lvs(8)> command. The \"full\" version includes all fields.");
197 (* Column names and types from LVM PVs/VGs/LVs. *)
206 "pv_attr", `String (* XXX *);
208 "pv_pe_alloc_count", `Int;
211 "pv_mda_count", `Int;
212 "pv_mda_free", `Bytes;
214 "pv_mda_size", `Bytes;
221 "vg_attr", `String (* XXX *);
225 "vg_extent_size", `Bytes;
226 "vg_extent_count", `Int;
227 "vg_free_count", `Int;
235 "vg_mda_count", `Int;
236 "vg_mda_free", `Bytes;
238 "vg_mda_size", `Bytes;
244 "lv_attr", `String (* XXX *);
247 "lv_kernel_major", `Int;
248 "lv_kernel_minor", `Int;
252 "snap_percent", `OptPercent;
253 "copy_percent", `OptPercent;
256 "mirror_log", `String;
260 (* In some places we want the functions to be displayed sorted
261 * alphabetically, so this is useful:
263 let sorted_functions =
264 List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) functions
267 * Note we don't want to use any external OCaml libraries which
268 * makes this a bit harder than it should be.
270 let failwithf fs = ksprintf failwith fs
272 let replace_char s c1 c2 =
273 let s2 = String.copy s in
275 for i = 0 to String.length s2 - 1 do
276 if String.unsafe_get s2 i = c1 then (
277 String.unsafe_set s2 i c2;
281 if not !r then s else s2
284 let len = String.length s in
285 let sublen = String.length sub in
287 if i <= len-sublen then (
290 if s.[i+j] = sub.[j] then loop2 (j+1)
296 if r = -1 then loop (i+1) else r
302 let rec replace_str s s1 s2 =
303 let len = String.length s in
304 let sublen = String.length s1 in
308 let s' = String.sub s 0 i in
309 let s'' = String.sub s (i+sublen) (len-i-sublen) in
310 s' ^ s2 ^ replace_str s'' s1 s2
313 (* 'pr' prints to the current output file. *)
314 let chan = ref stdout
315 let pr fs = ksprintf (output_string !chan) fs
317 let iter_args f = function
320 | P2 (arg1, arg2) -> f arg1; f arg2
322 let iteri_args f = function
324 | P1 arg1 -> f 0 arg1
325 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
327 let map_args f = function
329 | P1 arg1 -> [f arg1]
330 | P2 (arg1, arg2) -> [f arg1; f arg2]
332 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
334 (* Check function names etc. for consistency. *)
335 let check_functions () =
337 fun (name, _, _, _, _, longdesc) ->
338 if String.contains name '-' then
339 failwithf "Function name '%s' should not contain '-', use '_' instead."
341 if longdesc.[String.length longdesc-1] = '\n' then
342 failwithf "Long description of %s should not end with \\n." name
346 List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr) functions in
348 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
349 let rec loop = function
352 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
354 | (name1,nr1) :: (name2,nr2) :: _ ->
355 failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
360 type comment_style = CStyle | HashStyle | OCamlStyle
361 type license = GPLv2 | LGPLv2
363 (* Generate a header block in a number of standard styles. *)
364 let rec generate_header comment license =
365 let c = match comment with
366 | CStyle -> pr "/* "; " *"
367 | HashStyle -> pr "# "; "#"
368 | OCamlStyle -> pr "(* "; " *" in
369 pr "libguestfs generated file\n";
370 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
371 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
373 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
377 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
378 pr "%s it under the terms of the GNU General Public License as published by\n" c;
379 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
380 pr "%s (at your option) any later version.\n" c;
382 pr "%s This program is distributed in the hope that it will be useful,\n" c;
383 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
384 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
385 pr "%s GNU General Public License for more details.\n" c;
387 pr "%s You should have received a copy of the GNU General Public License along\n" c;
388 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
389 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
392 pr "%s This library is free software; you can redistribute it and/or\n" c;
393 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
394 pr "%s License as published by the Free Software Foundation; either\n" c;
395 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
397 pr "%s This library is distributed in the hope that it will be useful,\n" c;
398 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
399 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
400 pr "%s Lesser General Public License for more details.\n" c;
402 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
403 pr "%s License along with this library; if not, write to the Free Software\n" c;
404 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
407 | CStyle -> pr " */\n"
409 | OCamlStyle -> pr " *)\n"
413 (* Generate the pod documentation for the C API. *)
414 and generate_actions_pod () =
416 fun (shortname, style, _, flags, _, longdesc) ->
417 let name = "guestfs_" ^ shortname in
418 pr "=head2 %s\n\n" name;
420 generate_prototype ~extern:false ~handle:"handle" name style;
422 pr "%s\n\n" longdesc;
423 (match fst style with
425 pr "This function returns 0 on success or -1 on error.\n\n"
427 pr "This function returns a string or NULL on error.
428 I<The caller must free the returned string after use>.\n\n"
430 pr "This function returns a NULL-terminated array of strings
431 (like L<environ(3)>), or NULL if there was an error.
432 I<The caller must free the strings and the array after use>.\n\n"
434 pr "This function returns a C<struct guestfs_lvm_pv_list>.
435 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
437 pr "This function returns a C<struct guestfs_lvm_vg_list>.
438 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
440 pr "This function returns a C<struct guestfs_lvm_lv_list>.
441 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
443 if List.mem ProtocolLimitWarning flags then
444 pr "Because of the message protocol, there is a transfer limit
445 of somewhere between 2MB and 4MB. To transfer large files you should use
449 and generate_structs_pod () =
450 (* LVM structs documentation. *)
453 pr "=head2 guestfs_lvm_%s\n" typ;
455 pr " struct guestfs_lvm_%s {\n" typ;
458 | name, `String -> pr " char *%s;\n" name
460 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
461 pr " char %s[32];\n" name
462 | name, `Bytes -> pr " uint64_t %s;\n" name
463 | name, `Int -> pr " int64_t %s;\n" name
464 | name, `OptPercent ->
465 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
466 pr " float %s;\n" name
469 pr " struct guestfs_lvm_%s_list {\n" typ;
470 pr " uint32_t len; /* Number of elements in list. */\n";
471 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
474 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
477 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
479 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
480 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. We
481 * have to use an underscore instead of a dash because otherwise
482 * rpcgen generates incorrect code.
484 * This header is NOT exported to clients, but see also generate_structs_h.
486 and generate_xdr () =
487 generate_header CStyle LGPLv2;
489 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
490 pr "typedef string str<>;\n";
493 (* LVM internal structures. *)
497 pr "struct guestfs_lvm_int_%s {\n" typ;
499 | name, `String -> pr " string %s<>;\n" name
500 | name, `UUID -> pr " opaque %s[32];\n" name
501 | name, `Bytes -> pr " hyper %s;\n" name
502 | name, `Int -> pr " hyper %s;\n" name
503 | name, `OptPercent -> pr " float %s;\n" name
507 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
509 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
512 fun (shortname, style, _, _, _, _) ->
513 let name = "guestfs_" ^ shortname in
514 pr "/* %s */\n\n" name;
515 (match snd style with
518 pr "struct %s_args {\n" name;
521 | String name -> pr " string %s<>;\n" name
525 (match fst style with
528 pr "struct %s_ret {\n" name;
529 pr " string %s<>;\n" n;
532 pr "struct %s_ret {\n" name;
536 pr "struct %s_ret {\n" name;
537 pr " guestfs_lvm_int_pv_list %s;\n" n;
540 pr "struct %s_ret {\n" name;
541 pr " guestfs_lvm_int_vg_list %s;\n" n;
544 pr "struct %s_ret {\n" name;
545 pr " guestfs_lvm_int_lv_list %s;\n" n;
550 (* Table of procedure numbers. *)
551 pr "enum guestfs_procedure {\n";
553 fun (shortname, _, proc_nr, _, _, _) ->
554 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
556 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
560 (* Having to choose a maximum message size is annoying for several
561 * reasons (it limits what we can do in the API), but it (a) makes
562 * the protocol a lot simpler, and (b) provides a bound on the size
563 * of the daemon which operates in limited memory space. For large
564 * file transfers you should use FTP.
566 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
569 (* Message header, etc. *)
571 const GUESTFS_PROGRAM = 0x2000F5F5;
572 const GUESTFS_PROTOCOL_VERSION = 1;
574 enum guestfs_message_direction {
575 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
576 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
579 enum guestfs_message_status {
580 GUESTFS_STATUS_OK = 0,
581 GUESTFS_STATUS_ERROR = 1
584 const GUESTFS_ERROR_LEN = 256;
586 struct guestfs_message_error {
587 string error<GUESTFS_ERROR_LEN>; /* error message */
590 struct guestfs_message_header {
591 unsigned prog; /* GUESTFS_PROGRAM */
592 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
593 guestfs_procedure proc; /* GUESTFS_PROC_x */
594 guestfs_message_direction direction;
595 unsigned serial; /* message serial number */
596 guestfs_message_status status;
600 (* Generate the guestfs-structs.h file. *)
601 and generate_structs_h () =
602 generate_header CStyle LGPLv2;
604 (* This is a public exported header file containing various
605 * structures. The structures are carefully written to have
606 * exactly the same in-memory format as the XDR structures that
607 * we use on the wire to the daemon. The reason for creating
608 * copies of these structures here is just so we don't have to
609 * export the whole of guestfs_protocol.h (which includes much
610 * unrelated and XDR-dependent stuff that we don't want to be
611 * public, or required by clients).
613 * To reiterate, we will pass these structures to and from the
614 * client with a simple assignment or memcpy, so the format
615 * must be identical to what rpcgen / the RFC defines.
618 (* LVM public structures. *)
622 pr "struct guestfs_lvm_%s {\n" typ;
625 | name, `String -> pr " char *%s;\n" name
626 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
627 | name, `Bytes -> pr " uint64_t %s;\n" name
628 | name, `Int -> pr " int64_t %s;\n" name
629 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
633 pr "struct guestfs_lvm_%s_list {\n" typ;
634 pr " uint32_t len;\n";
635 pr " struct guestfs_lvm_%s *val;\n" typ;
638 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
640 (* Generate the guestfs-actions.h file. *)
641 and generate_actions_h () =
642 generate_header CStyle LGPLv2;
644 fun (shortname, style, _, _, _, _) ->
645 let name = "guestfs_" ^ shortname in
646 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
650 (* Generate the client-side dispatch stubs. *)
651 and generate_client_actions () =
652 generate_header CStyle LGPLv2;
654 (* Client-side stubs for each function. *)
656 fun (shortname, style, _, _, _, _) ->
657 let name = "guestfs_" ^ shortname in
659 (* Generate the return value struct. *)
660 pr "struct %s_rv {\n" shortname;
661 pr " int cb_done; /* flag to indicate callback was called */\n";
662 pr " struct guestfs_message_header hdr;\n";
663 pr " struct guestfs_message_error err;\n";
664 (match fst style with
666 | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
667 pr " struct %s_ret ret;\n" name
671 (* Generate the callback function. *)
672 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
674 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
676 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
677 pr " error (g, \"%s: failed to parse reply header\");\n" name;
680 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
681 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
682 pr " error (g, \"%s: failed to parse reply error\");\n" name;
688 (match fst style with
690 | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
691 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
692 pr " error (g, \"%s: failed to parse reply\");\n" name;
698 pr " rv->cb_done = 1;\n";
699 pr " main_loop.main_loop_quit (g);\n";
702 (* Generate the action stub. *)
703 generate_prototype ~extern:false ~semicolon:false ~newline:true
704 ~handle:"g" name style;
709 | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
714 (match snd style with
716 | _ -> pr " struct %s_args args;\n" name
719 pr " struct %s_rv rv;\n" shortname;
722 pr " if (g->state != READY) {\n";
723 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
726 pr " return %s;\n" error_code;
729 pr " memset (&rv, 0, sizeof rv);\n";
732 (match snd style with
734 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
735 (String.uppercase shortname)
739 | String name -> pr " args.%s = (char *) %s;\n" name name
741 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
742 (String.uppercase shortname);
743 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
746 pr " if (serial == -1)\n";
747 pr " return %s;\n" error_code;
750 pr " rv.cb_done = 0;\n";
751 pr " g->reply_cb_internal = %s_cb;\n" shortname;
752 pr " g->reply_cb_internal_data = &rv;\n";
753 pr " main_loop.main_loop_run (g);\n";
754 pr " g->reply_cb_internal = NULL;\n";
755 pr " g->reply_cb_internal_data = NULL;\n";
756 pr " if (!rv.cb_done) {\n";
757 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
758 pr " return %s;\n" error_code;
762 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
763 (String.uppercase shortname);
764 pr " return %s;\n" error_code;
767 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
768 pr " error (g, \"%%s\", rv.err.error);\n";
769 pr " return %s;\n" error_code;
773 (match fst style with
774 | Err -> pr " return 0;\n"
776 pr " return rv.ret.%s; /* caller will free */\n" n
778 pr " /* caller will free this, but we need to add a NULL entry */\n";
779 pr " rv.ret.%s.%s_val =" n n;
780 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
781 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
783 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
784 pr " return rv.ret.%s.%s_val;\n" n n
786 pr " /* caller will free this */\n";
787 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
789 pr " /* caller will free this */\n";
790 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
792 pr " /* caller will free this */\n";
793 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
799 (* Generate daemon/actions.h. *)
800 and generate_daemon_actions_h () =
801 generate_header CStyle GPLv2;
803 pr "#include \"../src/guestfs_protocol.h\"\n";
807 fun (name, style, _, _, _, _) ->
809 ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
812 (* Generate the server-side stubs. *)
813 and generate_daemon_actions () =
814 generate_header CStyle GPLv2;
816 pr "#define _GNU_SOURCE // for strchrnul\n";
818 pr "#include <stdio.h>\n";
819 pr "#include <stdlib.h>\n";
820 pr "#include <string.h>\n";
821 pr "#include <inttypes.h>\n";
822 pr "#include <ctype.h>\n";
823 pr "#include <rpc/types.h>\n";
824 pr "#include <rpc/xdr.h>\n";
826 pr "#include \"daemon.h\"\n";
827 pr "#include \"../src/guestfs_protocol.h\"\n";
828 pr "#include \"actions.h\"\n";
832 fun (name, style, _, _, _, _) ->
833 (* Generate server-side stubs. *)
834 pr "static void %s_stub (XDR *xdr_in)\n" name;
838 | Err -> pr " int r;\n"; "-1"
839 | RString _ -> pr " char *r;\n"; "NULL"
840 | RStringList _ -> pr " char **r;\n"; "NULL"
841 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
842 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
843 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
845 (match snd style with
848 pr " struct guestfs_%s_args args;\n" name;
851 | String name -> pr " const char *%s;\n" name
856 (match snd style with
859 pr " memset (&args, 0, sizeof args);\n";
861 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
862 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
867 | String name -> pr " %s = args.%s;\n" name name
872 pr " r = do_%s " name;
873 generate_call_args style;
876 pr " if (r == %s)\n" error_code;
877 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
881 (match fst style with
882 | Err -> pr " reply (NULL, NULL);\n"
884 pr " struct guestfs_%s_ret ret;\n" name;
885 pr " ret.%s = r;\n" n;
886 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
889 pr " struct guestfs_%s_ret ret;\n" name;
890 pr " ret.%s.%s_len = count_strings (r);\n" n n;
891 pr " ret.%s.%s_val = r;\n" n n;
892 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
893 pr " free_strings (r);\n"
895 pr " struct guestfs_%s_ret ret;\n" name;
896 pr " ret.%s = *r;\n" n;
897 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
898 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
900 pr " struct guestfs_%s_ret ret;\n" name;
901 pr " ret.%s = *r;\n" n;
902 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
903 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
905 pr " struct guestfs_%s_ret ret;\n" name;
906 pr " ret.%s = *r;\n" n;
907 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
908 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
914 (* Dispatch function. *)
915 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
917 pr " switch (proc_nr) {\n";
920 fun (name, style, _, _, _, _) ->
921 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
922 pr " %s_stub (xdr_in);\n" name;
927 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
932 (* LVM columns and tokenization functions. *)
933 (* XXX This generates crap code. We should rethink how we
939 pr "static const char *lvm_%s_cols = \"%s\";\n"
940 typ (String.concat "," (List.map fst cols));
943 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
945 pr " char *tok, *p, *next;\n";
949 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
953 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
956 pr " if (!*str || isspace (*str)) {\n";
957 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
962 fun (name, coltype) ->
964 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
967 pr " p = strchrnul (tok, ',');\n";
968 pr " if (*p) next = p+1; else next = NULL;\n";
972 pr " r->%s = strdup (tok);\n" name;
973 pr " if (r->%s == NULL) {\n" name;
974 pr " perror (\"strdup\");\n";
978 pr " for (i = j = 0; i < 32; ++j) {\n";
979 pr " if (tok[j] == '\\0') {\n";
980 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
982 pr " } else if (tok[j] != '-')\n";
983 pr " r->%s[i++] = tok[j];\n" name;
986 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
987 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
991 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
992 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
996 pr " if (tok[0] == '\\0')\n";
997 pr " r->%s = -1;\n" name;
998 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
999 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1003 pr " tok = next;\n";
1006 pr " if (tok != NULL) {\n";
1007 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1014 pr "guestfs_lvm_int_%s_list *\n" typ;
1015 pr "parse_command_line_%ss (void)\n" typ;
1017 pr " char *out, *err;\n";
1018 pr " char *p, *pend;\n";
1020 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1021 pr " void *newp;\n";
1023 pr " ret = malloc (sizeof *ret);\n";
1024 pr " if (!ret) {\n";
1025 pr " reply_with_perror (\"malloc\");\n";
1026 pr " return NULL;\n";
1029 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1030 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1032 pr " r = command (&out, &err,\n";
1033 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1034 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1035 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1036 pr " if (r == -1) {\n";
1037 pr " reply_with_error (\"%%s\", err);\n";
1038 pr " free (out);\n";
1039 pr " free (err);\n";
1040 pr " return NULL;\n";
1043 pr " free (err);\n";
1045 pr " /* Tokenize each line of the output. */\n";
1048 pr " while (p) {\n";
1049 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1050 pr " if (pend) {\n";
1051 pr " *pend = '\\0';\n";
1055 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
1058 pr " if (!*p) { /* Empty line? Skip it. */\n";
1063 pr " /* Allocate some space to store this next entry. */\n";
1064 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1065 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1066 pr " if (newp == NULL) {\n";
1067 pr " reply_with_perror (\"realloc\");\n";
1068 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1069 pr " free (ret);\n";
1070 pr " free (out);\n";
1071 pr " return NULL;\n";
1073 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1075 pr " /* Tokenize the next entry. */\n";
1076 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1077 pr " if (r == -1) {\n";
1078 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1079 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1080 pr " free (ret);\n";
1081 pr " free (out);\n";
1082 pr " return NULL;\n";
1089 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1091 pr " free (out);\n";
1092 pr " return ret;\n";
1095 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1097 (* Generate a lot of different functions for guestfish. *)
1098 and generate_fish_cmds () =
1099 generate_header CStyle GPLv2;
1101 pr "#include <stdio.h>\n";
1102 pr "#include <stdlib.h>\n";
1103 pr "#include <string.h>\n";
1104 pr "#include <inttypes.h>\n";
1106 pr "#include <guestfs.h>\n";
1107 pr "#include \"fish.h\"\n";
1110 (* list_commands function, which implements guestfish -h *)
1111 pr "void list_commands (void)\n";
1113 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
1114 pr " list_builtin_commands ();\n";
1116 fun (name, _, _, _, shortdesc, _) ->
1117 let name = replace_char name '_' '-' in
1118 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1121 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1125 (* display_command function, which implements guestfish -h cmd *)
1126 pr "void display_command (const char *cmd)\n";
1129 fun (name, style, _, flags, shortdesc, longdesc) ->
1130 let name2 = replace_char name '_' '-' in
1131 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1133 match snd style with
1138 String.concat "> <" (
1140 | String n -> n) args
1145 if List.mem ProtocolLimitWarning flags then
1146 "\n\nBecause of the message protocol, there is a transfer limit
1147 of somewhere between 2MB and 4MB. To transfer large files you should use
1152 pr "strcasecmp (cmd, \"%s\") == 0" name;
1153 if name <> name2 then
1154 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1156 pr " pod2text (\"%s - %s\", %S);\n"
1158 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings);
1161 pr " display_builtin_command (cmd);\n";
1165 (* print_{pv,vg,lv}_list functions *)
1169 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1176 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1178 pr " printf (\"%s: \");\n" name;
1179 pr " for (i = 0; i < 32; ++i)\n";
1180 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
1181 pr " printf (\"\\n\");\n"
1183 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1185 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1186 | name, `OptPercent ->
1187 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1188 typ name name typ name;
1189 pr " else printf (\"%s: \\n\");\n" name
1193 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1198 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
1199 pr " print_%s (&%ss->val[i]);\n" typ typ;
1202 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1204 (* run_<action> actions *)
1206 fun (name, style, _, _, _, _) ->
1207 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1209 (match fst style with
1210 | Err -> pr " int r;\n"
1211 | RString _ -> pr " char *r;\n"
1212 | RStringList _ -> pr " char **r;\n"
1213 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
1214 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
1215 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
1219 | String name -> pr " const char *%s;\n" name
1222 (* Check and convert parameters. *)
1223 let argc_expected = nr_args (snd style) in
1224 pr " if (argc != %d) {\n" argc_expected;
1225 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1227 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1233 | String name -> pr " %s = argv[%d];\n" name i
1236 (* Call C API function. *)
1237 pr " r = guestfs_%s " name;
1238 generate_call_args ~handle:"g" style;
1241 (* Check return value for errors and display command results. *)
1242 (match fst style with
1243 | Err -> pr " return r;\n"
1245 pr " if (r == NULL) return -1;\n";
1246 pr " printf (\"%%s\", r);\n";
1250 pr " if (r == NULL) return -1;\n";
1251 pr " print_strings (r);\n";
1252 pr " free_strings (r);\n";
1255 pr " if (r == NULL) return -1;\n";
1256 pr " print_pv_list (r);\n";
1257 pr " guestfs_free_lvm_pv_list (r);\n";
1260 pr " if (r == NULL) return -1;\n";
1261 pr " print_vg_list (r);\n";
1262 pr " guestfs_free_lvm_vg_list (r);\n";
1265 pr " if (r == NULL) return -1;\n";
1266 pr " print_lv_list (r);\n";
1267 pr " guestfs_free_lvm_lv_list (r);\n";
1274 (* run_action function *)
1275 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1278 fun (name, _, _, _, _, _) ->
1279 let name2 = replace_char name '_' '-' in
1281 pr "strcasecmp (cmd, \"%s\") == 0" name;
1282 if name <> name2 then
1283 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1285 pr " return run_%s (cmd, argc, argv);\n" name;
1289 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1296 (* Generate the POD documentation for guestfish. *)
1297 and generate_fish_actions_pod () =
1299 fun (name, style, _, _, _, longdesc) ->
1300 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
1301 let name = replace_char name '_' '-' in
1302 pr "=head2 %s\n\n" name;
1306 | String n -> pr " %s" n
1310 pr "%s\n\n" longdesc
1313 (* Generate a C function prototype. *)
1314 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1315 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1316 ?handle name style =
1317 if extern then pr "extern ";
1318 if static then pr "static ";
1319 (match fst style with
1321 | RString _ -> pr "char *"
1322 | RStringList _ -> pr "char **"
1324 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1325 else pr "guestfs_lvm_int_pv_list *"
1327 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1328 else pr "guestfs_lvm_int_vg_list *"
1330 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1331 else pr "guestfs_lvm_int_lv_list *"
1334 let comma = ref false in
1337 | Some handle -> pr "guestfs_h *%s" handle; comma := true
1341 if single_line then pr ", " else pr ",\n\t\t"
1347 | String name -> next (); pr "const char *%s" name
1350 if semicolon then pr ";";
1351 if newline then pr "\n"
1353 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1354 and generate_call_args ?handle style =
1356 let comma = ref false in
1359 | Some handle -> pr "%s" handle; comma := true
1363 if !comma then pr ", ";
1366 | String name -> pr "%s" name
1370 (* Generate the OCaml bindings interface. *)
1371 and generate_ocaml_mli () =
1372 generate_header OCamlStyle LGPLv2;
1375 (** For API documentation you should refer to the C API
1376 in the guestfs(3) manual page. The OCaml API uses almost
1377 exactly the same calls. *)
1380 (** A [guestfs_h] handle. *)
1382 exception Error of string
1383 (** This exception is raised when there is an error. *)
1385 val create : unit -> t
1387 val close : t -> unit
1388 (** Handles are closed by the garbage collector when they become
1389 unreferenced, but callers can also call this in order to
1390 provide predictable cleanup. *)
1392 val launch : t -> unit
1393 val wait_ready : t -> unit
1394 val kill_subprocess : t -> unit
1396 val add_drive : t -> string -> unit
1397 val add_cdrom : t -> string -> unit
1398 val config : t -> string -> string option -> unit
1400 val set_path : t -> string option -> unit
1401 val get_path : t -> string
1402 val set_autosync : t -> bool -> unit
1403 val get_autosync : t -> bool
1404 val set_verbose : t -> bool -> unit
1405 val get_verbose : t -> bool
1408 generate_ocaml_lvm_structure_decls ();
1412 fun (name, style, _, _, shortdesc, _) ->
1413 generate_ocaml_prototype name style;
1414 pr "(** %s *)\n" shortdesc;
1418 (* Generate the OCaml bindings implementation. *)
1419 and generate_ocaml_ml () =
1420 generate_header OCamlStyle LGPLv2;
1424 exception Error of string
1425 external create : unit -> t = \"ocaml_guestfs_create\"
1426 external close : t -> unit = \"ocaml_guestfs_create\"
1427 external launch : t -> unit = \"ocaml_guestfs_launch\"
1428 external wait_ready : t -> unit = \"ocaml_guestfs_wait_ready\"
1429 external kill_subprocess : t -> unit = \"ocaml_guestfs_kill_subprocess\"
1430 external add_drive : t -> string -> unit = \"ocaml_guestfs_add_drive\"
1431 external add_cdrom : t -> string -> unit = \"ocaml_guestfs_add_cdrom\"
1432 external config : t -> string -> string option -> unit = \"ocaml_guestfs_config\"
1433 external set_path : t -> string option -> unit = \"ocaml_guestfs_set_path\"
1434 external get_path : t -> string = \"ocaml_guestfs_get_path\"
1435 external set_autosync : t -> bool -> unit = \"ocaml_guestfs_set_autosync\"
1436 external get_autosync : t -> bool = \"ocaml_guestfs_get_autosync\"
1437 external set_verbose : t -> bool -> unit = \"ocaml_guestfs_set_verbose\"
1438 external get_verbose : t -> bool = \"ocaml_guestfs_get_verbose\"
1441 generate_ocaml_lvm_structure_decls ();
1445 fun (name, style, _, _, shortdesc, _) ->
1446 generate_ocaml_prototype ~is_external:true name style;
1449 (* Generate the OCaml bindings C implementation. *)
1450 and generate_ocaml_c () =
1451 generate_header CStyle LGPLv2;
1453 pr "#include <stdio.h>\n";
1454 pr "#include <stdlib.h>\n";
1456 pr "#include <guestfs.h>\n";
1458 pr "#include <caml/config.h>\n";
1459 pr "#include <caml/alloc.h>\n";
1460 pr "#include <caml/callback.h>\n";
1461 pr "#include <caml/fail.h>\n";
1462 pr "#include <caml/memory.h>\n";
1463 pr "#include <caml/mlvalues.h>\n";
1465 pr "#include \"guestfs_c.h\"\n";
1469 fun (name, style, _, _, _, _) ->
1470 pr "CAMLprim value\n";
1471 pr "ocaml_guestfs_%s (value hv /* XXX */)\n" name;
1473 pr " CAMLparam1 (hv); /* XXX */\n";
1474 pr "/* XXX write something here */\n";
1475 pr " CAMLreturn (Val_unit); /* XXX */\n";
1480 and generate_ocaml_lvm_structure_decls () =
1483 pr "type lvm_%s = {\n" typ;
1486 | name, `String -> pr " %s : string;\n" name
1487 | name, `UUID -> pr " %s : string;\n" name
1488 | name, `Bytes -> pr " %s : int64;\n" name
1489 | name, `Int -> pr " %s : int64;\n" name
1490 | name, `OptPercent -> pr " %s : float option;\n" name
1494 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1496 and generate_ocaml_prototype ?(is_external = false) name style =
1497 if is_external then pr "external " else pr "val ";
1498 pr "%s : t -> " name;
1501 | String _ -> pr "string -> " (* note String is not allowed to be NULL *)
1503 (match fst style with
1504 | Err -> pr "unit" (* all errors are turned into exceptions *)
1505 | RString _ -> pr "string"
1506 | RStringList _ -> pr "string list"
1507 | RPVList _ -> pr "lvm_pv list"
1508 | RVGList _ -> pr "lvm_vg list"
1509 | RLVList _ -> pr "lvm_lv list"
1511 if is_external then pr " = \"ocaml_guestfs_%s\"" name;
1514 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
1515 and generate_perl_xs () =
1516 generate_header CStyle LGPLv2;
1519 #include \"EXTERN.h\"
1523 #include <guestfs.h>
1526 #define PRId64 \"lld\"
1530 my_newSVll(long long val) {
1531 #ifdef USE_64_BIT_ALL
1532 return newSViv(val);
1536 len = snprintf(buf, 100, \"%%\" PRId64, val);
1537 return newSVpv(buf, len);
1542 #define PRIu64 \"llu\"
1546 my_newSVull(unsigned long long val) {
1547 #ifdef USE_64_BIT_ALL
1548 return newSVuv(val);
1552 len = snprintf(buf, 100, \"%%\" PRIu64, val);
1553 return newSVpv(buf, len);
1557 /* XXX Not thread-safe, and in general not safe if the caller is
1558 * issuing multiple requests in parallel (on different guestfs
1559 * handles). We should use the guestfs_h handle passed to the
1560 * error handle to distinguish these cases.
1562 static char *last_error = NULL;
1565 error_handler (guestfs_h *g,
1569 if (last_error != NULL) free (last_error);
1570 last_error = strdup (msg);
1573 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
1578 RETVAL = guestfs_create ();
1580 croak (\"could not create guestfs handle\");
1581 guestfs_set_error_handler (RETVAL, error_handler, NULL);
1592 add_drive (g, filename)
1594 const char *filename;
1596 if (guestfs_add_drive (g, filename) == -1)
1597 croak (\"add_drive: %%s\", last_error);
1600 add_cdrom (g, filename)
1602 const char *filename;
1604 if (guestfs_add_cdrom (g, filename) == -1)
1605 croak (\"add_cdrom: %%s\", last_error);
1608 config (g, param, value)
1613 if (guestfs_config (g, param, value) == -1)
1614 croak (\"config: %%s\", last_error);
1620 if (guestfs_launch (g) == -1)
1621 croak (\"launch: %%s\", last_error);
1627 if (guestfs_wait_ready (g) == -1)
1628 croak (\"wait_ready: %%s\", last_error);
1635 guestfs_set_path (g, path);
1643 path = guestfs_get_path (g);
1644 RETVAL = newSVpv (path, 0);
1649 set_autosync (g, autosync)
1653 guestfs_set_autosync (g, autosync);
1661 autosync = guestfs_get_autosync (g);
1662 RETVAL = newSViv (autosync);
1667 set_verbose (g, verbose)
1671 guestfs_set_verbose (g, verbose);
1679 verbose = guestfs_get_verbose (g);
1680 RETVAL = newSViv (verbose);
1687 fun (name, style, _, _, _, _) ->
1688 (match fst style with
1689 | Err -> pr "void\n"
1690 | RString _ -> pr "SV *\n"
1692 | RPVList _ | RVGList _ | RLVList _ ->
1693 pr "void\n" (* all lists returned implictly on the stack *)
1695 (* Call and arguments. *)
1697 generate_call_args ~handle:"g" style;
1699 pr " guestfs_h *g;\n";
1702 | String n -> pr " char *%s;\n" n
1705 (match fst style with
1708 pr " if (guestfs_%s " name;
1709 generate_call_args ~handle:"g" style;
1711 pr " croak (\"%s: %%s\", last_error);\n" name
1714 pr " char *%s;\n" n;
1716 pr " %s = guestfs_%s " n name;
1717 generate_call_args ~handle:"g" style;
1719 pr " if (%s == NULL)\n" n;
1720 pr " croak (\"%s: %%s\", last_error);\n" name;
1721 pr " RETVAL = newSVpv (%s, 0);\n" n;
1722 pr " free (%s);\n" n;
1727 pr " char **%s;\n" n;
1730 pr " %s = guestfs_%s " n name;
1731 generate_call_args ~handle:"g" style;
1733 pr " if (%s == NULL)\n" n;
1734 pr " croak (\"%s: %%s\", last_error);\n" name;
1735 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
1736 pr " EXTEND (SP, n);\n";
1737 pr " for (i = 0; i < n; ++i) {\n";
1738 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
1739 pr " free (%s[i]);\n" n;
1741 pr " free (%s);\n" n;
1743 generate_perl_lvm_code "pv" pv_cols name style n;
1745 generate_perl_lvm_code "vg" vg_cols name style n;
1747 generate_perl_lvm_code "lv" lv_cols name style n;
1752 and generate_perl_lvm_code typ cols name style n =
1754 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
1758 pr " %s = guestfs_%s " n name;
1759 generate_call_args ~handle:"g" style;
1761 pr " if (%s == NULL)\n" n;
1762 pr " croak (\"%s: %%s\", last_error);\n" name;
1763 pr " EXTEND (SP, %s->len);\n" n;
1764 pr " for (i = 0; i < %s->len; ++i) {\n" n;
1765 pr " hv = newHV ();\n";
1769 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
1770 name (String.length name) n name
1772 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
1773 name (String.length name) n name
1775 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
1776 name (String.length name) n name
1778 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
1779 name (String.length name) n name
1780 | name, `OptPercent ->
1781 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
1782 name (String.length name) n name
1784 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
1786 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
1788 (* Generate Sys/Guestfs.pm. *)
1789 and generate_perl_pm () =
1790 generate_header HashStyle LGPLv2;
1797 Sys::Guestfs - Perl bindings for libguestfs
1803 my $h = Sys::Guestfs->new ();
1804 $h->add_drive ('guest.img');
1807 $h->mount ('/dev/sda1', '/');
1808 $h->touch ('/hello');
1813 The C<Sys::Guestfs> module provides a Perl XS binding to the
1814 libguestfs API for examining and modifying virtual machine
1817 Amongst the things this is good for: making batch configuration
1818 changes to guests, getting disk used/free statistics (see also:
1819 virt-df), migrating between virtualization systems (see also:
1820 virt-p2v), performing partial backups, performing partial guest
1821 clones, cloning guests and changing registry/UUID/hostname info, and
1824 Libguestfs uses Linux kernel and qemu code, and can access any type of
1825 guest filesystem that Linux and qemu can, including but not limited
1826 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
1827 schemes, qcow, qcow2, vmdk.
1829 Libguestfs provides ways to enumerate guest storage (eg. partitions,
1830 LVs, what filesystem is in each LV, etc.). It can also run commands
1831 in the context of the guest. Also you can access filesystems over FTP.
1835 All errors turn into calls to C<croak> (see L<Carp(3)>).
1843 package Sys::Guestfs;
1849 XSLoader::load ('Sys::Guestfs');
1851 =item $h = Sys::Guestfs->new ();
1853 Create a new guestfs handle.
1859 my $class = ref ($proto) || $proto;
1861 my $self = Sys::Guestfs::_create ();
1862 bless $self, $class;
1866 =item $h->add_drive ($filename);
1868 =item $h->add_cdrom ($filename);
1870 This function adds a virtual machine disk image C<filename> to the
1871 guest. The first time you call this function, the disk appears as IDE
1872 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
1875 You don't necessarily need to be root when using libguestfs. However
1876 you obviously do need sufficient permissions to access the filename
1877 for whatever operations you want to perform (ie. read access if you
1878 just want to read the image or write access if you want to modify the
1881 The C<add_cdrom> variation adds a CD-ROM device.
1883 =item $h->config ($param, $value);
1885 =item $h->config ($param);
1887 Use this to add arbitrary parameters to the C<qemu> command line.
1890 =item $h->launch ();
1892 =item $h->wait_ready ();
1894 Internally libguestfs is implemented by running a virtual machine
1895 using L<qemu(1)>. These calls are necessary in order to boot the
1898 You should call these two functions after configuring the handle
1899 (eg. adding drives) but before performing any actions.
1901 =item $h->set_path ($path);
1903 =item $path = $h->get_path ();
1905 See the discussion of C<PATH> in the L<guestfs(3)>
1908 =item $h->set_autosync ($autosync);
1910 =item $autosync = $h->get_autosync ();
1912 See the discussion of I<AUTOSYNC> in the L<guestfs(3)>
1915 =item $h->set_verbose ($verbose);
1917 =item $verbose = $h->get_verbose ();
1919 This sets or gets the verbose messages flag. Verbose
1920 messages are sent to C<stderr>.
1924 (* Actions. We only need to print documentation for these as
1925 * they are pulled in from the XS code automatically.
1928 fun (name, style, _, flags, _, longdesc) ->
1929 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
1931 generate_perl_prototype name style;
1933 pr "%s\n\n" longdesc;
1934 if List.mem ProtocolLimitWarning flags then
1935 pr "Because of the message protocol, there is a transfer limit
1936 of somewhere between 2MB and 4MB. To transfer large files you should use
1950 Copyright (C) 2009 Red Hat Inc.
1954 Please see the file COPYING.LIB for the full license.
1958 L<guestfs(3)>, L<guestfish(1)>.
1963 and generate_perl_prototype name style =
1964 (match fst style with
1966 | RString n -> pr "$%s = " n
1970 | RLVList n -> pr "@%s = " n
1973 let comma = ref false in
1976 if !comma then pr ", ";
1979 | String n -> pr "%s" n
1983 let output_to filename =
1984 let filename_new = filename ^ ".new" in
1985 chan := open_out filename_new;
1989 Unix.rename filename_new filename;
1990 printf "written %s\n%!" filename;
1998 let close = output_to "src/guestfs_protocol.x" in
2002 let close = output_to "src/guestfs-structs.h" in
2003 generate_structs_h ();
2006 let close = output_to "src/guestfs-actions.h" in
2007 generate_actions_h ();
2010 let close = output_to "src/guestfs-actions.c" in
2011 generate_client_actions ();
2014 let close = output_to "daemon/actions.h" in
2015 generate_daemon_actions_h ();
2018 let close = output_to "daemon/stubs.c" in
2019 generate_daemon_actions ();
2022 let close = output_to "fish/cmds.c" in
2023 generate_fish_cmds ();
2026 let close = output_to "guestfs-structs.pod" in
2027 generate_structs_pod ();
2030 let close = output_to "guestfs-actions.pod" in
2031 generate_actions_pod ();
2034 let close = output_to "guestfish-actions.pod" in
2035 generate_fish_actions_pod ();
2038 let close = output_to "ocaml/guestfs.mli" in
2039 generate_ocaml_mli ();
2042 let close = output_to "ocaml/guestfs.ml" in
2043 generate_ocaml_ml ();
2046 let close = output_to "ocaml/guestfs_c_actions.c" in
2047 generate_ocaml_c ();
2050 let close = output_to "perl/Guestfs.xs" in
2051 generate_perl_xs ();
2054 let close = output_to "perl/lib/Sys/Guestfs.pm" in
2055 generate_perl_pm ();