From: Richard W.M. Jones <"Richard W.M. Jones "> Date: Sat, 19 Jan 2008 16:29:10 +0000 (+0000) Subject: Storage API almost completed, even more autogeneration. X-Git-Tag: 1.0.4~57 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=4696e201fac1d3138fa583229ffa93478a1dea1d;p=virt-top.git Storage API almost completed, even more autogeneration. --- diff --git a/libvirt/generator.pl b/libvirt/generator.pl index 96ee065..220fbaf 100755 --- a/libvirt/generator.pl +++ b/libvirt/generator.pl @@ -21,6 +21,8 @@ # This generates libvirt_c.c (the core of the bindings). You don't # need to run this program unless you are extending the bindings # themselves (eg. because libvirt has been extended). +# +# Please read libvirt/README. use strict; @@ -28,6 +30,13 @@ use strict; # The functions in the libvirt API that we can generate. +# The 'sig' (signature) doesn't have a meaning or any internal structure. +# It is interpreted by the generation functions below to indicate what +# "class" the function falls into, and to generate the right class of +# binding. +# +# Any function added since libvirt 0.2.1 must be marked weak. + my @functions = ( { name => "virConnectClose", sig => "conn : free" }, { name => "virConnectGetHostname", sig => "conn : string", weak => 1 }, @@ -52,27 +61,43 @@ my @functions = ( sig => "conn, int : string array", weak => 1 }, { name => "virConnectGetCapabilities", sig => "conn : string" }, + { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, + { name => "virDomainCreateLinuxJob", sig => "conn, string, 0U : job" }, { name => "virDomainFree", sig => "dom : free" }, { name => "virDomainDestroy", sig => "dom : free" }, { name => "virDomainLookupByName", sig => "conn, string : dom" }, + { name => "virDomainLookupByID", sig => "conn, int : dom" }, + { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" }, { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" }, { name => "virDomainGetName", sig => "dom : static string" }, { name => "virDomainGetOSType", sig => "dom : string" }, { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" }, { name => "virDomainGetUUID", sig => "dom : uuid" }, { name => "virDomainGetUUIDString", sig => "dom : uuid string" }, + { name => "virDomainGetMaxVcpus", sig => "dom : int" }, + { name => "virDomainSave", sig => "dom, string : unit" }, + { name => "virDomainSaveJob", sig => "dom, string : job from dom" }, + { name => "virDomainRestore", sig => "conn, string : unit" }, + { name => "virDomainRestoreJob", sig => "conn, string : job" }, + { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" }, + { name => "virDomainCoreDumpJob", sig => "dom, string, 0 : job from dom" }, { name => "virDomainSuspend", sig => "dom : unit" }, { name => "virDomainResume", sig => "dom : unit" }, { name => "virDomainShutdown", sig => "dom : unit" }, { name => "virDomainReboot", sig => "dom, 0 : unit" }, + { name => "virDomainDefineXML", sig => "conn, string : dom" }, { name => "virDomainUndefine", sig => "dom : unit" }, { name => "virDomainCreate", sig => "dom : unit" }, + { name => "virDomainCreateJob", sig => "dom, 0U : job from dom" }, + { name => "virDomainAttachDevice", sig => "dom, string : unit" }, + { name => "virDomainDetachDevice", sig => "dom, string : unit" }, { name => "virDomainGetAutostart", sig => "dom : bool" }, { name => "virDomainSetAutostart", sig => "dom, bool : unit" }, { name => "virNetworkFree", sig => "net : free" }, { name => "virNetworkDestroy", sig => "net : free" }, { name => "virNetworkLookupByName", sig => "conn, string : net" }, + { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" }, { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" }, { name => "virNetworkGetName", sig => "net : static string" }, { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" }, @@ -80,16 +105,20 @@ my @functions = ( { name => "virNetworkGetUUID", sig => "net : uuid" }, { name => "virNetworkGetUUIDString", sig => "net : uuid string" }, { name => "virNetworkUndefine", sig => "net : unit" }, + { name => "virNetworkCreateXML", sig => "conn, string : net" }, + { name => "virNetworkCreateXMLJob", sig => "conn, string : job" }, + { name => "virNetworkDefineXML", sig => "conn, string : net" }, { name => "virNetworkCreate", sig => "net : unit" }, + { name => "virNetworkCreateJob", sig => "net : job from net" }, { name => "virNetworkGetAutostart", sig => "net : bool" }, { name => "virNetworkSetAutostart", sig => "net, bool : unit" }, - { name => "virStoragePoolFree", - sig => "pool : free", weak => 1 }, - { name => "virStoragePoolDestroy", - sig => "pool : free", weak => 1 }, + { name => "virStoragePoolFree", sig => "pool : free", weak => 1 }, + { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 }, { name => "virStoragePoolLookupByName", sig => "conn, string : pool", weak => 1 }, + { name => "virStoragePoolLookupByUUID", + sig => "conn, uuid : pool", weak => 1 }, { name => "virStoragePoolLookupByUUIDString", sig => "conn, string : pool", weak => 1 }, { name => "virStoragePoolGetName", @@ -100,6 +129,10 @@ my @functions = ( sig => "pool : uuid", weak => 1 }, { name => "virStoragePoolGetUUIDString", sig => "pool : uuid string", weak => 1 }, + { name => "virStoragePoolCreateXML", + sig => "conn, string : pool", weak => 1 }, + { name => "virStoragePoolDefineXML", + sig => "conn, string : pool", weak => 1 }, { name => "virStoragePoolUndefine", sig => "pool : unit", weak => 1 }, { name => "virStoragePoolCreate", @@ -113,14 +146,16 @@ my @functions = ( { name => "virStoragePoolSetAutostart", sig => "pool, bool : unit", weak => 1 }, - { name => "virStorageVolFree", sig => "vol : free" }, - { name => "virStorageVolDestroy", sig => "vol : free" }, + { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, + { name => "virStorageVolDestroy", sig => "vol : free", weak => 1 }, # { name => "virStorageVolLookupByName", XXX see libvir-list posting # sig => "pool, string : vol", weak => 1 }, { name => "virStorageVolLookupByKey", sig => "conn, string : vol", weak => 1 }, { name => "virStorageVolLookupByPath", sig => "conn, string : vol", weak => 1 }, +# { name => "virStorageVolCreateXML", +# sig => "pool, string : vol", weak => 1 }, XXX { name => "virStorageVolGetXMLDesc", sig => "vol, 0 : string", weak => 1 }, { name => "virStorageVolGetPath", @@ -129,32 +164,32 @@ my @functions = ( sig => "vol : static string", weak => 1 }, { name => "virStorageVolGetName", sig => "vol : static string", weak => 1 }, + { name => "virStoragePoolLookupByVolume", + sig => "vol : pool from vol", weak => 1 }, + + { name => "virJobFree", + sig => "job : free", weak => 1 }, + { name => "virJobCancel", + sig => "job : unit", weak => 1 }, + { name => "virJobGetNetwork", + sig => "job : net from job", weak => 1 }, + { name => "virJobGetDomain", + sig => "job : dom from job", weak => 1 }, ); -# Functions we haven't implemented anywhere yet. -# We create stubs for these, but they need to either be moved ^^ so they -# are auto-generated or implementations written in libvirt_c_oneoffs.c. +# Functions we haven't implemented anywhere yet but which are mentioned +# in 'libvirt.ml'. +# +# We create stubs for these, but eventually they need to either be +# moved ^^^ so they are auto-generated, or implementations of them +# written in 'libvirt_c_oneoffs.c'. my @unimplemented = ( - "ocaml_libvirt_domain_create_job", - "ocaml_libvirt_domain_core_dump_job", - "ocaml_libvirt_domain_restore_job", - "ocaml_libvirt_domain_save_job", - "ocaml_libvirt_connect_create_linux_job", - "ocaml_libvirt_network_create_job", - "ocaml_libvirt_network_create_xml_job", "ocaml_libvirt_storage_pool_get_info", - "ocaml_libvirt_storage_pool_define_xml", - "ocaml_libvirt_storage_pool_create_xml", - "ocaml_libvirt_storage_pool_lookup_by_uuid", - "ocaml_libvirt_storage_vol_lookup_by_name", # XXX - "ocaml_libvirt_storage_vol_create_xml", + "ocaml_libvirt_storage_vol_lookup_by_name", # XXX see above + "ocaml_libvirt_storage_vol_create_xml", # XXX see above "ocaml_libvirt_storage_vol_get_info", - "ocaml_libvirt_pool_of_volume", - "ocaml_libvirt_job_cancel", - "ocaml_libvirt_job_get_network", - "ocaml_libvirt_job_get_domain", "ocaml_libvirt_job_get_info", ); @@ -242,11 +277,15 @@ sub short_name_to_c_type elsif ($_ eq "net") { "virNetworkPtr" } elsif ($_ eq "pool") { "virStoragePoolPtr" } elsif ($_ eq "vol") { "virStorageVolPtr" } + elsif ($_ eq "job") { "virJobPtr" } else { die "unknown short name $_" } } +# Generate a C signature for the original function. Used when building +# weak bindings. + sub gen_c_signature { my $sig = shift; @@ -291,15 +330,64 @@ sub gen_c_signature } elsif ($sig =~ /^(\w+) : free$/) { my $c_type = short_name_to_c_type ($1); "int $c_name ($c_type $1)" + } elsif ($sig =~ /^(\w+), string : unit$/) { + my $c_type = short_name_to_c_type ($1); + "int $c_name ($c_type $1, const char *str)" + } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + "int $c_name ($c_type $1, const char *str, $unsigned int flags)" } elsif ($sig =~ /^(\w+), string : (\w+)$/) { my $c_type = short_name_to_c_type ($1); my $c_ret_type = short_name_to_c_type ($2); "$c_ret_type $c_name ($c_type $1, const char *str)" + } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" + } elsif ($sig =~ /^(\w+), int : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1, int i)" + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1, const unsigned char *str)" + } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1)" + } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1, const char *str)" + } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" + } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" + } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1)" } else { die "unknown signature $sig" } } +# OCaml argument names. + sub gen_arg_names { my $sig = shift; @@ -330,13 +418,37 @@ sub gen_arg_names ( "$1v" ) } elsif ($sig =~ /^(\w+) : free$/) { ( "$1v" ) + } elsif ($sig =~ /^(\w+), string : unit$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { + ( "$1v", "strv" ) } elsif ($sig =~ /^(\w+), string : (\w+)$/) { ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), int : (\w+)$/) { + ( "$1v", "iv" ) + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + ( "$1v", "uuidv" ) + } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { + ( "$1v" ) } else { die "unknown signature $sig" } } +# Unpack the first (object) argument. + sub gen_unpack_args { local $_ = shift; @@ -355,11 +467,16 @@ sub gen_unpack_args } elsif ($_ eq "vol") { "virStorageVolPtr vol = Volume_val (volv);\n". " virConnectPtr conn = Connect_volv (volv);" + } elsif ($_ eq "job") { + "virJobPtr job = Job_val (jobv);\n". + " virConnectPtr conn = Connect_jobv (jobv);" } else { die "unknown short name $_" } } +# Pack the result if it's an object. + sub gen_pack_result { local $_ = shift; @@ -368,6 +485,7 @@ sub gen_pack_result elsif ($_ eq "net") { "rv = Val_network (r, connv);" } elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" } elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" } + elsif ($_ eq "job") { "rv = Val_job (r, connv);" } else { die "unknown short name $_" } @@ -382,11 +500,14 @@ sub gen_free_arg elsif ($_ eq "net") { "Network_val (netv) = NULL;" } elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" } elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" } + elsif ($_ eq "job") { "Job_val (jobv) = NULL;" } else { die "unknown short name $_" } } +# Generate the C body for each signature (class of function). + sub gen_c_code { my $sig = shift; @@ -557,6 +678,30 @@ sub gen_c_code CAMLreturn (Val_unit); " + } elsif ($sig =~ /^(\w+), string : unit$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" + } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" } elsif ($sig =~ /^(\w+), string : (\w+)$/) { my $c_ret_type = short_name_to_c_type ($2); "\ @@ -572,6 +717,141 @@ sub gen_c_code CAMLreturn (rv); " + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), int : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + int i = Int_val (iv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, i)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + unsigned char *uuid = (unsigned char *) String_val (uuidv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, uuid)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" } else { die "unknown signature $sig" } @@ -666,15 +946,16 @@ END printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented); -print F <<'END'; +if (@unimplemented) { + print F <<'END'; /* The following functions are unimplemented and always fail. * See generator.pl '@unimplemented' */ END -foreach my $c_external_name (@unimplemented) { - print F <`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux" - external create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_connect_create_linux_job" + external create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_domain_create_linux_job" external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id" external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid" external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string" @@ -268,7 +268,7 @@ struct external lookup_by_name : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_name" external lookup_by_key : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_key" external lookup_by_path : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_path" - external pool_of_volume : 'a t -> 'a Pool.t = "ocaml_libvirt_pool_of_volume" + external pool_of_volume : 'a t -> 'a Pool.t = "ocaml_libvirt_storage_pool_lookup_by_volume" external get_name : [`R] t -> string = "ocaml_libvirt_storage_vol_get_name" external get_key : [`R] t -> string = "ocaml_libvirt_storage_vol_get_key" external get_path : [`R] t -> string = "ocaml_libvirt_storage_vol_get_path" @@ -296,6 +296,7 @@ struct external get_domain : ([`Domain], 'a) t -> 'a Domain.t = "ocaml_libvirt_job_get_domain" external get_network : ([`Network], 'a) t -> 'a Network.t = "ocaml_libvirt_job_get_network" external cancel : ('a,'b) t -> unit = "ocaml_libvirt_job_cancel" + external free : ('a, [>`R]) t -> unit = "ocaml_libvirt_job_free" external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" end diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index 642b845..e80cf91 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -801,6 +801,14 @@ v} val cancel : ('a,'b) t -> unit (** Cancel a job. *) + val free : ('a, [>`R]) t -> unit + (** Free a job object in memory. + + The job object is automatically freed if it is garbage + collected. This function just forces it to be freed right + away. + *) + external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" (** [const conn] turns a read/write job into a read-only job. Note that the opposite operation is impossible. diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c index a23efbd..ef674c7 100644 --- a/libvirt/libvirt_c.c +++ b/libvirt/libvirt_c.c @@ -458,6 +458,42 @@ ocaml_libvirt_connect_get_capabilities (value connv) } CAMLprim value +ocaml_libvirt_domain_create_linux (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virDomainPtr r; + + NONBLOCKING (r = virDomainCreateLinux (conn, str, 0)); + CHECK_ERROR (!r, conn, "virDomainCreateLinux"); + + rv = Val_domain (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_create_linux_job (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virJobPtr r; + + NONBLOCKING (r = virDomainCreateLinuxJob (conn, str, 0)); + CHECK_ERROR (!r, conn, "virDomainCreateLinuxJob"); + + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_domain_free (value domv) { CAMLparam1 (domv); @@ -512,6 +548,42 @@ ocaml_libvirt_domain_lookup_by_name (value connv, value strv) } CAMLprim value +ocaml_libvirt_domain_lookup_by_id (value connv, value iv) +{ + CAMLparam2 (connv, iv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + virDomainPtr r; + + NONBLOCKING (r = virDomainLookupByID (conn, i)); + CHECK_ERROR (!r, conn, "virDomainLookupByID"); + + rv = Val_domain (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + unsigned char *uuid = (unsigned char *) String_val (uuidv); + virDomainPtr r; + + NONBLOCKING (r = virDomainLookupByUUID (conn, uuid)); + CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); + + rv = Val_domain (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value strv) { CAMLparam2 (connv, strv); @@ -619,6 +691,129 @@ ocaml_libvirt_domain_get_uuid_string (value domv) } CAMLprim value +ocaml_libvirt_domain_get_max_vcpus (value domv) +{ + CAMLparam1 (domv); + + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + NONBLOCKING (r = virDomainGetMaxVcpus (dom)); + CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_domain_save (value domv, value strv) +{ + CAMLparam2 (domv, strv); + + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *str = String_val (strv); + int r; + + NONBLOCKING (r = virDomainSave (dom, str)); + CHECK_ERROR (r == -1, conn, "virDomainSave"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_save_job (value domv, value strv) +{ + CAMLparam2 (domv, strv); + + CAMLlocal2 (rv, connv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *str = String_val (strv); + virJobPtr r; + + NONBLOCKING (r = virDomainSaveJob (dom, str)); + CHECK_ERROR (!r, conn, "virDomainSaveJob"); + + connv = Field (domv, 1); + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_restore (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + int r; + + NONBLOCKING (r = virDomainRestore (conn, str)); + CHECK_ERROR (r == -1, conn, "virDomainRestore"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_restore_job (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virJobPtr r; + + NONBLOCKING (r = virDomainRestoreJob (conn, str)); + CHECK_ERROR (!r, conn, "virDomainRestoreJob"); + + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_core_dump (value domv, value strv) +{ + CAMLparam2 (domv, strv); + + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *str = String_val (strv); + int r; + + NONBLOCKING (r = virDomainCoreDump (dom, str, 0)); + CHECK_ERROR (!r, conn, "virDomainCoreDump"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_core_dump_job (value domv, value strv) +{ + CAMLparam2 (domv, strv); + + CAMLlocal2 (rv, connv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *str = String_val (strv); + virJobPtr r; + + NONBLOCKING (r = virDomainCoreDumpJob (dom, str, 0)); + CHECK_ERROR (!r, conn, "virDomainCoreDumpJob"); + + connv = Field (domv, 1); + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_domain_suspend (value domv) { CAMLparam1 (domv); @@ -679,6 +874,24 @@ ocaml_libvirt_domain_reboot (value domv) } CAMLprim value +ocaml_libvirt_domain_define_xml (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virDomainPtr r; + + NONBLOCKING (r = virDomainDefineXML (conn, str)); + CHECK_ERROR (!r, conn, "virDomainDefineXML"); + + rv = Val_domain (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_domain_undefine (value domv) { CAMLparam1 (domv); @@ -709,6 +922,59 @@ ocaml_libvirt_domain_create (value domv) } CAMLprim value +ocaml_libvirt_domain_create_job (value domv) +{ + CAMLparam1 (domv); + + CAMLlocal2 (rv, connv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + virJobPtr r; + + NONBLOCKING (r = virDomainCreateJob (dom, 0)); + CHECK_ERROR (!r, conn, "virDomainCreateJob"); + + connv = Field (domv, 1); + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_attach_device (value domv, value strv) +{ + CAMLparam2 (domv, strv); + + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *str = String_val (strv); + int r; + + NONBLOCKING (r = virDomainAttachDevice (dom, str)); + CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_detach_device (value domv, value strv) +{ + CAMLparam2 (domv, strv); + + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *str = String_val (strv); + int r; + + NONBLOCKING (r = virDomainDetachDevice (dom, str)); + CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); + + CAMLreturn (Val_unit); +} + +CAMLprim value ocaml_libvirt_domain_get_autostart (value domv) { CAMLparam1 (domv); @@ -795,6 +1061,24 @@ ocaml_libvirt_network_lookup_by_name (value connv, value strv) } CAMLprim value +ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + unsigned char *uuid = (unsigned char *) String_val (uuidv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkLookupByUUID (conn, uuid)); + CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); + + rv = Val_network (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_network_lookup_by_uuid_string (value connv, value strv) { CAMLparam2 (connv, strv); @@ -917,6 +1201,60 @@ ocaml_libvirt_network_undefine (value netv) } CAMLprim value +ocaml_libvirt_network_create_xml (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkCreateXML (conn, str)); + CHECK_ERROR (!r, conn, "virNetworkCreateXML"); + + rv = Val_network (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_create_xml_job (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virJobPtr r; + + NONBLOCKING (r = virNetworkCreateXMLJob (conn, str)); + CHECK_ERROR (!r, conn, "virNetworkCreateXMLJob"); + + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_define_xml (value connv, value strv) +{ + CAMLparam2 (connv, strv); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkDefineXML (conn, str)); + CHECK_ERROR (!r, conn, "virNetworkDefineXML"); + + rv = Val_network (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_network_create (value netv) { CAMLparam1 (netv); @@ -932,6 +1270,25 @@ ocaml_libvirt_network_create (value netv) } CAMLprim value +ocaml_libvirt_network_create_job (value netv) +{ + CAMLparam1 (netv); + + CAMLlocal2 (rv, connv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + virJobPtr r; + + NONBLOCKING (r = virNetworkCreateJob (net)); + CHECK_ERROR (!r, conn, "virNetworkCreateJob"); + + connv = Field (netv, 1); + rv = Val_job (r, connv); + + CAMLreturn (rv); +} + +CAMLprim value ocaml_libvirt_network_get_autostart (value netv) { CAMLparam1 (netv); @@ -1069,6 +1426,41 @@ ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv) } #ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID +extern virStoragePoolPtr virStoragePoolLookupByUUID (virConnectPtr conn, const unsigned char *str) __attribute__((weak)); +#endif +#endif + +CAMLprim value +ocaml_libvirt_storage_pool_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); +#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID + /* Symbol virStoragePoolLookupByUUID not found at compile time. */ + not_supported ("virStoragePoolLookupByUUID"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolLookupByUUID + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUID); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + unsigned char *uuid = (unsigned char *) String_val (uuidv); + virStoragePoolPtr r; + + NONBLOCKING (r = virStoragePoolLookupByUUID (conn, uuid)); + CHECK_ERROR (!r, conn, "virStoragePoolLookupByUUID"); + + rv = Val_pool (r, connv); + + CAMLreturn (rv); +#endif +} + +#ifdef HAVE_WEAK_SYMBOLS #ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING extern virStoragePoolPtr virStoragePoolLookupByUUIDString (virConnectPtr conn, const char *str) __attribute__((weak)); #endif @@ -1243,6 +1635,76 @@ ocaml_libvirt_storage_pool_get_uuid_string (value poolv) } #ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLCREATEXML +extern virStoragePoolPtr virStoragePoolCreateXML (virConnectPtr conn, const char *str) __attribute__((weak)); +#endif +#endif + +CAMLprim value +ocaml_libvirt_storage_pool_create_xml (value connv, value strv) +{ + CAMLparam2 (connv, strv); +#ifndef HAVE_VIRSTORAGEPOOLCREATEXML + /* Symbol virStoragePoolCreateXML not found at compile time. */ + not_supported ("virStoragePoolCreateXML"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolCreateXML + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolCreateXML); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virStoragePoolPtr r; + + NONBLOCKING (r = virStoragePoolCreateXML (conn, str)); + CHECK_ERROR (!r, conn, "virStoragePoolCreateXML"); + + rv = Val_pool (r, connv); + + CAMLreturn (rv); +#endif +} + +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLDEFINEXML +extern virStoragePoolPtr virStoragePoolDefineXML (virConnectPtr conn, const char *str) __attribute__((weak)); +#endif +#endif + +CAMLprim value +ocaml_libvirt_storage_pool_define_xml (value connv, value strv) +{ + CAMLparam2 (connv, strv); +#ifndef HAVE_VIRSTORAGEPOOLDEFINEXML + /* Symbol virStoragePoolDefineXML not found at compile time. */ + not_supported ("virStoragePoolDefineXML"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolDefineXML + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolDefineXML); + + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *str = String_val (strv); + virStoragePoolPtr r; + + NONBLOCKING (r = virStoragePoolDefineXML (conn, str)); + CHECK_ERROR (!r, conn, "virStoragePoolDefineXML"); + + rv = Val_pool (r, connv); + + CAMLreturn (rv); +#endif +} + +#ifdef HAVE_WEAK_SYMBOLS #ifdef HAVE_VIRSTORAGEPOOLUNDEFINE extern int virStoragePoolUndefine (virStoragePoolPtr pool) __attribute__((weak)); #endif @@ -1436,10 +1898,26 @@ ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv) #endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEVOLFREE +extern int virStorageVolFree (virStorageVolPtr vol) __attribute__((weak)); +#endif +#endif + CAMLprim value ocaml_libvirt_storage_vol_free (value volv) { CAMLparam1 (volv); +#ifndef HAVE_VIRSTORAGEVOLFREE + /* Symbol virStorageVolFree not found at compile time. */ + not_supported ("virStorageVolFree"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStorageVolFree + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStorageVolFree); virStorageVolPtr vol = Volume_val (volv); virConnectPtr conn = Connect_volv (volv); @@ -1452,12 +1930,29 @@ ocaml_libvirt_storage_vol_free (value volv) Volume_val (volv) = NULL; CAMLreturn (Val_unit); +#endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEVOLDESTROY +extern int virStorageVolDestroy (virStorageVolPtr vol) __attribute__((weak)); +#endif +#endif + CAMLprim value ocaml_libvirt_storage_vol_destroy (value volv) { CAMLparam1 (volv); +#ifndef HAVE_VIRSTORAGEVOLDESTROY + /* Symbol virStorageVolDestroy not found at compile time. */ + not_supported ("virStorageVolDestroy"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStorageVolDestroy + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStorageVolDestroy); virStorageVolPtr vol = Volume_val (volv); virConnectPtr conn = Connect_volv (volv); @@ -1470,6 +1965,7 @@ ocaml_libvirt_storage_vol_destroy (value volv) Volume_val (volv) = NULL; CAMLreturn (Val_unit); +#endif } #ifdef HAVE_WEAK_SYMBOLS @@ -1680,74 +2176,189 @@ ocaml_libvirt_storage_vol_get_name (value volv) #endif } -/* The following functions are unimplemented and always fail. - * See generator.pl '@unimplemented' - */ +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME +extern virStoragePoolPtr virStoragePoolLookupByVolume (virStorageVolPtr vol) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_domain_create_job () +ocaml_libvirt_storage_pool_lookup_by_volume (value volv) { - failwith ("ocaml_libvirt_domain_create_job is unimplemented"); -} + CAMLparam1 (volv); +#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME + /* Symbol virStoragePoolLookupByVolume not found at compile time. */ + not_supported ("virStoragePoolLookupByVolume"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolLookupByVolume + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolLookupByVolume); -CAMLprim value -ocaml_libvirt_domain_core_dump_job () -{ - failwith ("ocaml_libvirt_domain_core_dump_job is unimplemented"); -} + CAMLlocal2 (rv, connv); + virStorageVolPtr vol = Volume_val (volv); + virConnectPtr conn = Connect_volv (volv); + virStoragePoolPtr r; -CAMLprim value -ocaml_libvirt_domain_restore_job () -{ - failwith ("ocaml_libvirt_domain_restore_job is unimplemented"); -} + NONBLOCKING (r = virStoragePoolLookupByVolume (vol)); + CHECK_ERROR (!r, conn, "virStoragePoolLookupByVolume"); -CAMLprim value -ocaml_libvirt_domain_save_job () -{ - failwith ("ocaml_libvirt_domain_save_job is unimplemented"); -} + connv = Field (volv, 1); + rv = Val_pool (r, connv); -CAMLprim value -ocaml_libvirt_connect_create_linux_job () -{ - failwith ("ocaml_libvirt_connect_create_linux_job is unimplemented"); + CAMLreturn (rv); +#endif } -CAMLprim value -ocaml_libvirt_network_create_job () -{ - failwith ("ocaml_libvirt_network_create_job is unimplemented"); -} +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRJOBFREE +extern int virJobFree (virJobPtr job) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_network_create_xml_job () +ocaml_libvirt_job_free (value jobv) { - failwith ("ocaml_libvirt_network_create_xml_job is unimplemented"); + CAMLparam1 (jobv); +#ifndef HAVE_VIRJOBFREE + /* Symbol virJobFree not found at compile time. */ + not_supported ("virJobFree"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virJobFree + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virJobFree); + + virJobPtr job = Job_val (jobv); + virConnectPtr conn = Connect_jobv (jobv); + int r; + + NONBLOCKING (r = virJobFree (job)); + CHECK_ERROR (r == -1, conn, "virJobFree"); + + /* So that we don't double-free in the finalizer: */ + Job_val (jobv) = NULL; + + CAMLreturn (Val_unit); +#endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRJOBCANCEL +extern int virJobCancel (virJobPtr job) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_storage_pool_get_info () +ocaml_libvirt_job_cancel (value jobv) { - failwith ("ocaml_libvirt_storage_pool_get_info is unimplemented"); + CAMLparam1 (jobv); +#ifndef HAVE_VIRJOBCANCEL + /* Symbol virJobCancel not found at compile time. */ + not_supported ("virJobCancel"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virJobCancel + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virJobCancel); + + virJobPtr job = Job_val (jobv); + virConnectPtr conn = Connect_jobv (jobv); + int r; + + NONBLOCKING (r = virJobCancel (job)); + CHECK_ERROR (r == -1, conn, "virJobCancel"); + + CAMLreturn (Val_unit); +#endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRJOBGETNETWORK +extern virNetworkPtr virJobGetNetwork (virJobPtr job) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_storage_pool_define_xml () +ocaml_libvirt_job_get_network (value jobv) { - failwith ("ocaml_libvirt_storage_pool_define_xml is unimplemented"); + CAMLparam1 (jobv); +#ifndef HAVE_VIRJOBGETNETWORK + /* Symbol virJobGetNetwork not found at compile time. */ + not_supported ("virJobGetNetwork"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virJobGetNetwork + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virJobGetNetwork); + + CAMLlocal2 (rv, connv); + virJobPtr job = Job_val (jobv); + virConnectPtr conn = Connect_jobv (jobv); + virNetworkPtr r; + + NONBLOCKING (r = virJobGetNetwork (job)); + CHECK_ERROR (!r, conn, "virJobGetNetwork"); + + connv = Field (jobv, 1); + rv = Val_network (r, connv); + + CAMLreturn (rv); +#endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRJOBGETDOMAIN +extern virDomainPtr virJobGetDomain (virJobPtr job) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_storage_pool_create_xml () +ocaml_libvirt_job_get_domain (value jobv) { - failwith ("ocaml_libvirt_storage_pool_create_xml is unimplemented"); + CAMLparam1 (jobv); +#ifndef HAVE_VIRJOBGETDOMAIN + /* Symbol virJobGetDomain not found at compile time. */ + not_supported ("virJobGetDomain"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virJobGetDomain + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virJobGetDomain); + + CAMLlocal2 (rv, connv); + virJobPtr job = Job_val (jobv); + virConnectPtr conn = Connect_jobv (jobv); + virDomainPtr r; + + NONBLOCKING (r = virJobGetDomain (job)); + CHECK_ERROR (!r, conn, "virJobGetDomain"); + + connv = Field (jobv, 1); + rv = Val_domain (r, connv); + + CAMLreturn (rv); +#endif } +/* The following functions are unimplemented and always fail. + * See generator.pl '@unimplemented' + */ + CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_uuid () +ocaml_libvirt_storage_pool_get_info () { - failwith ("ocaml_libvirt_storage_pool_lookup_by_uuid is unimplemented"); + failwith ("ocaml_libvirt_storage_pool_get_info is unimplemented"); } CAMLprim value @@ -1769,30 +2380,6 @@ ocaml_libvirt_storage_vol_get_info () } CAMLprim value -ocaml_libvirt_pool_of_volume () -{ - failwith ("ocaml_libvirt_pool_of_volume is unimplemented"); -} - -CAMLprim value -ocaml_libvirt_job_cancel () -{ - failwith ("ocaml_libvirt_job_cancel is unimplemented"); -} - -CAMLprim value -ocaml_libvirt_job_get_network () -{ - failwith ("ocaml_libvirt_job_get_network is unimplemented"); -} - -CAMLprim value -ocaml_libvirt_job_get_domain () -{ - failwith ("ocaml_libvirt_job_get_domain is unimplemented"); -} - -CAMLprim value ocaml_libvirt_job_get_info () { failwith ("ocaml_libvirt_job_get_info is unimplemented"); diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c index a18749d..a43d8e2 100644 --- a/libvirt/libvirt_c_epilogue.c +++ b/libvirt/libvirt_c_epilogue.c @@ -224,6 +224,9 @@ static void pol_finalize (value); #ifdef HAVE_VIRSTORAGEVOLPTR static void vol_finalize (value); #endif +#ifdef HAVE_VIRJOBPTR +static void jb_finalize (value); +#endif static struct custom_operations conn_custom_operations = { "conn_custom_operations", @@ -275,6 +278,17 @@ static struct custom_operations vol_custom_operations = { }; #endif +#ifdef HAVE_VIRJOBPTR +static struct custom_operations jb_custom_operations = { + "jb_custom_operations", + jb_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; +#endif + static value Val_connect (virConnectPtr conn) { @@ -334,6 +348,19 @@ Val_vol (virStorageVolPtr vol) } #endif +#ifdef HAVE_VIRJOBPTR +static value +Val_jb (virJobPtr jb) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&jb_custom_operations, + sizeof (virJobPtr), 0, 1); + Jb_val (rv) = jb; + CAMLreturn (rv); +} +#endif + /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use * by virterror wrappers. */ @@ -427,6 +454,22 @@ Val_volume (virStorageVolPtr vol, value connv) } #endif +#ifdef HAVE_VIRJOBPTR +/* This wraps up the (jb, conn) pair (Job.t). */ +static value +Val_job (virJobPtr jb, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_jb (jb); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} +#endif + /* No-finalize versions of Val_domain, Val_network ONLY for use by * virterror wrappers. */ @@ -494,3 +537,12 @@ vol_finalize (value volv) if (vol) (void) virStorageVolFree (vol); } #endif + +#ifdef HAVE_VIRJOBPTR +static void +jb_finalize (value jbv) +{ + virJobPtr jb = Jb_val (jbv); + if (jb) (void) virJobFree (jb); +} +#endif diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c index 0d568d6..b1331e0 100644 --- a/libvirt/libvirt_c_oneoffs.c +++ b/libvirt/libvirt_c_oneoffs.c @@ -229,98 +229,6 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv, } CAMLprim value -ocaml_libvirt_domain_create_linux (value connv, value xmlv) -{ - CAMLparam2 (connv, xmlv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virDomainPtr r; - - NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateLinux"); - - rv = Val_domain (r, connv); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_domain_lookup_by_id (value connv, value iv) -{ - CAMLparam2 (connv, iv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByID (conn, i)); - CHECK_ERROR (!r, conn, "virDomainLookupByID"); - - rv = Val_domain (r, connv); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *uuid = String_val (uuidv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); - - rv = Val_domain (r, connv); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_domain_save (value domv, value pathv) -{ - CAMLparam2 (domv, pathv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - int r; - - NONBLOCKING (r = virDomainSave (dom, path)); - CHECK_ERROR (r == -1, conn, "virDomainSave"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_restore (value connv, value pathv) -{ - CAMLparam2 (connv, pathv); - virConnectPtr conn = Connect_val (connv); - char *path = String_val (pathv); - int r; - - NONBLOCKING (r = virDomainRestore (conn, path)); - CHECK_ERROR (r == -1, conn, "virDomainRestore"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_core_dump (value domv, value pathv) -{ - CAMLparam2 (domv, pathv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - int r; - - NONBLOCKING (r = virDomainCoreDump (dom, path, 0)); - CHECK_ERROR (r == -1, conn, "virDomainCoreDump"); - - CAMLreturn (Val_unit); -} - -CAMLprim value ocaml_libvirt_domain_get_id (value domv) { CAMLparam1 (domv); @@ -548,22 +456,6 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) } CAMLprim value -ocaml_libvirt_domain_define_xml (value connv, value xmlv) -{ - CAMLparam2 (connv, xmlv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virDomainPtr r; - - NONBLOCKING (r = virDomainDefineXML (conn, xml)); - CHECK_ERROR (!r, conn, "virDomainDefineXML"); - - rv = Val_domain (r, connv); - CAMLreturn (rv); -} - -CAMLprim value ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv) { CAMLparam2 (domv, nvcpusv); @@ -637,50 +529,6 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) } CAMLprim value -ocaml_libvirt_domain_get_max_vcpus (value domv) -{ - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainGetMaxVcpus (dom)); - CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus"); - - CAMLreturn (Val_int (r)); -} - -CAMLprim value -ocaml_libvirt_domain_attach_device (value domv, value xmlv) -{ - CAMLparam2 (domv, xmlv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *xml = String_val (xmlv); - int r; - - NONBLOCKING (r = virDomainAttachDevice (dom, xml)); - CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_detach_device (value domv, value xmlv) -{ - CAMLparam2 (domv, xmlv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *xml = String_val (xmlv); - int r; - - NONBLOCKING (r = virDomainDetachDevice (dom, xml)); - CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); - - CAMLreturn (Val_unit); -} - -CAMLprim value ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) { #ifdef HAVE_VIRDOMAINMIGRATE @@ -791,54 +639,6 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv) #endif } -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *uuid = String_val (uuidv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); - - rv = Val_network (r, connv); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_network_create_xml (value connv, value xmlv) -{ - CAMLparam2 (connv, xmlv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkCreateXML (conn, xml)); - CHECK_ERROR (!r, conn, "virNetworkCreateXML"); - - rv = Val_network (r, connv); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_network_define_xml (value connv, value xmlv) -{ - CAMLparam2 (connv, xmlv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkDefineXML (conn, xml)); - CHECK_ERROR (!r, conn, "virNetworkDefineXML"); - - rv = Val_network (r, connv); - CAMLreturn (rv); -} - /*----------------------------------------------------------------------*/ CAMLprim value diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c index 1e81d5a..7fe9714 100644 --- a/libvirt/libvirt_c_prologue.c +++ b/libvirt/libvirt_c_prologue.c @@ -112,7 +112,7 @@ static value Val_virterror (virErrorPtr err); * "special" wrapper functions (Val_connect_no_finalize, etc.). * * Update 2008/01: Storage pools and volumes work the same way as - * domains and networks. + * domains and networks. And jobs. */ /* Unwrap a custom block. */ @@ -125,6 +125,9 @@ static value Val_virterror (virErrorPtr err); #ifdef HAVE_VIRSTORAGEVOLPTR #define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv))) #endif +#ifdef HAVE_VIRJOBPTR +#define Jb_val(rv) (*((virJobPtr *)Data_custom_val(rv))) +#endif /* Wrap up a pointer to something in a custom block. */ static value Val_connect (virConnectPtr conn); @@ -136,6 +139,9 @@ static value Val_pol (virStoragePoolPtr pool); #ifdef HAVE_VIRSTORAGEVOLPTR static value Val_vol (virStorageVolPtr vol); #endif +#ifdef HAVE_VIRJOBPTR +static value Val_jb (virJobPtr jb); +#endif /* ONLY for use by virterror wrappers. */ static value Val_connect_no_finalize (virConnectPtr conn); @@ -153,6 +159,9 @@ static value Val_net_no_finalize (virNetworkPtr net); #ifdef HAVE_VIRSTORAGEVOLPTR #define Volume_val(rv) (Vol_val(Field((rv),0))) #endif +#ifdef HAVE_VIRJOBPTR +#define Job_val(rv) (Jb_val(Field((rv),0))) +#endif #define Connect_domv(rv) (Connect_val(Field((rv),1))) #define Connect_netv(rv) (Connect_val(Field((rv),1))) #ifdef HAVE_VIRSTORAGEPOOLPTR @@ -161,6 +170,9 @@ static value Val_net_no_finalize (virNetworkPtr net); #ifdef HAVE_VIRSTORAGEVOLPTR #define Connect_volv(rv) (Connect_val(Field((rv),1))) #endif +#ifdef HAVE_VIRJOBPTR +#define Connect_jobv(rv) (Connect_val(Field((rv),1))) +#endif static value Val_domain (virDomainPtr dom, value connv); static value Val_network (virNetworkPtr net, value connv); @@ -170,6 +182,9 @@ static value Val_pool (virStoragePoolPtr pol, value connv); #ifdef HAVE_VIRSTORAGEVOLPTR static value Val_volume (virStorageVolPtr vol, value connv); #endif +#ifdef HAVE_VIRJOBPTR +static value Val_job (virJobPtr jb, value connv); +#endif /* ONLY for use by virterror wrappers. */ static value Val_domain_no_finalize (virDomainPtr dom, value connv);