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);
1594 fun (name, style, _, _, _, _) ->
1595 (match fst style with
1596 | Err -> pr "void\n"
1597 | RString _ -> pr "SV *\n"
1599 | RPVList _ | RVGList _ | RLVList _ ->
1600 pr "void\n" (* all lists returned implictly on the stack *)
1602 (* Call and arguments. *)
1604 generate_call_args ~handle:"g" style;
1606 pr " guestfs_h *g;\n";
1609 | String n -> pr " char *%s;\n" n
1612 (match fst style with
1615 pr " if (guestfs_%s " name;
1616 generate_call_args ~handle:"g" style;
1618 pr " croak (\"%s: %%s\", last_error);\n" name
1621 pr " char *%s;\n" n;
1623 pr " %s = guestfs_%s " n name;
1624 generate_call_args ~handle:"g" style;
1626 pr " if (%s == NULL)\n" n;
1627 pr " croak (\"%s: %%s\", last_error);\n" name;
1628 pr " RETVAL = newSVpv (%s, 0);\n" n;
1629 pr " free (%s);\n" n;
1634 pr " char **%s;\n" n;
1637 pr " %s = guestfs_%s " n name;
1638 generate_call_args ~handle:"g" style;
1640 pr " if (%s == NULL)\n" n;
1641 pr " croak (\"%s: %%s\", last_error);\n" name;
1642 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
1643 pr " EXTEND (SP, n);\n";
1644 pr " for (i = 0; i < n; ++i) {\n";
1645 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
1646 pr " free (%s[i]);\n" n;
1648 pr " free (%s);\n" n;
1650 generate_perl_lvm_code "pv" pv_cols name style n;
1652 generate_perl_lvm_code "vg" vg_cols name style n;
1654 generate_perl_lvm_code "lv" lv_cols name style n;
1659 and generate_perl_lvm_code typ cols name style n =
1661 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
1665 pr " %s = guestfs_%s " n name;
1666 generate_call_args ~handle:"g" style;
1668 pr " if (%s == NULL)\n" n;
1669 pr " croak (\"%s: %%s\", last_error);\n" name;
1670 pr " EXTEND (SP, %s->len);\n" n;
1671 pr " for (i = 0; i < %s->len; ++i) {\n" n;
1672 pr " hv = newHV ();\n";
1676 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
1677 name (String.length name) n name
1679 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
1680 name (String.length name) n name
1682 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
1683 name (String.length name) n name
1685 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
1686 name (String.length name) n name
1687 | name, `OptPercent ->
1688 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
1689 name (String.length name) n name
1691 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
1693 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
1695 (* Generate Sys/Guestfs.pm. *)
1696 and generate_perl_pm () =
1697 generate_header HashStyle LGPLv2;
1704 Sys::Guestfs - Perl bindings for libguestfs
1710 my $h = Sys::Guestfs->new ();
1711 $h->add_drive ('guest.img');
1714 $h->mount ('/dev/sda1', '/');
1715 $h->touch ('/hello');
1720 The C<Sys::Guestfs> module provides a Perl XS binding to the
1721 libguestfs API for examining and modifying virtual machine
1724 Amongst the things this is good for: making batch configuration
1725 changes to guests, getting disk used/free statistics (see also:
1726 virt-df), migrating between virtualization systems (see also:
1727 virt-p2v), performing partial backups, performing partial guest
1728 clones, cloning guests and changing registry/UUID/hostname info, and
1731 Libguestfs uses Linux kernel and qemu code, and can access any type of
1732 guest filesystem that Linux and qemu can, including but not limited
1733 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
1734 schemes, qcow, qcow2, vmdk.
1736 Libguestfs provides ways to enumerate guest storage (eg. partitions,
1737 LVs, what filesystem is in each LV, etc.). It can also run commands
1738 in the context of the guest. Also you can access filesystems over FTP.
1742 All errors turn into calls to C<croak> (see L<Carp(3)>).
1750 package Sys::Guestfs;
1756 XSLoader::load ('Sys::Guestfs');
1758 =item $h = Sys::Guestfs->new ();
1760 Create a new guestfs handle.
1766 my $class = ref ($proto) || $proto;
1768 my $self = Sys::Guestfs::_create ();
1769 bless $self, $class;
1775 (* Actions. We only need to print documentation for these as
1776 * they are pulled in from the XS code automatically.
1779 fun (name, style, _, flags, _, longdesc) ->
1780 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
1782 generate_perl_prototype name style;
1784 pr "%s\n\n" longdesc;
1785 if List.mem ProtocolLimitWarning flags then
1786 pr "Because of the message protocol, there is a transfer limit
1787 of somewhere between 2MB and 4MB. To transfer large files you should use
1801 Copyright (C) 2009 Red Hat Inc.
1805 Please see the file COPYING.LIB for the full license.
1809 L<guestfs(3)>, L<guestfish(1)>.
1814 and generate_perl_prototype name style =
1815 (match fst style with
1817 | RString n -> pr "$%s = " n
1821 | RLVList n -> pr "@%s = " n
1824 let comma = ref false in
1827 if !comma then pr ", ";
1830 | String n -> pr "%s" n
1834 let output_to filename =
1835 let filename_new = filename ^ ".new" in
1836 chan := open_out filename_new;
1840 Unix.rename filename_new filename;
1841 printf "written %s\n%!" filename;
1849 let close = output_to "src/guestfs_protocol.x" in
1853 let close = output_to "src/guestfs-structs.h" in
1854 generate_structs_h ();
1857 let close = output_to "src/guestfs-actions.h" in
1858 generate_actions_h ();
1861 let close = output_to "src/guestfs-actions.c" in
1862 generate_client_actions ();
1865 let close = output_to "daemon/actions.h" in
1866 generate_daemon_actions_h ();
1869 let close = output_to "daemon/stubs.c" in
1870 generate_daemon_actions ();
1873 let close = output_to "fish/cmds.c" in
1874 generate_fish_cmds ();
1877 let close = output_to "guestfs-structs.pod" in
1878 generate_structs_pod ();
1881 let close = output_to "guestfs-actions.pod" in
1882 generate_actions_pod ();
1885 let close = output_to "guestfish-actions.pod" in
1886 generate_fish_actions_pod ();
1889 let close = output_to "ocaml/guestfs.mli" in
1890 generate_ocaml_mli ();
1893 let close = output_to "ocaml/guestfs.ml" in
1894 generate_ocaml_ml ();
1897 let close = output_to "ocaml/guestfs_c_actions.c" in
1898 generate_ocaml_c ();
1901 let close = output_to "perl/Guestfs.xs" in
1902 generate_perl_xs ();
1905 let close = output_to "perl/lib/Sys/Guestfs.pm" in
1906 generate_perl_pm ();