[libvirt] [ocaml] event registration APis v3
Hi, Here are my latest patches which add OCaml bindings for the libvirt event API. I'm pretty happy with them now: my test programs have been running for long periods of time without incident. Changes from the previous submission (sent 2013-04-17) * added a patch which removes the backwards compatability logic from the bindings. The aim is to make the bindings simpler to read and develop. Changes from the initial submission (sent 2013-03-27) * add support for 'deregister_any' * fix the ordering of '{enter,leave}_blocking_section' and GC registration * add timer callbacks Cheers, Dave
Rather than compile against old versions of libvirt and resort to throwing 'not supported' exceptions at runtime, we instead require all symbols and definitions to be available at compile-time i.e. we require a much more recent libvirt. Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- config.h.in | 161 ------------ configure.ac | 65 ----- libvirt/generator.pl | 222 +++------------- libvirt/libvirt.mli | 17 +- libvirt/libvirt_c.c | 592 ------------------------------------------- libvirt/libvirt_c_epilogue.c | 20 -- libvirt/libvirt_c_oneoffs.c | 187 -------------- libvirt/libvirt_c_prologue.c | 42 --- 8 files changed, 42 insertions(+), 1264 deletions(-) diff --git a/config.h.in b/config.h.in index fccbbe7..c0bd102 100644 --- a/config.h.in +++ b/config.h.in @@ -30,167 +30,6 @@ /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H -/* Define to 1 if you have the `virConnectGetHostname' function. */ -#undef HAVE_VIRCONNECTGETHOSTNAME - -/* Define to 1 if you have the `virConnectGetURI' function. */ -#undef HAVE_VIRCONNECTGETURI - -/* Define to 1 if you have the `virConnectListDefinedStoragePools' function. - */ -#undef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS - -/* Define to 1 if you have the `virConnectListStoragePools' function. */ -#undef HAVE_VIRCONNECTLISTSTORAGEPOOLS - -/* Define to 1 if you have the `virConnectNumOfDefinedStoragePools' function. - */ -#undef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS - -/* Define to 1 if you have the `virConnectNumOfStoragePools' function. */ -#undef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS - -/* Define to 1 if you have the `virDomainBlockPeek' function. */ -#undef HAVE_VIRDOMAINBLOCKPEEK - -/* Define to 1 if you have the `virDomainBlockStats' function. */ -#undef HAVE_VIRDOMAINBLOCKSTATS - -/* Define to 1 if you have the `virDomainGetCPUStats' function. */ -#undef HAVE_VIRDOMAINGETCPUSTATS - -/* Define to 1 if you have the `virDomainGetSchedulerParameters' function. */ -#undef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS - -/* Define to 1 if you have the `virDomainGetSchedulerType' function. */ -#undef HAVE_VIRDOMAINGETSCHEDULERTYPE - -/* Define to 1 if you have the `virDomainInterfaceStats' function. */ -#undef HAVE_VIRDOMAININTERFACESTATS - -/* Define to 1 if you have the `virDomainMemoryPeek' function. */ -#undef HAVE_VIRDOMAINMEMORYPEEK - -/* Define to 1 if you have the `virDomainMigrate' function. */ -#undef HAVE_VIRDOMAINMIGRATE - -/* Define to 1 if you have the `virDomainSetSchedulerParameters' function. */ -#undef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS - -/* Define to 1 if you have the `virNodeGetCellsFreeMemory' function. */ -#undef HAVE_VIRNODEGETCELLSFREEMEMORY - -/* Define to 1 if you have the `virNodeGetFreeMemory' function. */ -#undef HAVE_VIRNODEGETFREEMEMORY - -/* Define to 1 if you have the `virStoragePoolBuild' function. */ -#undef HAVE_VIRSTORAGEPOOLBUILD - -/* Define to 1 if you have the `virStoragePoolCreate' function. */ -#undef HAVE_VIRSTORAGEPOOLCREATE - -/* Define to 1 if you have the `virStoragePoolCreateXML' function. */ -#undef HAVE_VIRSTORAGEPOOLCREATEXML - -/* Define to 1 if you have the `virStoragePoolDefineXML' function. */ -#undef HAVE_VIRSTORAGEPOOLDEFINEXML - -/* Define to 1 if you have the `virStoragePoolDelete' function. */ -#undef HAVE_VIRSTORAGEPOOLDELETE - -/* Define to 1 if you have the `virStoragePoolDestroy' function. */ -#undef HAVE_VIRSTORAGEPOOLDESTROY - -/* Define to 1 if you have the `virStoragePoolFree' function. */ -#undef HAVE_VIRSTORAGEPOOLFREE - -/* Define to 1 if you have the `virStoragePoolGetAutostart' function. */ -#undef HAVE_VIRSTORAGEPOOLGETAUTOSTART - -/* Define to 1 if you have the `virStoragePoolGetConnect' function. */ -#undef HAVE_VIRSTORAGEPOOLGETCONNECT - -/* Define to 1 if you have the `virStoragePoolGetInfo' function. */ -#undef HAVE_VIRSTORAGEPOOLGETINFO - -/* Define to 1 if you have the `virStoragePoolGetName' function. */ -#undef HAVE_VIRSTORAGEPOOLGETNAME - -/* Define to 1 if you have the `virStoragePoolGetUUID' function. */ -#undef HAVE_VIRSTORAGEPOOLGETUUID - -/* Define to 1 if you have the `virStoragePoolGetUUIDString' function. */ -#undef HAVE_VIRSTORAGEPOOLGETUUIDSTRING - -/* Define to 1 if you have the `virStoragePoolGetXMLDesc' function. */ -#undef HAVE_VIRSTORAGEPOOLGETXMLDESC - -/* Define to 1 if you have the `virStoragePoolListVolumes' function. */ -#undef HAVE_VIRSTORAGEPOOLLISTVOLUMES - -/* Define to 1 if you have the `virStoragePoolLookupByName' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME - -/* Define to 1 if you have the `virStoragePoolLookupByUUID' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID - -/* Define to 1 if you have the `virStoragePoolLookupByUUIDString' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING - -/* Define to 1 if you have the `virStoragePoolLookupByVolume' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME - -/* Define to 1 if you have the `virStoragePoolNumOfVolumes' function. */ -#undef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES - -/* Define to 1 if the system has the type `virStoragePoolPtr'. */ -#undef HAVE_VIRSTORAGEPOOLPTR - -/* Define to 1 if you have the `virStoragePoolRefresh' function. */ -#undef HAVE_VIRSTORAGEPOOLREFRESH - -/* Define to 1 if you have the `virStoragePoolSetAutostart' function. */ -#undef HAVE_VIRSTORAGEPOOLSETAUTOSTART - -/* Define to 1 if you have the `virStoragePoolUndefine' function. */ -#undef HAVE_VIRSTORAGEPOOLUNDEFINE - -/* Define to 1 if you have the `virStorageVolCreateXML' function. */ -#undef HAVE_VIRSTORAGEVOLCREATEXML - -/* Define to 1 if you have the `virStorageVolDelete' function. */ -#undef HAVE_VIRSTORAGEVOLDELETE - -/* Define to 1 if you have the `virStorageVolFree' function. */ -#undef HAVE_VIRSTORAGEVOLFREE - -/* Define to 1 if you have the `virStorageVolGetInfo' function. */ -#undef HAVE_VIRSTORAGEVOLGETINFO - -/* Define to 1 if you have the `virStorageVolGetKey' function. */ -#undef HAVE_VIRSTORAGEVOLGETKEY - -/* Define to 1 if you have the `virStorageVolGetName' function. */ -#undef HAVE_VIRSTORAGEVOLGETNAME - -/* Define to 1 if you have the `virStorageVolGetPath' function. */ -#undef HAVE_VIRSTORAGEVOLGETPATH - -/* Define to 1 if you have the `virStorageVolGetXMLDesc' function. */ -#undef HAVE_VIRSTORAGEVOLGETXMLDESC - -/* Define to 1 if you have the `virStorageVolLookupByKey' function. */ -#undef HAVE_VIRSTORAGEVOLLOOKUPBYKEY - -/* Define to 1 if you have the `virStorageVolLookupByName' function. */ -#undef HAVE_VIRSTORAGEVOLLOOKUPBYNAME - -/* Define to 1 if you have the `virStorageVolLookupByPath' function. */ -#undef HAVE_VIRSTORAGEVOLLOOKUPBYPATH - -/* Define to 1 if the system has the type `virStorageVolPtr'. */ -#undef HAVE_VIRSTORAGEVOLPTR - /* Define to 1 if your C compiler doesn't accept -c and -o together. */ #undef NO_MINUS_C_MINUS_O diff --git a/configure.ac b/configure.ac index 63635b6..d40d048 100644 --- a/configure.ac +++ b/configure.ac @@ -67,71 +67,6 @@ AC_CHECK_HEADER([libvirt/virterror.h], [], AC_MSG_ERROR([You must install libvirt development package])) -dnl Check for libvirt >= 0.2.1 (our minimum supported version). -dnl See: http://libvirt.org/hvsupport.html -AC_CHECK_FUNC(virConnectGetCapabilities, - [], - AC_MSG_ERROR([You must have libvirt >= 0.2.1])) - -dnl Check for optional libvirt functions added since 0.2.1. -dnl See: http://libvirt.org/hvsupport.html -AC_CHECK_FUNCS([virConnectGetHostname \ - virConnectGetURI \ - virDomainBlockStats \ - virDomainGetSchedulerParameters \ - virDomainGetSchedulerType \ - virDomainInterfaceStats \ - virDomainMigrate \ - virDomainSetSchedulerParameters \ - virNodeGetFreeMemory \ - virNodeGetCellsFreeMemory \ - virStoragePoolGetConnect \ - virConnectNumOfStoragePools \ - virConnectListStoragePools \ - virConnectNumOfDefinedStoragePools \ - virConnectListDefinedStoragePools \ - virStoragePoolLookupByName \ - virStoragePoolLookupByUUID \ - virStoragePoolLookupByUUIDString \ - virStoragePoolLookupByVolume \ - virStoragePoolCreateXML \ - virStoragePoolDefineXML \ - virStoragePoolBuild \ - virStoragePoolUndefine \ - virStoragePoolCreate \ - virStoragePoolDestroy \ - virStoragePoolDelete \ - virStoragePoolFree \ - virStoragePoolRefresh \ - virStoragePoolGetName \ - virStoragePoolGetUUID \ - virStoragePoolGetUUIDString \ - virStoragePoolGetInfo \ - virStoragePoolGetXMLDesc \ - virStoragePoolGetAutostart \ - virStoragePoolSetAutostart \ - virStoragePoolNumOfVolumes \ - virStoragePoolListVolumes \ - virStorageVolLookupByName \ - virStorageVolLookupByKey \ - virStorageVolLookupByPath \ - virStorageVolGetName \ - virStorageVolGetKey \ - virStorageVolCreateXML \ - virStorageVolDelete \ - virStorageVolFree \ - virStorageVolGetInfo \ - virStorageVolGetXMLDesc \ - virStorageVolGetPath \ - virDomainBlockPeek \ - virDomainMemoryPeek \ - virDomainGetCPUStats \ -]) - -dnl Check for optional types added since 0.2.1. -AC_CHECK_TYPES([virStoragePoolPtr, virStorageVolPtr],,, - [#include <libvirt/libvirt.h>]) - dnl Check for basic OCaml environment & findlib. AC_PROG_OCAML AC_PROG_FINDLIB diff --git a/libvirt/generator.pl b/libvirt/generator.pl index abebfff..ab8900e 100755 --- a/libvirt/generator.pl +++ b/libvirt/generator.pl @@ -35,13 +35,11 @@ use strict; # 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 }, - { name => "virConnectGetURI", sig => "conn : string", weak => 1 }, + { name => "virConnectGetHostname", sig => "conn : string" }, + { name => "virConnectGetURI", sig => "conn : string" }, { name => "virConnectGetType", sig => "conn : static string" }, { name => "virConnectNumOfDomains", sig => "conn : int" }, { name => "virConnectListDomains", sig => "conn, int : int array" }, @@ -53,13 +51,13 @@ my @functions = ( { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" }, { name => "virConnectListDefinedNetworks", sig => "conn, int : string array" }, - { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 }, + { name => "virConnectNumOfStoragePools", sig => "conn : int" }, { name => "virConnectListStoragePools", - sig => "conn, int : string array", weak => 1 }, + sig => "conn, int : string array" }, { name => "virConnectNumOfDefinedStoragePools", - sig => "conn : int", weak => 1 }, + sig => "conn : int" }, { name => "virConnectListDefinedStoragePools", - sig => "conn, int : string array", weak => 1 }, + sig => "conn, int : string array" }, { name => "virConnectGetCapabilities", sig => "conn : string" }, { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, @@ -107,66 +105,66 @@ my @functions = ( { 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" }, + { name => "virStoragePoolDestroy", sig => "pool : free" }, { name => "virStoragePoolLookupByName", - sig => "conn, string : pool", weak => 1 }, + sig => "conn, string : pool" }, { name => "virStoragePoolLookupByUUID", - sig => "conn, uuid : pool", weak => 1 }, + sig => "conn, uuid : pool" }, { name => "virStoragePoolLookupByUUIDString", - sig => "conn, string : pool", weak => 1 }, + sig => "conn, string : pool" }, { name => "virStoragePoolGetName", - sig => "pool : static string", weak => 1 }, + sig => "pool : static string" }, { name => "virStoragePoolGetXMLDesc", - sig => "pool, 0U : string", weak => 1 }, + sig => "pool, 0U : string" }, { name => "virStoragePoolGetUUID", - sig => "pool : uuid", weak => 1 }, + sig => "pool : uuid" }, { name => "virStoragePoolGetUUIDString", - sig => "pool : uuid string", weak => 1 }, + sig => "pool : uuid string" }, { name => "virStoragePoolCreateXML", - sig => "conn, string, 0U : pool", weak => 1 }, + sig => "conn, string, 0U : pool" }, { name => "virStoragePoolDefineXML", - sig => "conn, string, 0U : pool", weak => 1 }, + sig => "conn, string, 0U : pool" }, { name => "virStoragePoolBuild", - sig => "pool, uint : unit", weak => 1 }, + sig => "pool, uint : unit" }, { name => "virStoragePoolUndefine", - sig => "pool : unit", weak => 1 }, + sig => "pool : unit" }, { name => "virStoragePoolCreate", - sig => "pool, 0U : unit", weak => 1 }, + sig => "pool, 0U : unit" }, { name => "virStoragePoolDelete", - sig => "pool, uint : unit", weak => 1 }, + sig => "pool, uint : unit" }, { name => "virStoragePoolRefresh", - sig => "pool, 0U : unit", weak => 1 }, + sig => "pool, 0U : unit" }, { name => "virStoragePoolGetAutostart", - sig => "pool : bool", weak => 1 }, + sig => "pool : bool" }, { name => "virStoragePoolSetAutostart", - sig => "pool, bool : unit", weak => 1 }, + sig => "pool, bool : unit" }, { name => "virStoragePoolNumOfVolumes", - sig => "pool : int", weak => 1 }, + sig => "pool : int" }, { name => "virStoragePoolListVolumes", - sig => "pool, int : string array", weak => 1 }, + sig => "pool, int : string array" }, - { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, + { name => "virStorageVolFree", sig => "vol : free" }, { name => "virStorageVolDelete", - sig => "vol, uint : unit", weak => 1 }, + sig => "vol, uint : unit" }, { name => "virStorageVolLookupByName", - sig => "pool, string : vol from pool", weak => 1 }, + sig => "pool, string : vol from pool" }, { name => "virStorageVolLookupByKey", - sig => "conn, string : vol", weak => 1 }, + sig => "conn, string : vol" }, { name => "virStorageVolLookupByPath", - sig => "conn, string : vol", weak => 1 }, + sig => "conn, string : vol" }, { name => "virStorageVolCreateXML", - sig => "pool, string, 0U : vol from pool", weak => 1 }, + sig => "pool, string, 0U : vol from pool" }, { name => "virStorageVolGetXMLDesc", - sig => "vol, 0U : string", weak => 1 }, + sig => "vol, 0U : string" }, { name => "virStorageVolGetPath", - sig => "vol : string", weak => 1 }, + sig => "vol : string" }, { name => "virStorageVolGetKey", - sig => "vol : static string", weak => 1 }, + sig => "vol : static string" }, { name => "virStorageVolGetName", - sig => "vol : static string", weak => 1 }, + sig => "vol : static string" }, { name => "virStoragePoolLookupByVolume", - sig => "vol : pool from vol", weak => 1 }, + sig => "vol : pool from vol" }, ); @@ -270,115 +268,6 @@ sub short_name_to_c_type } } -# Generate a C signature for the original function. Used when building -# weak bindings. - -sub gen_c_signature -{ - my $sig = shift; - my $c_name = shift; - - if ($sig =~ /^(\w+) : string$/) { - my $c_type = short_name_to_c_type ($1); - "char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : static string$/) { - my $c_type = short_name_to_c_type ($1); - "const char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : int$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : uuid$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, unsigned char *)" - } elsif ($sig =~ /^(\w+) : uuid string$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char *)" - } elsif ($sig =~ /^(\w+) : bool$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int *r)" - } elsif ($sig =~ /^(\w+), bool : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int b)" - } elsif ($sig eq "conn, int : int array") { - "int $c_name (virConnectPtr conn, int *ids, int maxids)" - } elsif ($sig =~ /^(\w+), int : string array$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char **const names, int maxnames)" - } elsif ($sig =~ /^(\w+), 0(U?) : string$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "char *$c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } 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+), (u?)int : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "int $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), (u?)int : (\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 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 @@ -883,7 +772,6 @@ sub gen_c_code foreach my $function (@functions) { my $c_name = $function->{name}; - my $is_weak = $function->{weak}; my $sig = $function->{sig}; #print "generating $c_name with sig \"$sig\" ...\n"; @@ -911,20 +799,6 @@ foreach my $function (@functions) { END - # Generate a full function prototype if the function is weak. - my $have_name = "HAVE_" . uc ($c_name); - if ($is_weak) { - my $c_sig = gen_c_signature ($sig, $c_name); - print F <<END; -#ifdef HAVE_WEAK_SYMBOLS -#ifdef $have_name -extern $c_sig __attribute__((weak)); -#endif -#endif - -END - } - my @arg_names = gen_arg_names ($sig); my $nr_arg_names = scalar @arg_names; my $arg_names = join ", ", @arg_names; @@ -938,31 +812,9 @@ $c_external_name ($arg_names_as_values) CAMLparam$nr_arg_names ($arg_names); END - # If weak, check the function exists at compile time or runtime. - if ($is_weak) { - print F <<END; -#ifndef $have_name - /* Symbol $c_name not found at compile time. */ - not_supported ("$c_name"); - CAMLnoreturn; -#else - /* Check that the symbol $c_name - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK ($c_name); -END - } - # Generate the internals of the function. print F (gen_c_code ($sig, $c_name)); - # Finish off weak #ifdef. - if ($is_weak) { - print F <<END; -#endif -END - } - # Finish off the function. print F <<END; } diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index bf95fa2..0185402 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -142,18 +142,11 @@ printf "uri = %s\n%!" uri {3 Backwards and forwards compatibility} - OCaml-libvirt is backwards and forwards compatible with - any libvirt >= 0.2.1. One consequence of this is that - your program can dynamically link to a {i newer} version of - libvirt than it was compiled with, and it should still - work. - - When we link to an older version of libvirt.so, there may - be missing functions. If ocaml-libvirt was compiled with - gcc, then these are turned into OCaml {!Libvirt.Not_supported} - exceptions. - - We don't support libvirt < 0.2.1, and never will so don't ask us. + OCaml-libvirt requires libvirt version 1.0.2 or later. Future + releases of OCaml-libvirt will use newer features of libvirt + and therefore will require later versions of libvirt. It is always + possible to dynamically link your application against a newer + libvirt than OCaml-libvirt was originally compiled against. {3 Get list of domains and domain infos} diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c index d07a55e..00dbbbc 100644 --- a/libvirt/libvirt_c.c +++ b/libvirt/libvirt_c.c @@ -73,25 +73,10 @@ ocaml_libvirt_connect_close (value connv) * In generator.pl this function has signature "conn : string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTGETHOSTNAME -extern char *virConnectGetHostname (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_get_hostname (value connv) { CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTGETHOSTNAME - /* Symbol virConnectGetHostname not found at compile time. */ - not_supported ("virConnectGetHostname"); - CAMLnoreturn; -#else - /* Check that the symbol virConnectGetHostname - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectGetHostname); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -103,32 +88,16 @@ ocaml_libvirt_connect_get_hostname (value connv) rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virConnectGetURI. * In generator.pl this function has signature "conn : string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTGETURI -extern char *virConnectGetURI (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_get_uri (value connv) { CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTGETURI - /* Symbol virConnectGetURI not found at compile time. */ - not_supported ("virConnectGetURI"); - CAMLnoreturn; -#else - /* Check that the symbol virConnectGetURI - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectGetURI); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -140,7 +109,6 @@ ocaml_libvirt_connect_get_uri (value connv) rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virConnectGetType. @@ -387,25 +355,10 @@ ocaml_libvirt_connect_list_defined_networks (value connv, value iv) * In generator.pl this function has signature "conn : int". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS -extern int virConnectNumOfStoragePools (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_num_of_storage_pools (value connv) { CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS - /* Symbol virConnectNumOfStoragePools not found at compile time. */ - not_supported ("virConnectNumOfStoragePools"); - CAMLnoreturn; -#else - /* Check that the symbol virConnectNumOfStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectNumOfStoragePools); virConnectPtr conn = Connect_val (connv); int r; @@ -414,32 +367,16 @@ ocaml_libvirt_connect_num_of_storage_pools (value connv) CHECK_ERROR (r == -1, conn, "virConnectNumOfStoragePools"); CAMLreturn (Val_int (r)); -#endif } /* Automatically generated binding for virConnectListStoragePools. * In generator.pl this function has signature "conn, int : string array". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTLISTSTORAGEPOOLS -extern int virConnectListStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_list_storage_pools (value connv, value iv) { CAMLparam2 (connv, iv); -#ifndef HAVE_VIRCONNECTLISTSTORAGEPOOLS - /* Symbol virConnectListStoragePools not found at compile time. */ - not_supported ("virConnectListStoragePools"); - CAMLnoreturn; -#else - /* Check that the symbol virConnectListStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectListStoragePools); CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); @@ -468,32 +405,16 @@ ocaml_libvirt_connect_list_storage_pools (value connv, value iv) } CAMLreturn (rv); -#endif } /* Automatically generated binding for virConnectNumOfDefinedStoragePools. * In generator.pl this function has signature "conn : int". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS -extern int virConnectNumOfDefinedStoragePools (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_num_of_defined_storage_pools (value connv) { CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS - /* Symbol virConnectNumOfDefinedStoragePools not found at compile time. */ - not_supported ("virConnectNumOfDefinedStoragePools"); - CAMLnoreturn; -#else - /* Check that the symbol virConnectNumOfDefinedStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectNumOfDefinedStoragePools); virConnectPtr conn = Connect_val (connv); int r; @@ -502,32 +423,16 @@ ocaml_libvirt_connect_num_of_defined_storage_pools (value connv) CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedStoragePools"); CAMLreturn (Val_int (r)); -#endif } /* Automatically generated binding for virConnectListDefinedStoragePools. * In generator.pl this function has signature "conn, int : string array". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS -extern int virConnectListDefinedStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv) { CAMLparam2 (connv, iv); -#ifndef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS - /* Symbol virConnectListDefinedStoragePools not found at compile time. */ - not_supported ("virConnectListDefinedStoragePools"); - CAMLnoreturn; -#else - /* Check that the symbol virConnectListDefinedStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectListDefinedStoragePools); CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); @@ -556,7 +461,6 @@ ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv) } CAMLreturn (rv); -#endif } /* Automatically generated binding for virConnectGetCapabilities. @@ -1487,25 +1391,10 @@ ocaml_libvirt_network_set_autostart (value netv, value bv) * In generator.pl this function has signature "pool : free". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLFREE -extern int virStoragePoolFree (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_free (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLFREE - /* Symbol virStoragePoolFree not found at compile time. */ - not_supported ("virStoragePoolFree"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolFree); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -1518,32 +1407,16 @@ ocaml_libvirt_storage_pool_free (value poolv) Pool_val (poolv) = NULL; CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolDestroy. * In generator.pl this function has signature "pool : free". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDESTROY -extern int virStoragePoolDestroy (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_destroy (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLDESTROY - /* Symbol virStoragePoolDestroy not found at compile time. */ - not_supported ("virStoragePoolDestroy"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolDestroy - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDestroy); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -1556,32 +1429,16 @@ ocaml_libvirt_storage_pool_destroy (value poolv) Pool_val (poolv) = NULL; CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolLookupByName. * In generator.pl this function has signature "conn, string : pool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME -extern virStoragePoolPtr virStoragePoolLookupByName (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv) { CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME - /* Symbol virStoragePoolLookupByName not found at compile time. */ - not_supported ("virStoragePoolLookupByName"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolLookupByName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByName); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -1594,32 +1451,16 @@ ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv) rv = Val_pool (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolLookupByUUID. * In generator.pl this function has signature "conn, uuid : pool". */ -#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"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolLookupByUUID - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUID); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -1632,32 +1473,16 @@ ocaml_libvirt_storage_pool_lookup_by_uuid (value connv, value uuidv) rv = Val_pool (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolLookupByUUIDString. * In generator.pl this function has signature "conn, string : pool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING -extern virStoragePoolPtr virStoragePoolLookupByUUIDString (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_lookup_by_uuid_string (value connv, value strv) { CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING - /* Symbol virStoragePoolLookupByUUIDString not found at compile time. */ - not_supported ("virStoragePoolLookupByUUIDString"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolLookupByUUIDString - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUIDString); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -1670,32 +1495,16 @@ ocaml_libvirt_storage_pool_lookup_by_uuid_string (value connv, value strv) rv = Val_pool (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolGetName. * In generator.pl this function has signature "pool : static string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETNAME -extern const char *virStoragePoolGetName (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_get_name (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETNAME - /* Symbol virStoragePoolGetName not found at compile time. */ - not_supported ("virStoragePoolGetName"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolGetName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetName); CAMLlocal1 (rv); virStoragePoolPtr pool = Pool_val (poolv); @@ -1707,32 +1516,16 @@ ocaml_libvirt_storage_pool_get_name (value poolv) rv = caml_copy_string (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolGetXMLDesc. * In generator.pl this function has signature "pool, 0U : string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETXMLDESC -extern char *virStoragePoolGetXMLDesc (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_get_xml_desc (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETXMLDESC - /* Symbol virStoragePoolGetXMLDesc not found at compile time. */ - not_supported ("virStoragePoolGetXMLDesc"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolGetXMLDesc - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetXMLDesc); CAMLlocal1 (rv); virStoragePoolPtr pool = Pool_val (poolv); @@ -1745,32 +1538,16 @@ ocaml_libvirt_storage_pool_get_xml_desc (value poolv) rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolGetUUID. * In generator.pl this function has signature "pool : uuid". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETUUID -extern int virStoragePoolGetUUID (virStoragePoolPtr pool, unsigned char *) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_get_uuid (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETUUID - /* Symbol virStoragePoolGetUUID not found at compile time. */ - not_supported ("virStoragePoolGetUUID"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolGetUUID - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetUUID); CAMLlocal1 (rv); virStoragePoolPtr pool = Pool_val (poolv); @@ -1785,32 +1562,16 @@ ocaml_libvirt_storage_pool_get_uuid (value poolv) rv = caml_alloc_string (VIR_UUID_BUFLEN); memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolGetUUIDString. * In generator.pl this function has signature "pool : uuid string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETUUIDSTRING -extern int virStoragePoolGetUUIDString (virStoragePoolPtr pool, char *) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_get_uuid_string (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETUUIDSTRING - /* Symbol virStoragePoolGetUUIDString not found at compile time. */ - not_supported ("virStoragePoolGetUUIDString"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolGetUUIDString - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetUUIDString); CAMLlocal1 (rv); virStoragePoolPtr pool = Pool_val (poolv); @@ -1823,32 +1584,16 @@ ocaml_libvirt_storage_pool_get_uuid_string (value poolv) rv = caml_copy_string (uuid); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolCreateXML. * In generator.pl this function has signature "conn, string, 0U : pool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLCREATEXML -extern virStoragePoolPtr virStoragePoolCreateXML (virConnectPtr conn, const char *str, unsigned int flags) __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"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolCreateXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolCreateXML); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -1861,32 +1606,16 @@ ocaml_libvirt_storage_pool_create_xml (value connv, value strv) rv = Val_pool (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolDefineXML. * In generator.pl this function has signature "conn, string, 0U : pool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDEFINEXML -extern virStoragePoolPtr virStoragePoolDefineXML (virConnectPtr conn, const char *str, unsigned int flags) __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"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolDefineXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDefineXML); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -1899,32 +1628,16 @@ ocaml_libvirt_storage_pool_define_xml (value connv, value strv) rv = Val_pool (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolBuild. * In generator.pl this function has signature "pool, uint : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLBUILD -extern int virStoragePoolBuild (virStoragePoolPtr pool, unsigned int i) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_build (value poolv, value iv) { CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLBUILD - /* Symbol virStoragePoolBuild not found at compile time. */ - not_supported ("virStoragePoolBuild"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolBuild - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolBuild); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -1935,32 +1648,16 @@ ocaml_libvirt_storage_pool_build (value poolv, value iv) CHECK_ERROR (r == -1, conn, "virStoragePoolBuild"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolUndefine. * In generator.pl this function has signature "pool : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLUNDEFINE -extern int virStoragePoolUndefine (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_undefine (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLUNDEFINE - /* Symbol virStoragePoolUndefine not found at compile time. */ - not_supported ("virStoragePoolUndefine"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolUndefine - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolUndefine); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -1970,32 +1667,16 @@ ocaml_libvirt_storage_pool_undefine (value poolv) CHECK_ERROR (r == -1, conn, "virStoragePoolUndefine"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolCreate. * In generator.pl this function has signature "pool, 0U : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLCREATE -extern int virStoragePoolCreate (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_create (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLCREATE - /* Symbol virStoragePoolCreate not found at compile time. */ - not_supported ("virStoragePoolCreate"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolCreate - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolCreate); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -2005,32 +1686,16 @@ ocaml_libvirt_storage_pool_create (value poolv) CHECK_ERROR (r == -1, conn, "virStoragePoolCreate"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolDelete. * In generator.pl this function has signature "pool, uint : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDELETE -extern int virStoragePoolDelete (virStoragePoolPtr pool, unsigned int i) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_delete (value poolv, value iv) { CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLDELETE - /* Symbol virStoragePoolDelete not found at compile time. */ - not_supported ("virStoragePoolDelete"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolDelete - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDelete); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -2041,32 +1706,16 @@ ocaml_libvirt_storage_pool_delete (value poolv, value iv) CHECK_ERROR (r == -1, conn, "virStoragePoolDelete"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolRefresh. * In generator.pl this function has signature "pool, 0U : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLREFRESH -extern int virStoragePoolRefresh (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_refresh (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLREFRESH - /* Symbol virStoragePoolRefresh not found at compile time. */ - not_supported ("virStoragePoolRefresh"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolRefresh - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolRefresh); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -2076,32 +1725,16 @@ ocaml_libvirt_storage_pool_refresh (value poolv) CHECK_ERROR (r == -1, conn, "virStoragePoolRefresh"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolGetAutostart. * In generator.pl this function has signature "pool : bool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETAUTOSTART -extern int virStoragePoolGetAutostart (virStoragePoolPtr pool, int *r) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_get_autostart (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETAUTOSTART - /* Symbol virStoragePoolGetAutostart not found at compile time. */ - not_supported ("virStoragePoolGetAutostart"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolGetAutostart - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetAutostart); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -2111,32 +1744,16 @@ ocaml_libvirt_storage_pool_get_autostart (value poolv) CHECK_ERROR (r == -1, conn, "virStoragePoolGetAutostart"); CAMLreturn (b ? Val_true : Val_false); -#endif } /* Automatically generated binding for virStoragePoolSetAutostart. * In generator.pl this function has signature "pool, bool : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLSETAUTOSTART -extern int virStoragePoolSetAutostart (virStoragePoolPtr pool, int b) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv) { CAMLparam2 (poolv, bv); -#ifndef HAVE_VIRSTORAGEPOOLSETAUTOSTART - /* Symbol virStoragePoolSetAutostart not found at compile time. */ - not_supported ("virStoragePoolSetAutostart"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolSetAutostart - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolSetAutostart); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -2148,32 +1765,16 @@ ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv) CHECK_ERROR (r == -1, conn, "virStoragePoolSetAutostart"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStoragePoolNumOfVolumes. * In generator.pl this function has signature "pool : int". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES -extern int virStoragePoolNumOfVolumes (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_num_of_volumes (value poolv) { CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES - /* Symbol virStoragePoolNumOfVolumes not found at compile time. */ - not_supported ("virStoragePoolNumOfVolumes"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolNumOfVolumes - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolNumOfVolumes); virStoragePoolPtr pool = Pool_val (poolv); virConnectPtr conn = Connect_polv (poolv); @@ -2183,32 +1784,16 @@ ocaml_libvirt_storage_pool_num_of_volumes (value poolv) CHECK_ERROR (r == -1, conn, "virStoragePoolNumOfVolumes"); CAMLreturn (Val_int (r)); -#endif } /* Automatically generated binding for virStoragePoolListVolumes. * In generator.pl this function has signature "pool, int : string array". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLISTVOLUMES -extern int virStoragePoolListVolumes (virStoragePoolPtr pool, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_list_volumes (value poolv, value iv) { CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLLISTVOLUMES - /* Symbol virStoragePoolListVolumes not found at compile time. */ - not_supported ("virStoragePoolListVolumes"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolListVolumes - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolListVolumes); CAMLlocal2 (rv, strv); virStoragePoolPtr pool = Pool_val (poolv); @@ -2238,32 +1823,16 @@ ocaml_libvirt_storage_pool_list_volumes (value poolv, value iv) } CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolFree. * In generator.pl this function has signature "vol : free". */ -#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"); - CAMLnoreturn; -#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); @@ -2276,32 +1845,16 @@ ocaml_libvirt_storage_vol_free (value volv) Volume_val (volv) = NULL; CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStorageVolDelete. * In generator.pl this function has signature "vol, uint : unit". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLDELETE -extern int virStorageVolDelete (virStorageVolPtr vol, unsigned int i) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_delete (value volv, value iv) { CAMLparam2 (volv, iv); -#ifndef HAVE_VIRSTORAGEVOLDELETE - /* Symbol virStorageVolDelete not found at compile time. */ - not_supported ("virStorageVolDelete"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolDelete - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolDelete); virStorageVolPtr vol = Volume_val (volv); virConnectPtr conn = Connect_volv (volv); @@ -2312,32 +1865,16 @@ ocaml_libvirt_storage_vol_delete (value volv, value iv) CHECK_ERROR (r == -1, conn, "virStorageVolDelete"); CAMLreturn (Val_unit); -#endif } /* Automatically generated binding for virStorageVolLookupByName. * In generator.pl this function has signature "pool, string : vol from pool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYNAME -extern virStorageVolPtr virStorageVolLookupByName (virStoragePoolPtr pool, const char *str) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_lookup_by_name (value poolv, value strv) { CAMLparam2 (poolv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYNAME - /* Symbol virStorageVolLookupByName not found at compile time. */ - not_supported ("virStorageVolLookupByName"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolLookupByName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByName); CAMLlocal2 (rv, connv); virStoragePoolPtr pool = Pool_val (poolv); @@ -2352,32 +1889,16 @@ ocaml_libvirt_storage_vol_lookup_by_name (value poolv, value strv) rv = Val_volume (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolLookupByKey. * In generator.pl this function has signature "conn, string : vol". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYKEY -extern virStorageVolPtr virStorageVolLookupByKey (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_lookup_by_key (value connv, value strv) { CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYKEY - /* Symbol virStorageVolLookupByKey not found at compile time. */ - not_supported ("virStorageVolLookupByKey"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolLookupByKey - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByKey); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -2390,32 +1911,16 @@ ocaml_libvirt_storage_vol_lookup_by_key (value connv, value strv) rv = Val_volume (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolLookupByPath. * In generator.pl this function has signature "conn, string : vol". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYPATH -extern virStorageVolPtr virStorageVolLookupByPath (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_lookup_by_path (value connv, value strv) { CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYPATH - /* Symbol virStorageVolLookupByPath not found at compile time. */ - not_supported ("virStorageVolLookupByPath"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolLookupByPath - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByPath); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); @@ -2428,32 +1933,16 @@ ocaml_libvirt_storage_vol_lookup_by_path (value connv, value strv) rv = Val_volume (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolCreateXML. * In generator.pl this function has signature "pool, string, 0U : vol from pool". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLCREATEXML -extern virStorageVolPtr virStorageVolCreateXML (virStoragePoolPtr pool, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_create_xml (value poolv, value strv) { CAMLparam2 (poolv, strv); -#ifndef HAVE_VIRSTORAGEVOLCREATEXML - /* Symbol virStorageVolCreateXML not found at compile time. */ - not_supported ("virStorageVolCreateXML"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolCreateXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolCreateXML); CAMLlocal2 (rv, connv); virStoragePoolPtr pool = Pool_val (poolv); @@ -2468,32 +1957,16 @@ ocaml_libvirt_storage_vol_create_xml (value poolv, value strv) rv = Val_volume (r, connv); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolGetXMLDesc. * In generator.pl this function has signature "vol, 0U : string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETXMLDESC -extern char *virStorageVolGetXMLDesc (virStorageVolPtr vol, unsigned int flags) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_get_xml_desc (value volv) { CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETXMLDESC - /* Symbol virStorageVolGetXMLDesc not found at compile time. */ - not_supported ("virStorageVolGetXMLDesc"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolGetXMLDesc - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetXMLDesc); CAMLlocal1 (rv); virStorageVolPtr vol = Volume_val (volv); @@ -2506,32 +1979,16 @@ ocaml_libvirt_storage_vol_get_xml_desc (value volv) rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolGetPath. * In generator.pl this function has signature "vol : string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETPATH -extern char *virStorageVolGetPath (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_get_path (value volv) { CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETPATH - /* Symbol virStorageVolGetPath not found at compile time. */ - not_supported ("virStorageVolGetPath"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolGetPath - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetPath); CAMLlocal1 (rv); virStorageVolPtr vol = Volume_val (volv); @@ -2544,32 +2001,16 @@ ocaml_libvirt_storage_vol_get_path (value volv) rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolGetKey. * In generator.pl this function has signature "vol : static string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETKEY -extern const char *virStorageVolGetKey (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_get_key (value volv) { CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETKEY - /* Symbol virStorageVolGetKey not found at compile time. */ - not_supported ("virStorageVolGetKey"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolGetKey - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetKey); CAMLlocal1 (rv); virStorageVolPtr vol = Volume_val (volv); @@ -2581,32 +2022,16 @@ ocaml_libvirt_storage_vol_get_key (value volv) rv = caml_copy_string (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStorageVolGetName. * In generator.pl this function has signature "vol : static string". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETNAME -extern const char *virStorageVolGetName (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_get_name (value volv) { CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETNAME - /* Symbol virStorageVolGetName not found at compile time. */ - not_supported ("virStorageVolGetName"); - CAMLnoreturn; -#else - /* Check that the symbol virStorageVolGetName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetName); CAMLlocal1 (rv); virStorageVolPtr vol = Volume_val (volv); @@ -2618,32 +2043,16 @@ ocaml_libvirt_storage_vol_get_name (value volv) rv = caml_copy_string (r); CAMLreturn (rv); -#endif } /* Automatically generated binding for virStoragePoolLookupByVolume. * In generator.pl this function has signature "vol : pool from vol". */ -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME -extern virStoragePoolPtr virStoragePoolLookupByVolume (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_lookup_by_volume (value volv) { CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME - /* Symbol virStoragePoolLookupByVolume not found at compile time. */ - not_supported ("virStoragePoolLookupByVolume"); - CAMLnoreturn; -#else - /* Check that the symbol virStoragePoolLookupByVolume - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByVolume); CAMLlocal2 (rv, connv); virStorageVolPtr vol = Volume_val (volv); @@ -2657,7 +2066,6 @@ ocaml_libvirt_storage_pool_lookup_by_volume (value volv) rv = Val_pool (r, connv); CAMLreturn (rv); -#endif } #include "libvirt_c_epilogue.c" diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c index ac69fce..4649724 100644 --- a/libvirt/libvirt_c_epilogue.c +++ b/libvirt/libvirt_c_epilogue.c @@ -193,12 +193,8 @@ Val_virterror (virErrorPtr err) static void conn_finalize (value); static void dom_finalize (value); static void net_finalize (value); -#ifdef HAVE_VIRSTORAGEPOOLPTR static void pol_finalize (value); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR static void vol_finalize (value); -#endif static struct custom_operations conn_custom_operations = { "conn_custom_operations", @@ -228,7 +224,6 @@ static struct custom_operations net_custom_operations = { custom_deserialize_default }; -#ifdef HAVE_VIRSTORAGEPOOLPTR static struct custom_operations pol_custom_operations = { "pol_custom_operations", pol_finalize, @@ -237,9 +232,7 @@ static struct custom_operations pol_custom_operations = { custom_serialize_default, custom_deserialize_default }; -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR static struct custom_operations vol_custom_operations = { "vol_custom_operations", vol_finalize, @@ -248,7 +241,6 @@ static struct custom_operations vol_custom_operations = { custom_serialize_default, custom_deserialize_default }; -#endif static value Val_connect (virConnectPtr conn) @@ -283,7 +275,6 @@ Val_net (virNetworkPtr net) CAMLreturn (rv); } -#ifdef HAVE_VIRSTORAGEPOOLPTR static value Val_pol (virStoragePoolPtr pol) { @@ -294,9 +285,7 @@ Val_pol (virStoragePoolPtr pol) Pol_val (rv) = pol; CAMLreturn (rv); } -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR static value Val_vol (virStorageVolPtr vol) { @@ -307,7 +296,6 @@ Val_vol (virStorageVolPtr vol) Vol_val (rv) = vol; CAMLreturn (rv); } -#endif /* This wraps up the (dom, conn) pair (Domain.t). */ static value @@ -337,7 +325,6 @@ Val_network (virNetworkPtr net, value connv) CAMLreturn (rv); } -#ifdef HAVE_VIRSTORAGEPOOLPTR /* This wraps up the (pol, conn) pair (Pool.t). */ static value Val_pool (virStoragePoolPtr pol, value connv) @@ -351,9 +338,7 @@ Val_pool (virStoragePoolPtr pol, value connv) Store_field (rv, 1, connv); CAMLreturn (rv); } -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR /* This wraps up the (vol, conn) pair (Volume.t). */ static value Val_volume (virStorageVolPtr vol, value connv) @@ -367,7 +352,6 @@ Val_volume (virStorageVolPtr vol, value connv) Store_field (rv, 1, connv); CAMLreturn (rv); } -#endif static void conn_finalize (value connv) @@ -390,20 +374,16 @@ net_finalize (value netv) if (net) (void) virNetworkFree (net); } -#ifdef HAVE_VIRSTORAGEPOOLPTR static void pol_finalize (value polv) { virStoragePoolPtr pol = Pol_val (polv); if (pol) (void) virStoragePoolFree (pol); } -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR static void vol_finalize (value volv) { virStorageVolPtr vol = Vol_val (volv); if (vol) (void) virStorageVolFree (vol); } -#endif diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c index b1d88cc..42301b7 100644 --- a/libvirt/libvirt_c_oneoffs.c +++ b/libvirt/libvirt_c_oneoffs.c @@ -129,47 +129,25 @@ ocaml_libvirt_connect_get_node_info (value connv) CAMLreturn (rv); } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNODEGETFREEMEMORY -extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_node_get_free_memory (value connv) { -#ifdef HAVE_VIRNODEGETFREEMEMORY CAMLparam1 (connv); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); unsigned long long r; - WEAK_SYMBOL_CHECK (virNodeGetFreeMemory); NONBLOCKING (r = virNodeGetFreeMemory (conn)); CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory"); rv = caml_copy_int64 ((int64) r); CAMLreturn (rv); -#else - not_supported ("virNodeGetFreeMemory"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY -extern int virNodeGetCellsFreeMemory (virConnectPtr conn, - unsigned long long *freeMems, - int startCell, int maxCells) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_connect_node_get_cells_free_memory (value connv, value startv, value maxv) { -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY CAMLparam3 (connv, startv, maxv); CAMLlocal2 (rv, iv); virConnectPtr conn = Connect_val (connv); @@ -178,7 +156,6 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv, int r, i; unsigned long long freemems[max]; - WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory); NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max)); CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory"); @@ -189,9 +166,6 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv, } CAMLreturn (rv); -#else - not_supported ("virNodeGetCellsFreeMemory"); -#endif } CAMLprim value @@ -280,18 +254,9 @@ ocaml_libvirt_domain_get_info (value domv) CAMLreturn (rv); } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE -extern char *virDomainGetSchedulerType(virDomainPtr domain, - int *nparams) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_get_scheduler_type (value domv) { -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE CAMLparam1 (domv); CAMLlocal2 (rv, strv); virDomainPtr dom = Domain_val (domv); @@ -299,7 +264,6 @@ ocaml_libvirt_domain_get_scheduler_type (value domv) char *r; int nparams; - WEAK_SYMBOL_CHECK (virDomainGetSchedulerType); NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams)); CHECK_ERROR (!r, conn, "virDomainGetSchedulerType"); @@ -308,24 +272,11 @@ ocaml_libvirt_domain_get_scheduler_type (value domv) free (r); Store_field (rv, 1, nparams); CAMLreturn (rv); -#else - not_supported ("virDomainGetSchedulerType"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS -extern int virDomainGetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int *nparams) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv) { -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS CAMLparam2 (domv, nparamsv); CAMLlocal4 (rv, v, v2, v3); virDomainPtr dom = Domain_val (domv); @@ -334,7 +285,6 @@ ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv) virSchedParameter params[nparams]; int r, i; - WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters); NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams)); CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters"); @@ -373,24 +323,11 @@ ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv) Store_field (v, 1, v2); } CAMLreturn (rv); -#else - not_supported ("virDomainGetSchedulerParameters"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS -extern int virDomainSetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int nparams) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) { -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS CAMLparam2 (domv, paramsv); CAMLlocal1 (v); virDomainPtr dom = Domain_val (domv); @@ -436,14 +373,10 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) } } - WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters); NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams)); CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters"); CAMLreturn (Val_unit); -#else - not_supported ("virDomainSetSchedulerParameters"); -#endif } CAMLprim value @@ -519,22 +452,9 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) CAMLreturn (rv); } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETCPUSTATS -extern int virDomainGetCPUStats (virDomainPtr domain, - virTypedParameterPtr params, - unsigned int nparams, - int start_cpu, - unsigned int ncpus, - unsigned int flags) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_get_cpu_stats (value domv) { -#ifdef HAVE_VIRDOMAINGETCPUSTATS CAMLparam1 (domv); CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value); CAMLlocal1 (v); @@ -633,24 +553,11 @@ ocaml_libvirt_domain_get_cpu_stats (value domv) } free(params); CAMLreturn (cpustats); -#else - not_supported ("virDomainGetCPUStats"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINMIGRATE -extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn, - unsigned long flags, const char *dname, - const char *uri, unsigned long bandwidth) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) { -#ifdef HAVE_VIRDOMAINMIGRATE CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv); CAMLxparam2 (optbandwidthv, unitv); CAMLlocal2 (flagv, rv); @@ -676,17 +583,12 @@ ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, val else /* Some bandwidth */ bandwidth = Int_val (Field (optbandwidthv, 0)); - WEAK_SYMBOL_CHECK (virDomainMigrate); NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth)); CHECK_ERROR (!r, conn, "virDomainMigrate"); rv = Val_domain (r, dconnv); CAMLreturn (rv); - -#else /* virDomainMigrate not supported */ - not_supported ("virDomainMigrate"); -#endif } CAMLprim value @@ -697,20 +599,9 @@ ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn) argv[6]); } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINBLOCKSTATS -extern int virDomainBlockStats (virDomainPtr dom, - const char *path, - virDomainBlockStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_block_stats (value domv, value pathv) { -#if HAVE_VIRDOMAINBLOCKSTATS CAMLparam2 (domv, pathv); CAMLlocal2 (rv,v); virDomainPtr dom = Domain_val (domv); @@ -719,7 +610,6 @@ ocaml_libvirt_domain_block_stats (value domv, value pathv) struct _virDomainBlockStats stats; int r; - WEAK_SYMBOL_CHECK (virDomainBlockStats); NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats)); CHECK_ERROR (r == -1, conn, "virDomainBlockStats"); @@ -731,25 +621,11 @@ ocaml_libvirt_domain_block_stats (value domv, value pathv) v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v); CAMLreturn (rv); -#else - not_supported ("virDomainBlockStats"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAININTERFACESTATS -extern int virDomainInterfaceStats (virDomainPtr dom, - const char *path, - virDomainInterfaceStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_interface_stats (value domv, value pathv) { -#if HAVE_VIRDOMAININTERFACESTATS CAMLparam2 (domv, pathv); CAMLlocal2 (rv,v); virDomainPtr dom = Domain_val (domv); @@ -758,7 +634,6 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv) struct _virDomainInterfaceStats stats; int r; - WEAK_SYMBOL_CHECK (virDomainInterfaceStats); NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats)); CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats"); @@ -773,27 +648,11 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv) v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v); CAMLreturn (rv); -#else - not_supported ("virDomainInterfaceStats"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINBLOCKPEEK -extern int virDomainBlockPeek (virDomainPtr domain, - const char *path, - unsigned long long offset, - size_t size, - void *buffer, - unsigned int flags) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv) { -#ifdef HAVE_VIRDOMAINBLOCKPEEK CAMLparam5 (domv, pathv, offsetv, sizev, bufferv); CAMLxparam1 (boffv); virDomainPtr dom = Domain_val (domv); @@ -809,16 +668,11 @@ ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, if (caml_string_length (bufferv) < boff + size) caml_failwith ("virDomainBlockPeek: return buffer too short"); - WEAK_SYMBOL_CHECK (virDomainBlockPeek); /* NB. not NONBLOCKING because buffer might move (XXX) */ r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0); CHECK_ERROR (r == -1, conn, "virDomainBlockPeek"); CAMLreturn (Val_unit); - -#else /* virDomainBlockPeek not supported */ - not_supported ("virDomainBlockPeek"); -#endif } CAMLprim value @@ -828,21 +682,9 @@ ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn) argv[3], argv[4], argv[5]); } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINMEMORYPEEK -extern int virDomainMemoryPeek (virDomainPtr domain, - unsigned long long start, - size_t size, - void *buffer, - unsigned int flags) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv) { -#ifdef HAVE_VIRDOMAINMEMORYPEEK CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv); CAMLxparam1 (boffv); CAMLlocal1 (flagv); @@ -867,16 +709,11 @@ ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv flags |= VIR_MEMORY_VIRTUAL; } - WEAK_SYMBOL_CHECK (virDomainMemoryPeek); /* NB. not NONBLOCKING because buffer might move (XXX) */ r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags); CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek"); CAMLreturn (Val_unit); - -#else /* virDomainMemoryPeek not supported */ - not_supported ("virDomainMemoryPeek"); -#endif } CAMLprim value @@ -886,17 +723,9 @@ ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn) argv[3], argv[4], argv[5]); } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETINFO -extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_pool_get_info (value poolv) { -#if HAVE_VIRSTORAGEPOOLGETINFO CAMLparam1 (poolv); CAMLlocal2 (rv, v); virStoragePoolPtr pool = Pool_val (poolv); @@ -904,7 +733,6 @@ ocaml_libvirt_storage_pool_get_info (value poolv) virStoragePoolInfo info; int r; - WEAK_SYMBOL_CHECK (virStoragePoolGetInfo); NONBLOCKING (r = virStoragePoolGetInfo (pool, &info)); CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo"); @@ -915,22 +743,11 @@ ocaml_libvirt_storage_pool_get_info (value poolv) v = caml_copy_int64 (info.available); Store_field (rv, 3, v); CAMLreturn (rv); -#else - not_supported ("virStoragePoolGetInfo"); -#endif } -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETINFO -extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info) - __attribute__((weak)); -#endif -#endif - CAMLprim value ocaml_libvirt_storage_vol_get_info (value volv) { -#if HAVE_VIRSTORAGEVOLGETINFO CAMLparam1 (volv); CAMLlocal2 (rv, v); virStorageVolPtr vol = Volume_val (volv); @@ -938,7 +755,6 @@ ocaml_libvirt_storage_vol_get_info (value volv) virStorageVolInfo info; int r; - WEAK_SYMBOL_CHECK (virStorageVolGetInfo); NONBLOCKING (r = virStorageVolGetInfo (vol, &info)); CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo"); @@ -948,9 +764,6 @@ ocaml_libvirt_storage_vol_get_info (value volv) v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v); CAMLreturn (rv); -#else - not_supported ("virStorageVolGetInfo"); -#endif } /*----------------------------------------------------------------------*/ diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c index 2050078..7d9c0f5 100644 --- a/libvirt/libvirt_c_prologue.c +++ b/libvirt/libvirt_c_prologue.c @@ -46,28 +46,6 @@ static value Val_virterror (virErrorPtr err); #define CHECK_ERROR(cond, conn, fn) \ do { if (cond) _raise_virterror (conn, fn); } while (0) -/* For more about weak symbols, see: - * http://kolpackov.net/pipermail/notes/2004-March/000006.html - * We are using this to do runtime detection of library functions - * so that if we dynamically link with an older version of - * libvirt than we were compiled against, it won't fail (provided - * libvirt >= 0.2.1 - we don't support anything older). - */ -#ifdef __GNUC__ -#ifdef linux -#if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3) -#define HAVE_WEAK_SYMBOLS 1 -#endif -#endif -#endif - -#ifdef HAVE_WEAK_SYMBOLS -#define WEAK_SYMBOL_CHECK(sym) \ - do { if (!sym) not_supported(#sym); } while (0) -#else -#define WEAK_SYMBOL_CHECK(sym) -#endif /* HAVE_WEAK_SYMBOLS */ - /*----------------------------------------------------------------------*/ /* Some notes about the use of custom blocks to store virConnectPtr, @@ -113,49 +91,29 @@ static value Val_virterror (virErrorPtr err); #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv))) #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv))) #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv))) -#ifdef HAVE_VIRSTORAGEPOOLPTR #define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR #define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv))) -#endif /* Wrap up a pointer to something in a custom block. */ static value Val_connect (virConnectPtr conn); static value Val_dom (virDomainPtr dom); static value Val_net (virNetworkPtr net); -#ifdef HAVE_VIRSTORAGEPOOLPTR static value Val_pol (virStoragePoolPtr pool); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR static value Val_vol (virStorageVolPtr vol); -#endif /* Domains and networks are stored as pairs (dom/net, conn), so have * some convenience functions for unwrapping and wrapping them. */ #define Domain_val(rv) (Dom_val(Field((rv),0))) #define Network_val(rv) (Net_val(Field((rv),0))) -#ifdef HAVE_VIRSTORAGEPOOLPTR #define Pool_val(rv) (Pol_val(Field((rv),0))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR #define Volume_val(rv) (Vol_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 #define Connect_polv(rv) (Connect_val(Field((rv),1))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR #define Connect_volv(rv) (Connect_val(Field((rv),1))) -#endif static value Val_domain (virDomainPtr dom, value connv); static value Val_network (virNetworkPtr net, value connv); -#ifdef HAVE_VIRSTORAGEPOOLPTR static value Val_pool (virStoragePoolPtr pol, value connv); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR static value Val_volume (virStorageVolPtr vol, value connv); -#endif -- 1.8.1.2
This one is a 'one-off' but it ought to be possible to use the generator to create the function (it has signature 'conn, int, int : int') This function first appeared in libvirt version 0.9.8. Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- libvirt/libvirt.ml | 2 ++ libvirt/libvirt.mli | 8 ++++++++ libvirt/libvirt_c_oneoffs.c | 17 +++++++++++++++++ 3 files changed, 27 insertions(+) diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml index 1fbb8ca..784a2b5 100644 --- a/libvirt/libvirt.ml +++ b/libvirt/libvirt.ml @@ -100,6 +100,8 @@ struct let cpu_usable cpumaps maplen vcpu cpu = Char.code cpumaps.[vcpu*maplen + cpu/8] land (1 lsl (cpu mod 8)) <> 0 + external set_keep_alive : [>`R] t -> int -> int -> unit = "ocaml_libvirt_connect_set_keep_alive" + external const : [>`R] t -> ro t = "%identity" end diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index 0185402..fa5a0fe 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -384,6 +384,14 @@ sig (** [cpu_usable cpumaps maplen vcpu cpu] checks returns true iff the [cpu] is usable by [vcpu]. *) + val set_keep_alive : [>`R] t -> int -> int -> unit + (** [set_keep_alive conn interval count] starts sending keepalive + messages after [interval] seconds of inactivity and consider the + connection to be broken when no response is received after [count] + keepalive messages. + Note: the client has to implement and run an event loop to + be able to use keep-alive messages. *) + external const : [>`R] t -> ro t = "%identity" (** [const conn] turns a read/write connection into a read-only connection. Note that the opposite operation is impossible. diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c index 42301b7..c51aad7 100644 --- a/libvirt/libvirt_c_oneoffs.c +++ b/libvirt/libvirt_c_oneoffs.c @@ -169,6 +169,23 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv, } CAMLprim value +ocaml_libvirt_connect_set_keep_alive(value connv, + value intervalv, value countv) +{ + CAMLparam3 (connv, intervalv, countv); + virConnectPtr conn = Connect_val(connv); + int interval = Int_val(intervalv); + unsigned int count = Int_val(countv); + int r; + + NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count)); + CHECK_ERROR (r == -1, conn, "virConnectSetKeepAlive"); + + CAMLreturn(Val_unit); +} + + +CAMLprim value ocaml_libvirt_domain_get_id (value domv) { CAMLparam1 (domv); -- 1.8.1.2
A client may register a callback as follows: E.register_default_impl (); let conn = C.connect_readonly ?name () in let id = E.register_any conn (E.Lifecycle (fun dom e -> printd dom "Lifecycle %s" (E.Lifecycle.to_string e) )) in Internally this will: 1. generate a unique int64 used to identify the specific callback 2. add the callback to an OCaml hashtable based on the signature (there is a distinct hashtable per callback signature) 3. call virConnectDomainEventRegisterAny which registers a generic C callback in the stubs (one distinct callback per signature) and supply the int64 as the "opaque" data The client must enter the event loop with: while true do E.run_default_impl () done When an event is triggered, the C callback will upcall into an OCaml function (having re-acquired the heap lock) supplying the int64 value. The OCaml function can then find the right callback in the Hashtbl and call it. The client can deregister the callback with: E.deregister_any conn id; Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- libvirt/generator.pl | 2 + libvirt/libvirt.ml | 765 ++++++++++++++++++++++++++++++++++++++++++++ libvirt/libvirt.mli | 355 ++++++++++++++++++++ libvirt/libvirt_c.c | 19 ++ libvirt/libvirt_c_oneoffs.c | 411 ++++++++++++++++++++++++ 5 files changed, 1552 insertions(+) diff --git a/libvirt/generator.pl b/libvirt/generator.pl index ab8900e..8229ad1 100755 --- a/libvirt/generator.pl +++ b/libvirt/generator.pl @@ -59,6 +59,8 @@ my @functions = ( { name => "virConnectListDefinedStoragePools", sig => "conn, int : string array" }, { name => "virConnectGetCapabilities", sig => "conn : string" }, + { name => "virConnectDomainEventDeregisterAny", + sig => "conn, int : unit" }, { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, { name => "virDomainFree", sig => "dom : free" }, diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml index 784a2b5..9c9368a 100644 --- a/libvirt/libvirt.ml +++ b/libvirt/libvirt.ml @@ -483,6 +483,771 @@ struct map_ignore_errors (fun dom -> (dom, get_info dom)) doms end +module Event = +struct + + module Defined = struct + type t = [ + | `Added + | `Updated + | `Unknown of int + ] + + let to_string = function + | `Added -> "Added" + | `Updated -> "Updated" + | `Unknown x -> Printf.sprintf "Unknown Defined.detail: %d" x + + let make = function + | 0 -> `Added + | 1 -> `Updated + | x -> `Unknown x (* newer libvirt *) + end + + module Undefined = struct + type t = [ + | `Removed + | `Unknown of int + ] + + let to_string = function + | `Removed -> "UndefinedRemoved" + | `Unknown x -> Printf.sprintf "Unknown Undefined.detail: %d" x + + let make = function + | 0 -> `Removed + | x -> `Unknown x (* newer libvirt *) + end + + module Started = struct + type t = [ + | `Booted + | `Migrated + | `Restored + | `FromSnapshot + | `Wakeup + | `Unknown of int + ] + + let to_string = function + | `Booted -> "Booted" + | `Migrated -> "Migrated" + | `Restored -> "Restored" + | `FromSnapshot -> "FromSnapshot" + | `Wakeup -> "Wakeup" + | `Unknown x -> Printf.sprintf "Unknown Started.detail: %d" x + + let make = function + | 0 -> `Booted + | 1 -> `Migrated + | 2 -> `Restored + | 3 -> `FromSnapshot + | 4 -> `Wakeup + | x -> `Unknown x (* newer libvirt *) + end + + module Suspended = struct + type t = [ + | `Paused + | `Migrated + | `IOError + | `Watchdog + | `Restored + | `FromSnapshot + | `APIError + | `Unknown of int (* newer libvirt *) + ] + + let to_string = function + | `Paused -> "Paused" + | `Migrated -> "Migrated" + | `IOError -> "IOError" + | `Watchdog -> "Watchdog" + | `Restored -> "Restored" + | `FromSnapshot -> "FromSnapshot" + | `APIError -> "APIError" + | `Unknown x -> Printf.sprintf "Unknown Suspended.detail: %d" x + + let make = function + | 0 -> `Paused + | 1 -> `Migrated + | 2 -> `IOError + | 3 -> `Watchdog + | 4 -> `Restored + | 5 -> `FromSnapshot + | 6 -> `APIError + | x -> `Unknown x (* newer libvirt *) + end + + module Resumed = struct + type t = [ + | `Unpaused + | `Migrated + | `FromSnapshot + | `Unknown of int (* newer libvirt *) + ] + + let to_string = function + | `Unpaused -> "Unpaused" + | `Migrated -> "Migrated" + | `FromSnapshot -> "FromSnapshot" + | `Unknown x -> Printf.sprintf "Unknown Resumed.detail: %d" x + + let make = function + | 0 -> `Unpaused + | 1 -> `Migrated + | 2 -> `FromSnapshot + | x -> `Unknown x (* newer libvirt *) + end + + module Stopped = struct + type t = [ + | `Shutdown + | `Destroyed + | `Crashed + | `Migrated + | `Saved + | `Failed + | `FromSnapshot + | `Unknown of int + ] + let to_string = function + | `Shutdown -> "Shutdown" + | `Destroyed -> "Destroyed" + | `Crashed -> "Crashed" + | `Migrated -> "Migrated" + | `Saved -> "Saved" + | `Failed -> "Failed" + | `FromSnapshot -> "FromSnapshot" + | `Unknown x -> Printf.sprintf "Unknown Stopped.detail: %d" x + + let make = function + | 0 -> `Shutdown + | 1 -> `Destroyed + | 2 -> `Crashed + | 3 -> `Migrated + | 4 -> `Saved + | 5 -> `Failed + | 6 -> `FromSnapshot + | x -> `Unknown x (* newer libvirt *) + end + + module PM_suspended = struct + type t = [ + | `Memory + | `Disk + | `Unknown of int (* newer libvirt *) + ] + + let to_string = function + | `Memory -> "Memory" + | `Disk -> "Disk" + | `Unknown x -> Printf.sprintf "Unknown PM_suspended.detail: %d" x + + let make = function + | 0 -> `Memory + | 1 -> `Disk + | x -> `Unknown x (* newer libvirt *) + end + + let string_option x = match x with + | None -> "None" + | Some x' -> "Some " ^ x' + + module Lifecycle = struct + type t = [ + | `Defined of Defined.t + | `Undefined of Undefined.t + | `Started of Started.t + | `Suspended of Suspended.t + | `Resumed of Resumed.t + | `Stopped of Stopped.t + | `Shutdown (* no detail defined yet *) + | `PMSuspended of PM_suspended.t + | `Unknown of int (* newer libvirt *) + ] + + let to_string = function + | `Defined x -> "Defined " ^ (Defined.to_string x) + | `Undefined x -> "Undefined " ^ (Undefined.to_string x) + | `Started x -> "Started " ^ (Started.to_string x) + | `Suspended x -> "Suspended " ^ (Suspended.to_string x) + | `Resumed x -> "Resumed " ^ (Resumed.to_string x) + | `Stopped x -> "Stopped " ^ (Stopped.to_string x) + | `Shutdown -> "Shutdown" + | `PMSuspended x -> "PMSuspended " ^ (PM_suspended.to_string x) + | `Unknown x -> Printf.sprintf "Unknown Lifecycle event: %d" x + + let make (ty, detail) = match ty with + | 0 -> `Defined (Defined.make detail) + | 1 -> `Undefined (Undefined.make detail) + | 2 -> `Started (Started.make detail) + | 3 -> `Suspended (Suspended.make detail) + | 4 -> `Resumed (Resumed.make detail) + | 5 -> `Stopped (Stopped.make detail) + | 6 -> `Shutdown + | 7 -> `PMSuspended (PM_suspended.make detail) + | x -> `Unknown x + end + + module Reboot = struct + type t = unit + + let to_string _ = "()" + + let make () = () + end + + module Rtc_change = struct + type t = int64 + + let to_string = Int64.to_string + + let make x = x + end + + module Watchdog = struct + type t = [ + | `None + | `Pause + | `Reset + | `Poweroff + | `Shutdown + | `Debug + | `Unknown of int + ] + + let to_string = function + | `None -> "None" + | `Pause -> "Pause" + | `Reset -> "Reset" + | `Poweroff -> "Poweroff" + | `Shutdown -> "Shutdown" + | `Debug -> "Debug" + | `Unknown x -> Printf.sprintf "Unknown watchdog_action: %d" x + + let make = function + | 0 -> `None + | 1 -> `Pause + | 2 -> `Reset + | 3 -> `Poweroff + | 4 -> `Shutdown + | 5 -> `Debug + | x -> `Unknown x (* newer libvirt *) + end + + module Io_error = struct + type action = [ + | `None + | `Pause + | `Report + | `Unknown of int (* newer libvirt *) + ] + + let string_of_action = function + | `None -> "None" + | `Pause -> "Pause" + | `Report -> "Report" + | `Unknown x -> Printf.sprintf "Unknown Io_error.action: %d" x + + let action_of_int = function + | 0 -> `None + | 1 -> `Pause + | 2 -> `Report + | x -> `Unknown x + + type t = { + src_path: string option; + dev_alias: string option; + action: action; + reason: string option; + } + + let to_string t = Printf.sprintf + "{ Io_error.src_path = %s; dev_alias = %s; action = %s; reason = %s }" + (string_option t.src_path) + (string_option t.dev_alias) + (string_of_action t.action) + (string_option t.reason) + + let make (src_path, dev_alias, action, reason) = { + src_path = src_path; + dev_alias = dev_alias; + action = action_of_int action; + reason = reason; + } + + let make_noreason (src_path, dev_alias, action) = + make (src_path, dev_alias, action, None) + end + + module Graphics_address = struct + type family = [ + | `Ipv4 + | `Ipv6 + | `Unix + | `Unknown of int (* newer libvirt *) + ] + + let string_of_family = function + | `Ipv4 -> "IPv4" + | `Ipv6 -> "IPv6" + | `Unix -> "UNIX" + | `Unknown x -> Printf.sprintf "Unknown Graphics_address.family: %d" x + + let family_of_int = function + (* no zero *) + | 1 -> `Ipv4 + | 2 -> `Ipv6 + | 3 -> `Unix + | x -> `Unknown x + + type t = { + family: family; (** Address family *) + node: string option; (** Address of node (eg IP address, or UNIX path *) + service: string option; (** Service name/number (eg TCP port, or NULL) *) + } + + let to_string t = Printf.sprintf + "{ family = %s; node = %s; service = %s }" + (string_of_family t.family) + (string_option t.node) + (string_option t.service) + + let make (family, node, service) = { + family = family_of_int family; + node = node; + service = service; + } + end + + module Graphics_subject = struct + type identity = { + ty: string option; + name: string option; + } + + let string_of_identity t = Printf.sprintf + "{ ty = %s; name = %s }" + (string_option t.ty) + (string_option t.name) + + type t = identity list + + let to_string ts = + "[ " ^ (String.concat "; " (List.map string_of_identity ts)) ^ " ]" + + let make xs = + List.map (fun (ty, name) -> { ty = ty; name = name }) + (Array.to_list xs) + end + + module Graphics = struct + type phase = [ + | `Connect + | `Initialize + | `Disconnect + | `Unknown of int (** newer libvirt *) + ] + + let string_of_phase = function + | `Connect -> "Connect" + | `Initialize -> "Initialize" + | `Disconnect -> "Disconnect" + | `Unknown x -> Printf.sprintf "Unknown Graphics.phase: %d" x + + let phase_of_int = function + | 0 -> `Connect + | 1 -> `Initialize + | 2 -> `Disconnect + | x -> `Unknown x + + type t = { + phase: phase; (** the phase of the connection *) + local: Graphics_address.t; (** the local server address *) + remote: Graphics_address.t; (** the remote client address *) + auth_scheme: string option; (** the authentication scheme activated *) + subject: Graphics_subject.t; (** the authenticated subject (user) *) + } + + let to_string t = + let phase = Printf.sprintf "phase = %s" + (string_of_phase t.phase) in + let local = Printf.sprintf "local = %s" + (Graphics_address.to_string t.local) in + let remote = Printf.sprintf "remote = %s" + (Graphics_address.to_string t.remote) in + let auth_scheme = Printf.sprintf "auth_scheme = %s" + (string_option t.auth_scheme) in + let subject = Printf.sprintf "subject = %s" + (Graphics_subject.to_string t.subject) in + "{ " ^ (String.concat "; " [ phase; local; remote; auth_scheme; subject ]) ^ " }" + + let make (phase, local, remote, auth_scheme, subject) = { + phase = phase_of_int phase; + local = Graphics_address.make local; + remote = Graphics_address.make remote; + auth_scheme = auth_scheme; + subject = Graphics_subject.make subject; + } + end + + module Control_error = struct + type t = unit + + let to_string () = "()" + + let make () = () + end + + module Block_job = struct + type ty = [ + | `KnownUnknown (* explicitly named UNKNOWN in the spec *) + | `Pull + | `Copy + | `Commit + | `Unknown of int (* newer libvirt *) + ] + + let string_of_ty = function + | `KnownUnknown -> "KnownUnknown" + | `Pull -> "Pull" + | `Copy -> "Copy" + | `Commit -> "Commit" + | `Unknown x -> Printf.sprintf "Unknown Block_job.ty: %d" x + + let ty_of_int = function + | 0 -> `KnownUnknown + | 1 -> `Pull + | 2 -> `Copy + | 3 -> `Commit + | x -> `Unknown x (* newer libvirt *) + + type status = [ + | `Completed + | `Failed + | `Cancelled + | `Ready + | `Unknown of int + ] + + let string_of_status = function + | `Completed -> "Completed" + | `Failed -> "Failed" + | `Cancelled -> "Cancelled" + | `Ready -> "Ready" + | `Unknown x -> Printf.sprintf "Unknown Block_job.status: %d" x + + let status_of_int = function + | 0 -> `Completed + | 1 -> `Failed + | 2 -> `Cancelled + | 3 -> `Ready + | x -> `Unknown x + + type t = { + disk: string option; + ty: ty; + status: status; + } + + let to_string t = Printf.sprintf "{ disk = %s; ty = %s; status = %s }" + (string_option t.disk) + (string_of_ty t.ty) + (string_of_status t.status) + + let make (disk, ty, status) = { + disk = disk; + ty = ty_of_int ty; + status = status_of_int ty; + } + end + + module Disk_change = struct + type reason = [ + | `MissingOnStart + | `Unknown of int + ] + + let string_of_reason = function + | `MissingOnStart -> "MissingOnStart" + | `Unknown x -> Printf.sprintf "Unknown Disk_change.reason: %d" x + + let reason_of_int = function + | 0 -> `MissingOnStart + | x -> `Unknown x + + type t = { + old_src_path: string option; + new_src_path: string option; + dev_alias: string option; + reason: reason; + } + + let to_string t = + let o = Printf.sprintf "old_src_path = %s" (string_option t.old_src_path) in + let n = Printf.sprintf "new_src_path = %s" (string_option t.new_src_path) in + let d = Printf.sprintf "dev_alias = %s" (string_option t.dev_alias) in + let r = string_of_reason t.reason in + "{ " ^ (String.concat "; " [ o; n; d; r ]) ^ " }" + + let make (o, n, d, r) = { + old_src_path = o; + new_src_path = n; + dev_alias = d; + reason = reason_of_int r; + } + end + + module Tray_change = struct + type reason = [ + | `Open + | `Close + | `Unknown of int + ] + + let string_of_reason = function + | `Open -> "Open" + | `Close -> "Close" + | `Unknown x -> Printf.sprintf "Unknown Tray_change.reason: %d" x + + let reason_of_int = function + | 0 -> `Open + | 1 -> `Close + | x -> `Unknown x + + type t = { + dev_alias: string option; + reason: reason; + } + + let to_string t = Printf.sprintf + "{ dev_alias = %s; reason = %s }" + (string_option t.dev_alias) + (string_of_reason t.reason) + + let make (dev_alias, reason) = { + dev_alias = dev_alias; + reason = reason_of_int reason; + } + end + + module PM_wakeup = struct + type reason = [ + | `Unknown of int + ] + + type t = reason + + let to_string = function + | `Unknown x -> Printf.sprintf "Unknown PM_wakeup.reason: %d" x + + let make x = `Unknown x + end + + module PM_suspend = struct + type reason = [ + | `Unknown of int + ] + + type t = reason + + let to_string = function + | `Unknown x -> Printf.sprintf "Unknown PM_suspend.reason: %d" x + + let make x = `Unknown x + end + + module Balloon_change = struct + type t = int64 + + let to_string = Int64.to_string + let make x = x + end + + module PM_suspend_disk = struct + type reason = [ + | `Unknown of int + ] + + type t = reason + + let to_string = function + | `Unknown x -> Printf.sprintf "Unknown PM_suspend_disk.reason: %d" x + + let make x = `Unknown x + end + + type callback = + | Lifecycle of ([`R] Domain.t -> Lifecycle.t -> unit) + | Reboot of ([`R] Domain.t -> Reboot.t -> unit) + | RtcChange of ([`R] Domain.t -> Rtc_change.t -> unit) + | Watchdog of ([`R] Domain.t -> Watchdog.t -> unit) + | IOError of ([`R] Domain.t -> Io_error.t -> unit) + | Graphics of ([`R] Domain.t -> Graphics.t -> unit) + | IOErrorReason of ([`R] Domain.t -> Io_error.t -> unit) + | ControlError of ([`R] Domain.t -> Control_error.t -> unit) + | BlockJob of ([`R] Domain.t -> Block_job.t -> unit) + | DiskChange of ([`R] Domain.t -> Disk_change.t -> unit) + | TrayChange of ([`R] Domain.t -> Tray_change.t -> unit) + | PMWakeUp of ([`R] Domain.t -> PM_wakeup.t -> unit) + | PMSuspend of ([`R] Domain.t -> PM_suspend.t -> unit) + | BalloonChange of ([`R] Domain.t -> Balloon_change.t -> unit) + | PMSuspendDisk of ([`R] Domain.t -> PM_suspend_disk.t -> unit) + + type callback_id = int64 + + let fresh_callback_id = + let next = ref 0L in + fun () -> + let result = !next in + next := Int64.succ !next; + result + + let make_table value_name = + let table = Hashtbl.create 16 in + let callback callback_id generic x = + if Hashtbl.mem table callback_id + then Hashtbl.find table callback_id generic x in + let _ = Callback.register value_name callback in + table + + let u_table = make_table "Libvirt.u_callback" + let i_table = make_table "Libvirt.i_callback" + let i64_table = make_table "Libvirt.i64_callback" + let i_i_table = make_table "Libvirt.i_i_callback" + let s_i_table = make_table "Libvirt.s_i_callback" + let s_i_i_table = make_table "Libvirt.s_i_i_callback" + let s_s_i_table = make_table "Libvirt.s_s_i_callback" + let s_s_i_s_table = make_table "Libvirt.s_s_i_s_callback" + let s_s_s_i_table = make_table "Libvirt.s_s_s_i_callback" + let i_ga_ga_s_gs_table = make_table "Libvirt.i_ga_ga_s_gs_callback" + + external register_default_impl : unit -> unit = "ocaml_libvirt_event_register_default_impl" + + external run_default_impl : unit -> unit = "ocaml_libvirt_event_run_default_impl" + + external register_any' : 'a Connect.t -> 'a Domain.t option -> callback -> callback_id -> int = "ocaml_libvirt_connect_domain_event_register_any" + + external deregister_any' : 'a Connect.t -> int -> unit = "ocaml_libvirt_connect_domain_event_deregister_any" + + let our_id_to_libvirt_id = Hashtbl.create 16 + + let register_any conn ?dom callback = + let id = fresh_callback_id () in + begin match callback with + | Lifecycle f -> + Hashtbl.add i_i_table id (fun dom x -> + f dom (Lifecycle.make x) + ) + | Reboot f -> + Hashtbl.add u_table id (fun dom x -> + f dom (Reboot.make x) + ) + | RtcChange f -> + Hashtbl.add i64_table id (fun dom x -> + f dom (Rtc_change.make x) + ) + | Watchdog f -> + Hashtbl.add i_table id (fun dom x -> + f dom (Watchdog.make x) + ) + | IOError f -> + Hashtbl.add s_s_i_table id (fun dom x -> + f dom (Io_error.make_noreason x) + ) + | Graphics f -> + Hashtbl.add i_ga_ga_s_gs_table id (fun dom x -> + f dom (Graphics.make x) + ) + | IOErrorReason f -> + Hashtbl.add s_s_i_s_table id (fun dom x -> + f dom (Io_error.make x) + ) + | ControlError f -> + Hashtbl.add u_table id (fun dom x -> + f dom (Control_error.make x) + ) + | BlockJob f -> + Hashtbl.add s_i_i_table id (fun dom x -> + f dom (Block_job.make x) + ) + | DiskChange f -> + Hashtbl.add s_s_s_i_table id (fun dom x -> + f dom (Disk_change.make x) + ) + | TrayChange f -> + Hashtbl.add s_i_table id (fun dom x -> + f dom (Tray_change.make x) + ) + | PMWakeUp f -> + Hashtbl.add i_table id (fun dom x -> + f dom (PM_wakeup.make x) + ) + | PMSuspend f -> + Hashtbl.add i_table id (fun dom x -> + f dom (PM_suspend.make x) + ) + | BalloonChange f -> + Hashtbl.add i64_table id (fun dom x -> + f dom (Balloon_change.make x) + ) + | PMSuspendDisk f -> + Hashtbl.add i_table id (fun dom x -> + f dom (PM_suspend_disk.make x) + ) + end; + let libvirt_id = register_any' conn dom callback id in + Hashtbl.replace our_id_to_libvirt_id id libvirt_id; + id + + let deregister_any conn id = + if Hashtbl.mem our_id_to_libvirt_id id then begin + let libvirt_id = Hashtbl.find our_id_to_libvirt_id id in + deregister_any' conn libvirt_id + end; + Hashtbl.remove our_id_to_libvirt_id id; + Hashtbl.remove u_table id; + Hashtbl.remove i_table id; + Hashtbl.remove i64_table id; + Hashtbl.remove i_i_table id; + Hashtbl.remove s_i_table id; + Hashtbl.remove s_i_i_table id; + Hashtbl.remove s_s_i_table id; + Hashtbl.remove s_s_i_s_table id; + Hashtbl.remove s_s_s_i_table id; + Hashtbl.remove i_ga_ga_s_gs_table id + + let timeout_table = Hashtbl.create 16 + let _ = + let callback x = + if Hashtbl.mem timeout_table x + then Hashtbl.find timeout_table x () in + Callback.register "Libvirt.timeout_callback" callback + + type timer_id = int64 + + external add_timeout' : 'a Connect.t -> int -> int64 -> int = "ocaml_libvirt_event_add_timeout" + + external remove_timeout' : 'a Connect.t -> int -> unit = "ocaml_libvirt_event_remove_timeout" + + let our_id_to_timer_id = Hashtbl.create 16 + let add_timeout conn ms fn = + let id = fresh_callback_id () in + Hashtbl.add timeout_table id fn; + let timer_id = add_timeout' conn ms id in + Hashtbl.add our_id_to_timer_id id timer_id; + id + + let remove_timeout conn id = + if Hashtbl.mem our_id_to_timer_id id then begin + let timer_id = Hashtbl.find our_id_to_timer_id id in + remove_timeout' conn timer_id + end; + Hashtbl.remove our_id_to_timer_id id; + Hashtbl.remove timeout_table id +end + module Network = struct type 'rw t diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index fa5a0fe..36cd113 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -638,6 +638,361 @@ end (** Module dealing with domains. [Domain.t] is the domain object. *) +module Event : +sig + + module Defined : sig + type t = [ + | `Added (** Newly created config file *) + | `Updated (** Changed config file *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module Undefined : sig + type t = [ + | `Removed (** Deleted the config file *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module Started : sig + type t = [ + | `Booted (** Normal startup from boot *) + | `Migrated (** Incoming migration from another host *) + | `Restored (** Restored from a state file *) + | `FromSnapshot (** Restored from snapshot *) + | `Wakeup (** Started due to wakeup event *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module Suspended : sig + type t = [ + | `Paused (** Normal suspend due to admin pause *) + | `Migrated (** Suspended for offline migration *) + | `IOError (** Suspended due to a disk I/O error *) + | `Watchdog (** Suspended due to a watchdog firing *) + | `Restored (** Restored from paused state file *) + | `FromSnapshot (** Restored from paused snapshot *) + | `APIError (** suspended after failure during libvirt API call *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module Resumed : sig + type t = [ + | `Unpaused (** Normal resume due to admin unpause *) + | `Migrated (** Resumed for completion of migration *) + | `FromSnapshot (** Resumed from snapshot *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module Stopped : sig + type t = [ + | `Shutdown (** Normal shutdown *) + | `Destroyed (** Forced poweroff from host *) + | `Crashed (** Guest crashed *) + | `Migrated (** Migrated off to another host *) + | `Saved (** Saved to a state file *) + | `Failed (** Host emulator/mgmt failed *) + | `FromSnapshot (** offline snapshot loaded *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module PM_suspended : sig + type t = [ + | `Memory (** Guest was PM suspended to memory *) + | `Disk (** Guest was PM suspended to disk *) + | `Unknown of int + ] + + val to_string: t -> string + end + + module Lifecycle : sig + type t = [ + | `Defined of Defined.t + | `Undefined of Undefined.t + | `Started of Started.t + | `Suspended of Suspended.t + | `Resumed of Resumed.t + | `Stopped of Stopped.t + | `Shutdown (* no detail defined yet *) + | `PMSuspended of PM_suspended.t + | `Unknown of int + ] + + val to_string: t -> string + end + + module Reboot : sig + type t = unit + + val to_string: t -> string + end + + module Rtc_change : sig + type t = int64 + + val to_string: t -> string + end + + module Watchdog : sig + type t = [ + | `None (** No action, watchdog ignored *) + | `Pause (** Guest CPUs are paused *) + | `Reset (** Guest CPUs are reset *) + | `Poweroff (** Guest is forcably powered off *) + | `Shutdown (** Guest is requested to gracefully shutdown *) + | `Debug (** No action, a debug message logged *) + | `Unknown of int (** newer libvirt *) + ] + + val to_string: t -> string + end + + module Io_error : sig + (** Represents both IOError and IOErrorReason *) + type action = [ + | `None (** No action, IO error ignored *) + | `Pause (** Guest CPUs are paused *) + | `Report (** IO error reported to guest OS *) + | `Unknown of int (** newer libvirt *) + ] + + type t = { + src_path: string option; (** The host file on which the I/O error occurred *) + dev_alias: string option; (** The guest device alias associated with the path *) + action: action; (** The action that is to be taken due to the IO error *) + reason: string option; (** The cause of the IO error *) + } + + val to_string: t -> string + end + + module Graphics_address : sig + type family = [ + | `Ipv4 (** IPv4 address *) + | `Ipv6 (** IPv6 address *) + | `Unix (** UNIX socket path *) + | `Unknown of int (** newer libvirt *) + ] + + type t = { + family: family; (** Address family *) + node: string option; (** Address of node (eg IP address, or UNIX path *) + service: string option; (** Service name/number (eg TCP port, or NULL) *) + } + + val to_string: t -> string + end + + module Graphics_subject : sig + type identity = { + ty: string option; (** Type of identity *) + name: string option; (** Identity value *) + } + + type t = identity list + + val to_string: t -> string + end + + module Graphics : sig + type phase = [ + | `Connect (** Initial socket connection established *) + | `Initialize (** Authentication & setup completed *) + | `Disconnect (** Final socket disconnection *) + | `Unknown of int (** newer libvirt *) + ] + + type t = { + phase: phase; (** the phase of the connection *) + local: Graphics_address.t; (** the local server address *) + remote: Graphics_address.t; (** the remote client address *) + auth_scheme: string option; (** the authentication scheme activated *) + subject: Graphics_subject.t; (** the authenticated subject (user) *) + } + + val to_string: t -> string + end + + module Control_error : sig + type t = unit + + val to_string: t -> string + end + + module Block_job : sig + type ty = [ + | `KnownUnknown (** explicitly named UNKNOWN in the spec *) + | `Pull + | `Copy + | `Commit + | `Unknown of int + ] + + type status = [ + | `Completed + | `Failed + | `Cancelled + | `Ready + | `Unknown of int + ] + + type t = { + disk: string option; (** fully-qualified name of the affected disk *) + ty: ty; (** type of block job *) + status: status; (** final status of the operation *) + } + + val to_string: t -> string + end + + module Disk_change : sig + type reason = [ + | `MissingOnStart + | `Unknown of int + ] + + type t = { + old_src_path: string option; (** old source path *) + new_src_path: string option; (** new source path *) + dev_alias: string option; (** device alias name *) + reason: reason; (** reason why this callback was called *) + } + + val to_string: t -> string + end + + module Tray_change : sig + type reason = [ + | `Open + | `Close + | `Unknown of int + ] + + type t = { + dev_alias: string option; (** device alias *) + reason: reason; (** why the tray status was changed *) + } + + val to_string: t -> string + end + + module PM_wakeup : sig + type reason = [ + | `Unknown of int + ] + + type t = reason + + val to_string: t -> string + end + + module PM_suspend : sig + type reason = [ + | `Unknown of int + ] + + type t = reason + + val to_string: t -> string + end + + module Balloon_change : sig + type t = int64 + + val to_string: t -> string + end + + module PM_suspend_disk : sig + type reason = [ + | `Unknown of int + ] + + type t = reason + + val to_string: t -> string + end + + + type callback = + | Lifecycle of ([`R] Domain.t -> Lifecycle.t -> unit) + | Reboot of ([`R] Domain.t -> Reboot.t -> unit) + | RtcChange of ([`R] Domain.t -> Rtc_change.t -> unit) + | Watchdog of ([`R] Domain.t -> Watchdog.t -> unit) + | IOError of ([`R] Domain.t -> Io_error.t -> unit) + | Graphics of ([`R] Domain.t -> Graphics.t -> unit) + | IOErrorReason of ([`R] Domain.t -> Io_error.t -> unit) + | ControlError of ([`R] Domain.t -> Control_error.t -> unit) + | BlockJob of ([`R] Domain.t -> Block_job.t -> unit) + | DiskChange of ([`R] Domain.t -> Disk_change.t -> unit) + | TrayChange of ([`R] Domain.t -> Tray_change.t -> unit) + | PMWakeUp of ([`R] Domain.t -> PM_wakeup.t -> unit) + | PMSuspend of ([`R] Domain.t -> PM_suspend.t -> unit) + | BalloonChange of ([`R] Domain.t -> Balloon_change.t -> unit) + | PMSuspendDisk of ([`R] Domain.t -> PM_suspend_disk.t -> unit) + + (** type of a registered call back function *) + + val register_default_impl : unit -> unit + (** Registers the default event loop based on poll(). This + must be done before connections are opened. + + Once registered call run_default_impl in a loop. *) + + val run_default_impl : unit -> unit + (** Runs one iteration of the event loop. Applications will + generally want to have a thread which invokes this in an + infinite loop. *) + + type callback_id + (** an individual event registration *) + + val register_any : 'a Connect.t -> ?dom:'a Domain.t -> callback -> callback_id + (** [register_any con ?dom callback] registers [callback] + to receive notification of arbitrary domain events. Return + a registration id which can be used in [deregister_any]. + + If [?dom] is None then register for this kind of event on + all domains. If [dom] is [Some d] then register for this + kind of event only on [d]. + *) + + val deregister_any : 'a Connect.t -> callback_id -> unit + (** [deregister_any con id] deregisters the previously registered + callback with id [id]. *) + + type timer_id + (** an individual timer event *) + + val add_timeout : 'a Connect.t -> int -> (unit -> unit) -> timer_id + (** [add_timeout con ms cb] registers [cb] as a timeout callback + which will be called every [ms] milliseconds *) + + val remove_timeout : 'a Connect.t -> timer_id -> unit + (** [remove_timeout con t] deregisters timeout callback [t]. *) + +end + (** Module dealing with events generated by domain + state changes. *) + (** {3 Networks} *) module Network : diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c index 00dbbbc..71e6f61 100644 --- a/libvirt/libvirt_c.c +++ b/libvirt/libvirt_c.c @@ -484,6 +484,25 @@ ocaml_libvirt_connect_get_capabilities (value connv) CAMLreturn (rv); } +/* Automatically generated binding for virConnectDomainEventDeregisterAny. + * In generator.pl this function has signature "conn, int : unit". + */ + +CAMLprim value +ocaml_libvirt_connect_domain_event_deregister_any (value connv, value iv) +{ + CAMLparam2 (connv, iv); + + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + int r; + + NONBLOCKING (r = virConnectDomainEventDeregisterAny (conn, i)); + CHECK_ERROR (r == -1, conn, "virConnectDomainEventDeregisterAny"); + + CAMLreturn (Val_unit); +} + /* Automatically generated binding for virDomainCreateLinux. * In generator.pl this function has signature "conn, string, 0U : dom". */ diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c index c51aad7..3bb572f 100644 --- a/libvirt/libvirt_c_oneoffs.c +++ b/libvirt/libvirt_c_oneoffs.c @@ -740,6 +740,417 @@ ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn) argv[3], argv[4], argv[5]); } +/*----------------------------------------------------------------------*/ + +/* Domain events */ + +CAMLprim value +ocaml_libvirt_event_register_default_impl (value unitv) +{ + CAMLparam1 (unitv); + + /* arg is of type unit = void */ + int r; + + NONBLOCKING (r = virEventRegisterDefaultImpl ()); + /* must be called before connection, therefore we can't use CHECK_ERROR */ + if (r == -1) caml_failwith("virEventRegisterDefaultImpl"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_event_run_default_impl (value unitv) +{ + CAMLparam1 (unitv); + + /* arg is of type unit = void */ + int r; + + NONBLOCKING (r = virEventRunDefaultImpl ()); + if (r == -1) caml_failwith("virEventRunDefaultImpl"); + + CAMLreturn (Val_unit); +} + +/* We register a single C callback function for every distinct + callback signature. We encode the signature itself in the function + name and also in the name of the assocated OCaml callback + e.g.: + a C function called + i_i64_s_callback(virConnectPtr conn, + virDomainPtr dom, + int x, + long y, + char *z, + void *opaque) + would correspond to an OCaml callback + Libvirt.i_i64_s_callback : + int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit + where the initial int64 is a unique ID used by the OCaml to + dispatch to the specific OCaml closure and stored by libvirt + as the "opaque" data. */ + +/* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME) + where NAME is the string name of the OCaml callback registered + in libvirt.ml. */ +#define DOMAIN_CALLBACK_BEGIN(NAME) \ + value connv, domv, callback_id, result; \ + connv = domv = callback_id = result = Val_int(0); \ + static value *callback = NULL; \ + caml_leave_blocking_section(); \ + if (callback == NULL) \ + callback = caml_named_value(NAME); \ + if (callback == NULL) \ + abort(); /* C code out of sync with OCaml code */ \ + if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \ + abort(); /* should never happen in practice? */ \ + \ + Begin_roots4(connv, domv, callback_id, result); \ + connv = Val_connect(conn); \ + domv = Val_domain(dom, connv); \ + callback_id = caml_copy_int64(*(long *)opaque); + +/* Every one of the callbacks ends with a CALLBACK_END */ +#define DOMAIN_CALLBACK_END \ + (void) caml_callback3(*callback, callback_id, domv, result); \ + End_roots(); \ + caml_enter_blocking_section(); + + +static void +i_i_callback(virConnectPtr conn, + virDomainPtr dom, + int x, + int y, + void * opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback") + result = caml_alloc_tuple(2); + Store_field(result, 0, Val_int(x)); + Store_field(result, 1, Val_int(y)); + DOMAIN_CALLBACK_END +} + +static void +u_callback(virConnectPtr conn, + virDomainPtr dom, + void *opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback") + result = Val_int(0); /* () */ + DOMAIN_CALLBACK_END +} + +static void +i64_callback(virConnectPtr conn, + virDomainPtr dom, + long long int64, + void *opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback") + result = caml_copy_int64(int64); + DOMAIN_CALLBACK_END +} + +static void +i_callback(virConnectPtr conn, + virDomainPtr dom, + int x, + void *opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback") + result = Val_int(x); + DOMAIN_CALLBACK_END +} + +static void +s_i_callback(virConnectPtr conn, + virDomainPtr dom, + char *x, + int y, + void * opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback") + result = caml_alloc_tuple(2); + Store_field(result, 0, + Val_opt(x, (Val_ptr_t) caml_copy_string)); + Store_field(result, 1, Val_int(y)); + DOMAIN_CALLBACK_END +} + +static void +s_i_i_callback(virConnectPtr conn, + virDomainPtr dom, + char *x, + int y, + int z, + void * opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback") + result = caml_alloc_tuple(3); + Store_field(result, 0, + Val_opt(x, (Val_ptr_t) caml_copy_string)); + Store_field(result, 1, Val_int(y)); + Store_field(result, 2, Val_int(z)); + DOMAIN_CALLBACK_END +} + +static void +s_s_i_callback(virConnectPtr conn, + virDomainPtr dom, + char *x, + char *y, + int z, + void *opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback") + result = caml_alloc_tuple(3); + Store_field(result, 0, + Val_opt(x, (Val_ptr_t) caml_copy_string)); + Store_field(result, 1, + Val_opt(y, (Val_ptr_t) caml_copy_string)); + Store_field(result, 2, Val_int(z)); + DOMAIN_CALLBACK_END +} + +static void +s_s_i_s_callback(virConnectPtr conn, + virDomainPtr dom, + char *x, + char *y, + int z, + char *a, + void *opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback") + result = caml_alloc_tuple(4); + Store_field(result, 0, + Val_opt(x, (Val_ptr_t) caml_copy_string)); + Store_field(result, 1, + Val_opt(y, (Val_ptr_t) caml_copy_string)); + Store_field(result, 2, Val_int(z)); + Store_field(result, 3, + Val_opt(a, (Val_ptr_t) caml_copy_string)); + DOMAIN_CALLBACK_END +} + +static void +s_s_s_i_callback(virConnectPtr conn, + virDomainPtr dom, + char * x, + char * y, + char * z, + int a, + void * opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback") + result = caml_alloc_tuple(4); + Store_field(result, 0, + Val_opt(x, (Val_ptr_t) caml_copy_string)); + Store_field(result, 1, + Val_opt(y, (Val_ptr_t) caml_copy_string)); + Store_field(result, 2, + Val_opt(z, (Val_ptr_t) caml_copy_string)); + Store_field(result, 3, Val_int(a)); + DOMAIN_CALLBACK_END +} + +static value +Val_event_graphics_address(virDomainEventGraphicsAddressPtr x) +{ + CAMLparam0 (); + CAMLlocal1(result); + result = caml_alloc_tuple(3); + Store_field(result, 0, Val_int(x->family)); + Store_field(result, 1, + Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string)); + Store_field(result, 2, + Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string)); + CAMLreturn(result); +} + +static value +Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x) +{ + CAMLparam0 (); + CAMLlocal1(result); + result = caml_alloc_tuple(2); + Store_field(result, 0, + Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string)); + Store_field(result, 1, + Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string)); + CAMLreturn(result); + +} + +static value +Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x) +{ + CAMLparam0 (); + CAMLlocal1(result); + int i; + result = caml_alloc_tuple(x->nidentity); + for (i = 0; i < x->nidentity; i++ ) + Store_field(result, i, + Val_event_graphics_subject_identity(x->identities + i)); + CAMLreturn(result); +} + +static void +i_ga_ga_s_gs_callback(virConnectPtr conn, + virDomainPtr dom, + int i1, + virDomainEventGraphicsAddressPtr ga1, + virDomainEventGraphicsAddressPtr ga2, + char *s1, + virDomainEventGraphicsSubjectPtr gs1, + void * opaque) +{ + DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback") + result = caml_alloc_tuple(5); + Store_field(result, 0, Val_int(i1)); + Store_field(result, 1, Val_event_graphics_address(ga1)); + Store_field(result, 2, Val_event_graphics_address(ga2)); + Store_field(result, 3, + Val_opt(s1, (Val_ptr_t) caml_copy_string)); + Store_field(result, 4, Val_event_graphics_subject(gs1)); + DOMAIN_CALLBACK_END +} + +static void +timeout_callback(int timer, void *opaque) +{ + value callback_id, result; + callback_id = result = Val_int(0); + static value *callback = NULL; + caml_leave_blocking_section(); + if (callback == NULL) + callback = caml_named_value("Libvirt.timeout_callback"); + if (callback == NULL) + abort(); /* C code out of sync with OCaml code */ + + Begin_roots2(callback_id, result); + callback_id = caml_copy_int64(*(long *)opaque); + + (void)caml_callback_exn(*callback, callback_id); + End_roots(); + caml_enter_blocking_section(); +} + +CAMLprim value +ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id) +{ + CAMLparam3 (connv, ms, callback_id); + virConnectPtr conn = Connect_val (connv); + void *opaque; + virFreeCallback freecb = free; + virEventTimeoutCallback cb = timeout_callback; + + int r; + + /* Store the int64 callback_id as the opaque data so the OCaml + callback can demultiplex to the correct OCaml handler. */ + if ((opaque = malloc(sizeof(long))) == NULL) + caml_failwith ("virEventAddTimeout: malloc"); + *((long*)opaque) = Int64_val(callback_id); + NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb)); + CHECK_ERROR(r == -1, conn, "virEventAddTimeout"); + + CAMLreturn(Val_int(r)); +} + +CAMLprim value +ocaml_libvirt_event_remove_timeout (value connv, value timer_id) +{ + CAMLparam2 (connv, timer_id); + virConnectPtr conn = Connect_val (connv); + int r; + + NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id))); + CHECK_ERROR(r == -1, conn, "virEventRemoveTimeout"); + + CAMLreturn(Val_int(r)); +} + +CAMLprim value +ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id) +{ + CAMLparam4(connv, domv, callback, callback_id); + + virConnectPtr conn = Connect_val (connv); + virDomainPtr dom = NULL; + int eventID = Tag_val(callback); + + virConnectDomainEventGenericCallback cb; + void *opaque; + virFreeCallback freecb = free; + int r; + + if (domv != Val_int(0)) + dom = Domain_val (Field(domv, 0)); + + switch (eventID){ + case VIR_DOMAIN_EVENT_ID_LIFECYCLE: + cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback); + break; + case VIR_DOMAIN_EVENT_ID_REBOOT: + cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback); + break; + case VIR_DOMAIN_EVENT_ID_RTC_CHANGE: + cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback); + break; + case VIR_DOMAIN_EVENT_ID_WATCHDOG: + cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback); + break; + case VIR_DOMAIN_EVENT_ID_IO_ERROR: + cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback); + break; + case VIR_DOMAIN_EVENT_ID_GRAPHICS: + cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback); + break; + case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON: + cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback); + break; + case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR: + cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback); + break; + case VIR_DOMAIN_EVENT_ID_BLOCK_JOB: + cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback); + break; + case VIR_DOMAIN_EVENT_ID_DISK_CHANGE: + cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback); + break; + case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE: + cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback); + break; + case VIR_DOMAIN_EVENT_ID_PMWAKEUP: + cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback); + break; + case VIR_DOMAIN_EVENT_ID_PMSUSPEND: + cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback); + break; + case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE: + cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback); + break; + case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK: + cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback); + break; + default: + caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID"); + } + + /* Store the int64 callback_id as the opaque data so the OCaml + callback can demultiplex to the correct OCaml handler. */ + if ((opaque = malloc(sizeof(long))) == NULL) + caml_failwith ("virConnectDomainEventRegisterAny: malloc"); + *((long*)opaque) = Int64_val(callback_id); + NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb)); + CHECK_ERROR(r == -1, conn, "virConnectDomainEventRegisterAny"); + + CAMLreturn(Val_int(r)); +} + CAMLprim value ocaml_libvirt_storage_pool_get_info (value poolv) { -- 1.8.1.2
Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- .gitignore | 1 + Makefile.in | 1 + examples/Makefile.in | 13 ++++- examples/domain_events.ml | 145 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 159 insertions(+), 1 deletion(-) create mode 100644 examples/domain_events.ml diff --git a/.gitignore b/.gitignore index 2b5e4fd..71a245e 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,7 @@ core.* *.exe *~ libvirt/libvirt_version.ml +examples/domain_events examples/get_cpu_stats examples/list_domains examples/node_info diff --git a/Makefile.in b/Makefile.in index c0622cc..3b8b7ec 100644 --- a/Makefile.in +++ b/Makefile.in @@ -40,6 +40,7 @@ clean: rm -f examples/list_domains rm -f examples/node_info rm -f examples/get_cpu_stats + rm -f examples/domain_events distclean: clean rm -f config.h config.log config.status configure diff --git a/examples/Makefile.in b/examples/Makefile.in index 2eb220a..041e382 100644 --- a/examples/Makefile.in +++ b/examples/Makefile.in @@ -27,7 +27,7 @@ OCAMLOPTLIBS := $(OCAMLCLIBS) export LIBRARY_PATH=../libvirt export LD_LIBRARY_PATH=../libvirt -BYTE_TARGETS := list_domains node_info get_cpu_stats +BYTE_TARGETS := list_domains node_info get_cpu_stats domain_events OPT_TARGETS := $(BYTE_TARGETS:%=%.opt) all: $(BYTE_TARGETS) @@ -64,6 +64,17 @@ get_cpu_stats.opt: get_cpu_stats.cmx $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ ../libvirt/mllibvirt.cmxa -o $@ $< +domain_events: domain_events.cmo + $(OCAMLFIND) ocamlc \ + $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ + ../libvirt/mllibvirt.cma -o $@ $< + +domain_events.opt: domain_events.cmx + $(OCAMLFIND) ocamlopt \ + $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ + ../libvirt/mllibvirt.cmxa -o $@ $< + + install-opt install-byte: include ../Make.rules diff --git a/examples/domain_events.ml b/examples/domain_events.ml new file mode 100644 index 0000000..03cecd9 --- /dev/null +++ b/examples/domain_events.ml @@ -0,0 +1,145 @@ +(* Simple demo program showing how to receive domain events. + Usage: domain_events [URI] + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + (C) Copyright 2013 Citrix Inc + http://libvirt.org/ + *) + +open Printf + +module C = Libvirt.Connect +module D = Libvirt.Domain +module E = Libvirt.Event +module N = Libvirt.Network + +let string_of_state = function + | D.InfoNoState -> "no state" + | D.InfoRunning -> "running" + | D.InfoBlocked -> "blocked" + | D.InfoPaused -> "paused" + | D.InfoShutdown -> "shutdown" + | D.InfoShutoff -> "shutoff" + | D.InfoCrashed -> "crashed" + +let printd dom fmt = + let prefix dom = + let id = D.get_id dom in + try + let name = D.get_name dom in + let info = D.get_info dom in + let state = string_of_state info.D.state in + sprintf "%8d %-20s %s " id name state + with _ -> + sprintf "%8d " id in + let write x = + output_string stdout (prefix dom); + output_string stdout x; + output_string stdout "\n"; + flush stdout in + Printf.ksprintf write fmt + +let string_option = function + | None -> "None" + | Some x -> "Some " ^ x + +let string_of_graphics_address (family, node, service) = + Printf.sprintf "{ family=%d; node=%s; service=%s }" family (string_option node) (string_option service) + +let string_of_graphics_subject_identity (ty, name) = + Printf.sprintf "{ type=%s; name=%s }" (string_option ty) (string_option name) + +let string_of_graphics_subject xs = String.concat "; " (List.map string_of_graphics_subject_identity (Array.to_list xs)) + +let map_option f = function + | None -> None + | Some x -> Some (f x) + +let () = + try + E.register_default_impl (); + let name = + if Array.length Sys.argv >= 2 then + Some (Sys.argv.(1)) + else + None in + let conn = C.connect_readonly ?name () in + + let spinner = [| '|'; '/'; '-'; '\\' |] in + + let timeouts = ref 0 in + (* Check add/remove works *) + let id = E.add_timeout conn 250 (fun () -> Printf.printf "This callback is immediately deregistered\n%!") in + E.remove_timeout conn id; + + let (_: E.timer_id) = E.add_timeout conn 250 (* ms *) + (fun () -> + incr timeouts; + Printf.printf "\r%c %d timeout callbacks%!" (spinner.(!timeouts mod (Array.length spinner))) !timeouts; + (* Check for GC errors: *) + Gc.compact () + ) in + + (* Check add/remove works *) + let id = E.register_any conn (E.Lifecycle (fun dom e -> + printd dom "Removed Lifecycle callback %s" (E.Lifecycle.to_string e) + )) in + E.deregister_any conn id; + + let (_: E.callback_id) = E.register_any conn (E.Lifecycle (fun dom e -> + printd dom "Lifecycle %s" (E.Lifecycle.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.Reboot (fun dom e -> + printd dom "Reboot %s" (E.Reboot.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.RtcChange (fun dom e -> + printd dom "RtcChange %s" (E.Rtc_change.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.Watchdog (fun dom e -> + printd dom "Watchdog %s" (E.Watchdog.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.IOError (fun dom e -> + printd dom "IOError %s" (E.Io_error.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.IOErrorReason (fun dom e -> + printd dom "IOErrorReason %s" (E.Io_error.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.Graphics (fun dom e -> + printd dom "Graphics %s" (E.Graphics.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.ControlError (fun dom e -> + printd dom "ControlError %s" (E.Control_error.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.BlockJob (fun dom e -> + printd dom "BlockJob %s" (E.Block_job.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.DiskChange (fun dom e -> + printd dom "DiskChange %s" (E.Disk_change.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.TrayChange (fun dom e -> + printd dom "TrayChange %s" (E.Tray_change.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.PMWakeUp (fun dom e -> + printd dom "PMWakeup %s" (E.PM_wakeup.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.PMSuspend (fun dom e -> + printd dom "PMSuspend %s" (E.PM_suspend.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.BalloonChange (fun dom e -> + printd dom "BalloonChange %s" (E.Balloon_change.to_string e) + )) in + let (_: E.callback_id) = E.register_any conn (E.PMSuspendDisk (fun dom x -> + printd dom "PMSuspendDisk %s" (E.PM_suspend_disk.to_string x) + )) in + C.set_keep_alive conn 5 3; + while true do + E.run_default_impl () + done + with + Libvirt.Virterror err -> + eprintf "error: %s\n" (Libvirt.Virterror.to_string err) + +let () = + (* Run the garbage collector which is a good way to check for + * memory corruption errors and reference counting issues in libvirt. + *) + Gc.compact () -- 1.8.1.2
On Wed, Apr 24, 2013 at 11:39:02AM +0100, David Scott wrote:
Hi,
Here are my latest patches which add OCaml bindings for the libvirt event API. I'm pretty happy with them now: my test programs have been running for long periods of time without incident.
Changes from the previous submission (sent 2013-04-17) * added a patch which removes the backwards compatability logic from the bindings. The aim is to make the bindings simpler to read and develop.
Changes from the initial submission (sent 2013-03-27) * add support for 'deregister_any' * fix the ordering of '{enter,leave}_blocking_section' and GC registration * add timer callbacks
Sorry for the long delay in reviewing this. I have pushed all four patches. Thanks, Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones virt-df lists disk usage of guests without needing to install any software inside the virtual machine. Supports Linux and Windows. http://people.redhat.com/~rjones/virt-df/
Hi, On 8 May 2013, at 12:32, "Richard W.M. Jones" <rjones@redhat.com> wrote:
On Wed, Apr 24, 2013 at 11:39:02AM +0100, David Scott wrote:
Hi,
Here are my latest patches which add OCaml bindings for the libvirt event API. I'm pretty happy with them now: my test programs have been running for long periods of time without incident.
Changes from the previous submission (sent 2013-04-17) * added a patch which removes the backwards compatability logic from the bindings. The aim is to make the bindings simpler to read and develop.
Changes from the initial submission (sent 2013-03-27) * add support for 'deregister_any' * fix the ordering of '{enter,leave}_blocking_section' and GC registration * add timer callbacks
Sorry for the long delay in reviewing this.
No problem.
I have pushed all four patches.
Great! Thanks, Dave
Thanks,
Rich.
-- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones virt-df lists disk usage of guests without needing to install any software inside the virtual machine. Supports Linux and Windows. http://people.redhat.com/~rjones/virt-df/
participants (2)
-
David Scott -
Richard W.M. Jones