type flags = ProtocolLimitWarning
+(* Note about long descriptions: When referring to another
+ * action, use the format C<guestfs_other> (ie. the full name of
+ * the C function). This will be replaced as appropriate in other
+ * language bindings.
+ *
+ * Apart from that, long descriptions are just perldoc paragraphs.
+ *)
+
let functions = [
("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
"mount a guest disk at a position in the filesystem",
underlying disk image.
You should always call this if you have modified a disk image, before
-calling C<guestfs_close>.");
+closing the handle.");
("touch", (Err, P1 (String "path")), 3, [],
"update file timestamps or create a new file",
"\
List all the block devices.
-The full block device names are returned, eg. C</dev/sda>
-");
+The full block device names are returned, eg. C</dev/sda>");
("list_partitions", (RStringList "partitions", P0), 8, [],
"list the partitions",
let sorted_functions =
List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) functions
-(* Useful functions. *)
+(* Useful functions.
+ * Note we don't want to use any external OCaml libraries which
+ * makes this a bit harder than it should be.
+ *)
let failwithf fs = ksprintf failwith fs
-let replace s c1 c2 =
+
+let replace_char s c1 c2 =
let s2 = String.copy s in
let r = ref false in
for i = 0 to String.length s2 - 1 do
done;
if not !r then s else s2
+let rec find s sub =
+ let len = String.length s in
+ let sublen = String.length sub in
+ let rec loop i =
+ if i <= len-sublen then (
+ let rec loop2 j =
+ if j < sublen then (
+ if s.[i+j] = sub.[j] then loop2 (j+1)
+ else -1
+ ) else
+ i (* found *)
+ in
+ let r = loop2 0 in
+ if r = -1 then loop (i+1) else r
+ ) else
+ -1 (* not found *)
+ in
+ loop 0
+
+let rec replace_str s s1 s2 =
+ let len = String.length s in
+ let sublen = String.length s1 in
+ let i = find s s1 in
+ if i = -1 then s
+ else (
+ let s' = String.sub s 0 i in
+ let s'' = String.sub s (i+sublen) (len-i-sublen) in
+ s' ^ s2 ^ replace_str s'' s1 s2
+ )
+
(* 'pr' prints to the current output file. *)
let chan = ref stdout
let pr fs = ksprintf (output_string !chan) fs
(* Check function names etc. for consistency. *)
let check_functions () =
List.iter (
- fun (name, _, _, _, _, _) ->
+ fun (name, _, _, _, _, longdesc) ->
if String.contains name '-' then
failwithf "Function name '%s' should not contain '-', use '_' instead."
- name
+ name;
+ if longdesc.[String.length longdesc-1] = '\n' then
+ failwithf "Long description of %s should not end with \\n." name
) functions;
let proc_nrs =
pr " list_builtin_commands ();\n";
List.iter (
fun (name, _, _, _, shortdesc, _) ->
- let name = replace name '_' '-' in
+ let name = replace_char name '_' '-' in
pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
name shortdesc
) sorted_functions;
pr "{\n";
List.iter (
fun (name, style, _, flags, shortdesc, longdesc) ->
- let name2 = replace name '_' '-' in
+ let name2 = replace_char name '_' '-' in
+ let longdesc = replace_str longdesc "C<guestfs_" "C<" in
let synopsis =
match snd style with
| P0 -> name2
pr "{\n";
List.iter (
fun (name, _, _, _, _, _) ->
- let name2 = replace name '_' '-' in
+ let name2 = replace_char name '_' '-' in
pr " if (";
pr "strcasecmp (cmd, \"%s\") == 0" name;
if name <> name2 then
and generate_fish_actions_pod () =
List.iter (
fun (name, style, _, _, _, longdesc) ->
- let name = replace name '_' '-' in
+ let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+ let name = replace_char name '_' '-' in
pr "=head2 %s\n\n" name;
pr " %s" name;
iter_args (
) (snd style);
pr ")"
+(* Generate the OCaml bindings interface. *)
+and generate_ocaml_mli () =
+ generate_header OCamlStyle LGPLv2;
+
+ pr "\
+(** For API documentation you should refer to the C API
+ in the guestfs(3) manual page. The OCaml API uses almost
+ exactly the same calls. *)
+
+type t
+(** A [guestfs_h] handle. *)
+
+exception Error of string
+(** This exception is raised when there is an error. *)
+
+val create : unit -> t
+
+val close : t -> unit
+(** Handles are closed by the garbage collector when they become
+ unreferenced, but callers can also call this in order to
+ provide predictable cleanup. *)
+
+val launch : t -> unit
+val wait_ready : t -> unit
+val kill_subprocess : t -> unit
+
+val add_drive : t -> string -> unit
+val add_cdrom : t -> string -> unit
+val config : t -> string -> string option -> unit
+
+val set_path : t -> string option -> unit
+val get_path : t -> string
+val set_autosync : t -> bool -> unit
+val get_autosync : t -> bool
+val set_verbose : t -> bool -> unit
+val get_verbose : t -> bool
+
+";
+ generate_ocaml_lvm_structure_decls ();
+
+ (* The actions. *)
+ List.iter (
+ fun (name, style, _, _, shortdesc, _) ->
+ generate_ocaml_prototype name style;
+ pr "(** %s *)\n" shortdesc;
+ pr "\n"
+ ) sorted_functions
+
+(* Generate the OCaml bindings implementation. *)
+and generate_ocaml_ml () =
+ generate_header OCamlStyle LGPLv2;
+
+ pr "\
+type t
+exception Error of string
+external create : unit -> t = \"ocaml_guestfs_create\"
+external close : t -> unit = \"ocaml_guestfs_create\"
+external launch : t -> unit = \"ocaml_guestfs_launch\"
+external wait_ready : t -> unit = \"ocaml_guestfs_wait_ready\"
+external kill_subprocess : t -> unit = \"ocaml_guestfs_kill_subprocess\"
+external add_drive : t -> string -> unit = \"ocaml_guestfs_add_drive\"
+external add_cdrom : t -> string -> unit = \"ocaml_guestfs_add_cdrom\"
+external config : t -> string -> string option -> unit = \"ocaml_guestfs_config\"
+external set_path : t -> string option -> unit = \"ocaml_guestfs_set_path\"
+external get_path : t -> string = \"ocaml_guestfs_get_path\"
+external set_autosync : t -> bool -> unit = \"ocaml_guestfs_set_autosync\"
+external get_autosync : t -> bool = \"ocaml_guestfs_get_autosync\"
+external set_verbose : t -> bool -> unit = \"ocaml_guestfs_set_verbose\"
+external get_verbose : t -> bool = \"ocaml_guestfs_get_verbose\"
+
+";
+ generate_ocaml_lvm_structure_decls ();
+
+ (* The actions. *)
+ List.iter (
+ fun (name, style, _, _, shortdesc, _) ->
+ generate_ocaml_prototype ~is_external:true name style;
+ ) sorted_functions
+
+(* Generate the OCaml bindings C implementation. *)
+and generate_ocaml_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "#include <stdio.h>\n";
+ pr "#include <stdlib.h>\n";
+ pr "\n";
+ pr "#include <guestfs.h>\n";
+ pr "\n";
+ pr "#include <caml/config.h>\n";
+ pr "#include <caml/alloc.h>\n";
+ pr "#include <caml/callback.h>\n";
+ pr "#include <caml/fail.h>\n";
+ pr "#include <caml/memory.h>\n";
+ pr "#include <caml/mlvalues.h>\n";
+ pr "\n";
+ pr "#include \"guestfs_c.h\"\n";
+ pr "\n";
+
+ List.iter (
+ fun (name, style, _, _, _, _) ->
+ pr "CAMLprim value\n";
+ pr "ocaml_guestfs_%s (value hv /* XXX */)\n" name;
+ pr "{\n";
+ pr " CAMLparam1 (hv); /* XXX */\n";
+ pr "/* XXX write something here */\n";
+ pr " CAMLreturn (Val_unit); /* XXX */\n";
+ pr "}\n";
+ pr "\n"
+ ) sorted_functions
+
+and generate_ocaml_lvm_structure_decls () =
+ List.iter (
+ fun (typ, cols) ->
+ pr "type lvm_%s = {\n" typ;
+ List.iter (
+ function
+ | name, `String -> pr " %s : string;\n" name
+ | name, `UUID -> pr " %s : string;\n" name
+ | name, `Bytes -> pr " %s : int64;\n" name
+ | name, `Int -> pr " %s : int64;\n" name
+ | name, `OptPercent -> pr " %s : float option;\n" name
+ ) cols;
+ pr "}\n";
+ pr "\n"
+ ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
+
+and generate_ocaml_prototype ?(is_external = false) name style =
+ if is_external then pr "external " else pr "val ";
+ pr "%s : t -> " name;
+ iter_args (
+ function
+ | String _ -> pr "string -> " (* note String is not allowed to be NULL *)
+ ) (snd style);
+ (match fst style with
+ | Err -> pr "unit" (* all errors are turned into exceptions *)
+ | RString _ -> pr "string"
+ | RStringList _ -> pr "string list"
+ | RPVList _ -> pr "lvm_pv list"
+ | RVGList _ -> pr "lvm_vg list"
+ | RLVList _ -> pr "lvm_lv list"
+ );
+ if is_external then pr " = \"ocaml_guestfs_%s\"" name;
+ pr "\n"
+
+(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
+and generate_perl_xs () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include \"EXTERN.h\"
+#include \"perl.h\"
+#include \"XSUB.h\"
+
+#include <guestfs.h>
+
+#ifndef PRId64
+#define PRId64 \"lld\"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSViv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRId64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 \"llu\"
+#endif
+
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSVuv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRIu64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+/* XXX Not thread-safe, and in general not safe if the caller is
+ * issuing multiple requests in parallel (on different guestfs
+ * handles). We should use the guestfs_h handle passed to the
+ * error handle to distinguish these cases.
+ */
+static char *last_error = NULL;
+
+static void
+error_handler (guestfs_h *g,
+ void *data,
+ const char *msg)
+{
+ if (last_error != NULL) free (last_error);
+ last_error = strdup (msg);
+}
+
+MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
+
+guestfs_h *
+_create ()
+ CODE:
+ RETVAL = guestfs_create ();
+ if (!RETVAL)
+ croak (\"could not create guestfs handle\");
+ guestfs_set_error_handler (RETVAL, error_handler, NULL);
+ OUTPUT:
+ RETVAL
+
+void
+DESTROY (g)
+ guestfs_h *g;
+ PPCODE:
+ guestfs_close (g);
+
+void
+add_drive (g, filename)
+ guestfs_h *g;
+ const char *filename;
+ CODE:
+ if (guestfs_add_drive (g, filename) == -1)
+ croak (\"add_drive: %%s\", last_error);
+
+void
+add_cdrom (g, filename)
+ guestfs_h *g;
+ const char *filename;
+ CODE:
+ if (guestfs_add_cdrom (g, filename) == -1)
+ croak (\"add_cdrom: %%s\", last_error);
+
+void
+config (g, param, value)
+ guestfs_h *g;
+ const char *param;
+ const char *value;
+ CODE:
+ if (guestfs_config (g, param, value) == -1)
+ croak (\"config: %%s\", last_error);
+
+void
+launch (g)
+ guestfs_h *g;
+ CODE:
+ if (guestfs_launch (g) == -1)
+ croak (\"launch: %%s\", last_error);
+
+void
+wait_ready (g)
+ guestfs_h *g;
+ CODE:
+ if (guestfs_wait_ready (g) == -1)
+ croak (\"wait_ready: %%s\", last_error);
+
+void
+set_path (g, path)
+ guestfs_h *g;
+ const char *path;
+ CODE:
+ guestfs_set_path (g, path);
+
+SV *
+get_path (g)
+ guestfs_h *g;
+PREINIT:
+ const char *path;
+ CODE:
+ path = guestfs_get_path (g);
+ RETVAL = newSVpv (path, 0);
+ OUTPUT:
+ RETVAL
+
+void
+set_autosync (g, autosync)
+ guestfs_h *g;
+ int autosync;
+ CODE:
+ guestfs_set_autosync (g, autosync);
+
+SV *
+get_autosync (g)
+ guestfs_h *g;
+PREINIT:
+ int autosync;
+ CODE:
+ autosync = guestfs_get_autosync (g);
+ RETVAL = newSViv (autosync);
+ OUTPUT:
+ RETVAL
+
+void
+set_verbose (g, verbose)
+ guestfs_h *g;
+ int verbose;
+ CODE:
+ guestfs_set_verbose (g, verbose);
+
+SV *
+get_verbose (g)
+ guestfs_h *g;
+PREINIT:
+ int verbose;
+ CODE:
+ verbose = guestfs_get_verbose (g);
+ RETVAL = newSViv (verbose);
+ OUTPUT:
+ RETVAL
+
+";
+
+ List.iter (
+ fun (name, style, _, _, _, _) ->
+ (match fst style with
+ | Err -> pr "void\n"
+ | RString _ -> pr "SV *\n"
+ | RStringList _
+ | RPVList _ | RVGList _ | RLVList _ ->
+ pr "void\n" (* all lists returned implictly on the stack *)
+ );
+ (* Call and arguments. *)
+ pr "%s " name;
+ generate_call_args ~handle:"g" style;
+ pr "\n";
+ pr " guestfs_h *g;\n";
+ iter_args (
+ function
+ | String n -> pr " char *%s;\n" n
+ ) (snd style);
+ (* Code. *)
+ (match fst style with
+ | Err ->
+ pr " PPCODE:\n";
+ pr " if (guestfs_%s " name;
+ generate_call_args ~handle:"g" style;
+ pr " == -1)\n";
+ pr " croak (\"%s: %%s\", last_error);\n" name
+ | RString n ->
+ pr "PREINIT:\n";
+ pr " char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RStringList n ->
+ pr "PREINIT:\n";
+ pr " char **%s;\n" n;
+ pr " int i, n;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
+ pr " EXTEND (SP, n);\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
+ pr " free (%s[i]);\n" n;
+ pr " }\n";
+ pr " free (%s);\n" n;
+ | RPVList n ->
+ generate_perl_lvm_code "pv" pv_cols name style n;
+ | RVGList n ->
+ generate_perl_lvm_code "vg" vg_cols name style n;
+ | RLVList n ->
+ generate_perl_lvm_code "lv" lv_cols name style n;
+ );
+ pr "\n"
+ ) functions
+
+and generate_perl_lvm_code typ cols name style n =
+ pr "PREINIT:\n";
+ pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
+ pr " int i;\n";
+ pr " HV *hv;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " EXTEND (SP, %s->len);\n" n;
+ pr " for (i = 0; i < %s->len; ++i) {\n" n;
+ pr " hv = newHV ();\n";
+ List.iter (
+ function
+ | name, `String ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
+ name (String.length name) n name
+ | name, `UUID ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
+ name (String.length name) n name
+ | name, `Bytes ->
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, `Int ->
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, `OptPercent ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ ) cols;
+ pr " PUSHs (sv_2mortal ((SV *) hv));\n";
+ pr " }\n";
+ pr " guestfs_free_lvm_%s_list (%s);\n" typ n
+
+(* Generate Sys/Guestfs.pm. *)
+and generate_perl_pm () =
+ generate_header HashStyle LGPLv2;
+
+ pr "\
+=pod
+
+=head1 NAME
+
+Sys::Guestfs - Perl bindings for libguestfs
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs;
+
+ my $h = Sys::Guestfs->new ();
+ $h->add_drive ('guest.img');
+ $h->launch ();
+ $h->wait_ready ();
+ $h->mount ('/dev/sda1', '/');
+ $h->touch ('/hello');
+ $h->sync ();
+
+=head1 DESCRIPTION
+
+The C<Sys::Guestfs> module provides a Perl XS binding to the
+libguestfs API for examining and modifying virtual machine
+disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.). It can also run commands
+in the context of the guest. Also you can access filesystems over FTP.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Sys::Guestfs;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Sys::Guestfs');
+
+=item $h = Sys::Guestfs->new ();
+
+Create a new guestfs handle.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref ($proto) || $proto;
+
+ my $self = Sys::Guestfs::_create ();
+ bless $self, $class;
+ return $self;
+}
+
+=item $h->add_drive ($filename);
+
+=item $h->add_cdrom ($filename);
+
+This function adds a virtual machine disk image C<filename> to the
+guest. The first time you call this function, the disk appears as IDE
+disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
+so on.
+
+You don't necessarily need to be root when using libguestfs. However
+you obviously do need sufficient permissions to access the filename
+for whatever operations you want to perform (ie. read access if you
+just want to read the image or write access if you want to modify the
+image).
+
+The C<add_cdrom> variation adds a CD-ROM device.
+
+=item $h->config ($param, $value);
+
+=item $h->config ($param);
+
+Use this to add arbitrary parameters to the C<qemu> command line.
+See L<qemu(1)>.
+
+=item $h->launch ();
+
+=item $h->wait_ready ();
+
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>. These calls are necessary in order to boot the
+virtual machine.
+
+You should call these two functions after configuring the handle
+(eg. adding drives) but before performing any actions.
+
+=item $h->set_path ($path);
+
+=item $path = $h->get_path ();
+
+See the discussion of C<PATH> in the L<guestfs(3)>
+manpage.
+
+=item $h->set_autosync ($autosync);
+
+=item $autosync = $h->get_autosync ();
+
+See the discussion of I<AUTOSYNC> in the L<guestfs(3)>
+manpage.
+
+=item $h->set_verbose ($verbose);
+
+=item $verbose = $h->get_verbose ();
+
+This sets or gets the verbose messages flag. Verbose
+messages are sent to C<stderr>.
+
+";
+
+ (* Actions. We only need to print documentation for these as
+ * they are pulled in from the XS code automatically.
+ *)
+ List.iter (
+ fun (name, style, _, flags, _, longdesc) ->
+ let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
+ pr "=item ";
+ generate_perl_prototype name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+ if List.mem ProtocolLimitWarning flags then
+ pr "Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files you should use
+FTP.\n\n";
+ ) sorted_functions;
+
+ (* End of file. *)
+ pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<guestfs(3)>, L<guestfish(1)>.
+
+=cut
+"
+
+and generate_perl_prototype name style =
+ (match fst style with
+ | Err -> ()
+ | RString n -> pr "$%s = " n
+ | RStringList n
+ | RPVList n
+ | RVGList n
+ | RLVList n -> pr "@%s = " n
+ );
+ pr "$h->%s (" name;
+ let comma = ref false in
+ iter_args (
+ fun arg ->
+ if !comma then pr ", ";
+ comma := true;
+ match arg with
+ | String n -> pr "%s" n
+ ) (snd style);
+ pr ");"
+
let output_to filename =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
let close = output_to "guestfish-actions.pod" in
generate_fish_actions_pod ();
- close ()
+ close ();
+
+ let close = output_to "ocaml/guestfs.mli" in
+ generate_ocaml_mli ();
+ close ();
+
+ let close = output_to "ocaml/guestfs.ml" in
+ generate_ocaml_ml ();
+ close ();
+
+ let close = output_to "ocaml/guestfs_c_actions.c" in
+ generate_ocaml_c ();
+ close ();
+
+ let close = output_to "perl/Guestfs.xs" in
+ generate_perl_xs ();
+ close ();
+
+ let close = output_to "perl/lib/Sys/Guestfs.pm" in
+ generate_perl_pm ();
+ close ();
git.annexia.org / libguestfs.git / blobdiff