diff options
| author | Richard W.M. Jones <rjones@redhat.com> | 2008-01-18 18:43:20 +0000 |
|---|---|---|
| committer | Richard W.M. Jones <rjones@redhat.com> | 2008-01-18 18:43:20 +0000 |
| commit | 43b894e0ef93f380dcd8b1b20a3cd6626a8f3b7d (patch) | |
| tree | aa007bd306678022f2441ee290326c1a64d60027 | |
| parent | ebb4ff16c73674ef768674c85f600b71b63448e7 (diff) | |
| download | virt-top-43b894e0ef93f380dcd8b1b20a3cd6626a8f3b7d.tar.gz virt-top-43b894e0ef93f380dcd8b1b20a3cd6626a8f3b7d.tar.xz virt-top-43b894e0ef93f380dcd8b1b20a3cd6626a8f3b7d.zip | |
Move to autogeneration of many C bindings.
* configure.ac, libvirt/libvirt_c.c, libvirt/generator.pl: Many
C bindings can now be autogenerated using a Perl script.
Also includes preliminary support for the experimental
storage API.
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r--[-rwxr-xr-x] | config.h.in | 164 | ||||
| -rw-r--r-- | configure.ac | 54 | ||||
| -rw-r--r-- | libvirt/Makefile.in | 4 | ||||
| -rw-r--r-- | libvirt/README | 27 | ||||
| -rwxr-xr-x | libvirt/generator.pl | 524 | ||||
| -rw-r--r--[-rwxr-xr-x] | libvirt/libvirt.ml | 94 | ||||
| -rw-r--r-- | libvirt/libvirt.mli | 199 | ||||
| -rw-r--r--[-rwxr-xr-x] | libvirt/libvirt_c.c | 2072 | ||||
| -rw-r--r-- | libvirt/libvirt_c_epilogue.c | 496 | ||||
| -rw-r--r-- | libvirt/libvirt_c_oneoffs.c | 1171 | ||||
| -rw-r--r-- | libvirt/libvirt_c_prologue.c | 176 |
12 files changed, 3490 insertions, 1499 deletions
@@ -1,3 +1,11 @@ +2008-01-18 Richard Jones <rjones@redhat.com> + + Move to autogeneration of many C bindings. + * configure.ac, libvirt/libvirt_c.c, libvirt/generator.pl: Many + C bindings can now be autogenerated using a Perl script. + Also includes preliminary support for the experimental + storage API. + 2008-01-08 Richard Jones <rjones@redhat.com> Get node_info just once for each connection. diff --git a/config.h.in b/config.h.in index b28c478..37c309a 100755..100644 --- a/config.h.in +++ b/config.h.in @@ -33,15 +33,41 @@ /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H +/* Define to 1 if you have the `virConnectDiscoverStoragePools' function. */ +#undef HAVE_VIRCONNECTDISCOVERSTORAGEPOOLS + /* 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 `virDomainBlockStats' function. */ #undef HAVE_VIRDOMAINBLOCKSTATS +/* Define to 1 if you have the `virDomainCoreDumpJob' function. */ +#undef HAVE_VIRDOMAINCOREDUMPJOB + +/* Define to 1 if you have the `virDomainCreateJob' function. */ +#undef HAVE_VIRDOMAINCREATEJOB + +/* Define to 1 if you have the `virDomainCreateLinuxJob' function. */ +#undef HAVE_VIRDOMAINCREATELINUXJOB + /* Define to 1 if you have the `virDomainGetSchedulerParameters' function. */ #undef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS @@ -54,15 +80,153 @@ /* Define to 1 if you have the `virDomainMigrate' function. */ #undef HAVE_VIRDOMAINMIGRATE +/* Define to 1 if you have the `virDomainRestoreJob' function. */ +#undef HAVE_VIRDOMAINRESTOREJOB + +/* Define to 1 if you have the `virDomainSaveJob' function. */ +#undef HAVE_VIRDOMAINSAVEJOB + /* Define to 1 if you have the `virDomainSetSchedulerParameters' function. */ #undef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS +/* Define to 1 if the system has the type `virJob'. */ +#undef HAVE_VIRJOB + +/* Define to 1 if you have the `virJobCancel' function. */ +#undef HAVE_VIRJOBCANCEL + +/* Define to 1 if you have the `virJobFree' function. */ +#undef HAVE_VIRJOBFREE + +/* Define to 1 if you have the `virJobGetDomain' function. */ +#undef HAVE_VIRJOBGETDOMAIN + +/* Define to 1 if you have the `virJobGetInfo' function. */ +#undef HAVE_VIRJOBGETINFO + +/* Define to 1 if you have the `virJobGetNetwork' function. */ +#undef HAVE_VIRJOBGETNETWORK + +/* Define to 1 if you have the `virNetworkCreateJob' function. */ +#undef HAVE_VIRNETWORKCREATEJOB + +/* Define to 1 if you have the `virNetworkCreateXMLJob' function. */ +#undef HAVE_VIRNETWORKCREATEXMLJOB + /* 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 the system has the type `virStoragePool'. */ +#undef HAVE_VIRSTORAGEPOOL + +/* 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 `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 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 `virStoragePoolShutdown' function. */ +#undef HAVE_VIRSTORAGEPOOLSHUTDOWN + +/* Define to 1 if you have the `virStoragePoolUndefine' function. */ +#undef HAVE_VIRSTORAGEPOOLUNDEFINE + +/* Define to 1 if the system has the type `virStorageVol'. */ +#undef HAVE_VIRSTORAGEVOL + +/* Define to 1 if you have the `virStorageVolCreateXML' function. */ +#undef HAVE_VIRSTORAGEVOLCREATEXML + +/* Define to 1 if you have the `virStorageVolDestroy' function. */ +#undef HAVE_VIRSTORAGEVOLDESTROY + +/* Define to 1 if you have the `virStorageVolFree' function. */ +#undef HAVE_VIRSTORAGEVOLFREE + +/* Define to 1 if you have the `virStorageVolGetConnect' function. */ +#undef HAVE_VIRSTORAGEVOLGETCONNECT + +/* 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 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 8158440..0fe2bda 100644 --- a/configure.ac +++ b/configure.ac @@ -80,8 +80,62 @@ AC_CHECK_FUNCS([virConnectGetHostname \ virDomainSetSchedulerParameters \ virNodeGetFreeMemory \ virNodeGetCellsFreeMemory \ + virJobGetInfo \ + virJobGetDomain \ + virJobGetNetwork \ + virJobCancel \ + virJobFree \ + virDomainCreateLinuxJob \ + virDomainSaveJob \ + virDomainRestoreJob \ + virDomainCoreDumpJob \ + virDomainCreateJob \ + virNetworkCreateXMLJob \ + virNetworkCreateJob \ + virStoragePoolGetConnect \ + virConnectNumOfStoragePools \ + virConnectListStoragePools \ + virConnectNumOfDefinedStoragePools \ + virConnectListDefinedStoragePools \ + virConnectDiscoverStoragePools \ + virStoragePoolLookupByName \ + virStoragePoolLookupByUUID \ + virStoragePoolLookupByUUIDString \ + virStoragePoolLookupByVolume \ + virStoragePoolCreateXML \ + virStoragePoolDefineXML \ + virStoragePoolUndefine \ + virStoragePoolCreate \ + virStoragePoolDestroy \ + virStoragePoolShutdown \ + virStoragePoolFree \ + virStoragePoolRefresh \ + virStoragePoolGetName \ + virStoragePoolGetUUID \ + virStoragePoolGetUUIDString \ + virStoragePoolGetInfo \ + virStoragePoolGetXMLDesc \ + virStoragePoolGetAutostart \ + virStoragePoolSetAutostart \ + virStoragePoolNumOfVolumes \ + virStoragePoolListVolumes \ + virStorageVolGetConnect \ + virStorageVolLookupByName \ + virStorageVolLookupByKey \ + virStorageVolLookupByPath \ + virStorageVolGetName \ + virStorageVolGetKey \ + virStorageVolCreateXML \ + virStorageVolDestroy \ + virStorageVolFree \ + virStorageVolGetInfo \ + virStorageVolGetXMLDesc \ + virStorageVolGetPath \ ]) +dnl Check for optional types added since 0.2.1. +AC_CHECK_TYPES([virJobPtr, virStoragePoolPtr, virStorageVolPtr]) + dnl We also use <libvirt/virterror.h> AC_CHECK_HEADER([libvirt/virterror.h], [], diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in index 53b25b0..9387bc9 100644 --- a/libvirt/Makefile.in +++ b/libvirt/Makefile.in @@ -98,6 +98,10 @@ $(BYTE_TARGETS) $(OPT_TARGETS): endif endif +# Automatically generate the C code from a Perl script 'generator.pl'. +libvirt_c.c: generator.pl + perl -w $< > $@ + libvirt.cmo: libvirt.cmi libvirt.cmi: libvirt.mli diff --git a/libvirt/README b/libvirt/README new file mode 100644 index 0000000..c94cccb --- /dev/null +++ b/libvirt/README @@ -0,0 +1,27 @@ +README for generated code +------------------------- + +The C bindings in 'libvirt_c.c' are now generated automatically by a +Perl script called 'generator.pl'. You do not normally need to run +this script, but you may need to if you want to extend libvirt +coverage. + +The generated 'libvirt_c.c' #includes some other C files in this +directory: + + #include "libvirt_c_prologue.c" + + A prologue that prototypes some static functions which are defined + in the epilogue (see below), and provides some general macros. + + #include "libvirt_c_oneoffs.c" + + One-off bindings: Bindings which are too specialised or one-of-a-kind + to be worth generating automatically. + + [Followed by generated bindings, then ...] + + #include "libvirt_c_epilogue.c" + + An epilogue which defines some standard static functions (eg.) for + wrapping and unwrapping libvirt objects. diff --git a/libvirt/generator.pl b/libvirt/generator.pl new file mode 100755 index 0000000..a54bd94 --- /dev/null +++ b/libvirt/generator.pl @@ -0,0 +1,524 @@ +#!/usr/bin/perl -w +# +# OCaml bindings for libvirt. +# (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. +# http://libvirt.org/ +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; either +# version 2 of the License, or (at your option) any later version. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +# This generates libvirt_c.c (the core of the bindings). You don't +# need to run this program unless you are extending the bindings +# themselves (eg. because libvirt has been extended). + +use strict; + +#---------------------------------------------------------------------- + +# The functions in the libvirt API that we can generate. + +my @functions = ( + { name => "virConnectGetHostname", sig => "conn : string", weak => 1 }, + { name => "virConnectGetURI", sig => "conn : string", weak => 1 }, + { name => "virConnectGetType", sig => "conn : static string" }, + { name => "virConnectNumOfDomains", sig => "conn : int" }, + { name => "virConnectListDomains", sig => "conn, int : int array" }, + { name => "virConnectNumOfDefinedDomains", sig => "conn : int" }, + { name => "virConnectListDefinedDomains", + sig => "conn, int : string array" }, + { name => "virConnectNumOfNetworks", sig => "conn : int" }, + { name => "virConnectListNetworks", sig => "conn, int : string array" }, + { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" }, + { name => "virConnectListDefinedNetworks", + sig => "conn, int : string array" }, + { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 }, + { name => "virConnectListStoragePools", + sig => "conn, int : string array", weak => 1 }, + { name => "virConnectNumOfDefinedStoragePools", + sig => "conn : int", weak => 1 }, + { name => "virConnectListDefinedStoragePools", + sig => "conn, int : string array", weak => 1 }, + { name => "virConnectGetCapabilities", sig => "conn : string" }, + + { name => "virDomainGetName", sig => "dom : static string" }, + { name => "virDomainGetOSType", sig => "dom : string" }, + { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" }, + { name => "virDomainSuspend", sig => "dom : unit" }, + { name => "virDomainResume", sig => "dom : unit" }, + { name => "virDomainShutdown", sig => "dom : unit" }, + { name => "virDomainReboot", sig => "dom, 0 : unit" }, + { name => "virDomainUndefine", sig => "dom : unit" }, + { name => "virDomainCreate", sig => "dom : unit" }, + + { name => "virNetworkGetName", sig => "net : static string" }, + { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" }, + { name => "virNetworkGetBridgeName", sig => "net : string" }, + { name => "virNetworkUndefine", sig => "net : unit" }, + { name => "virNetworkCreate", sig => "net : unit" }, + + { name => "virStoragePoolGetName", + sig => "pool : static string", weak => 1 }, + { name => "virStoragePoolGetXMLDesc", + sig => "pool, 0 : string", weak => 1 }, + { name => "virStoragePoolUndefine", + sig => "pool : string", weak => 1 }, + { name => "virStoragePoolCreate", + sig => "pool : string", weak => 1 }, + { name => "virStoragePoolShutdown", + sig => "pool : string", weak => 1 }, + { name => "virStoragePoolRefresh", + sig => "pool, 0 : string", weak => 1 }, + + { name => "virStorageVolGetXMLDesc", + sig => "pool, 0 : string", weak => 1 }, + { name => "virStorageVolGetPath", + sig => "pool : string", weak => 1 }, + { name => "virStorageVolGetKey", + sig => "pool : static string", weak => 1 }, + { name => "virStorageVolGetName", + sig => "pool : static string", weak => 1 }, + + ); + +# Functions we haven't implemented anywhere yet. +# We create stubs for these, but they need to either be moved ^^ so they +# are auto-generated or implementations written in libvirt_c_oneoffs.c. + +my @unimplemented = ( + "ocaml_libvirt_domain_create_job", + "ocaml_libvirt_domain_core_dump_job", + "ocaml_libvirt_domain_restore_job", + "ocaml_libvirt_domain_save_job", + "ocaml_libvirt_connect_create_linux_job", + "ocaml_libvirt_network_create_job", + "ocaml_libvirt_network_create_xml_job", + "ocaml_libvirt_storage_pool_set_autostart", + "ocaml_libvirt_storage_pool_get_autostart", + "ocaml_libvirt_storage_pool_get_info", + "ocaml_libvirt_storage_pool_get_uuid_string", + "ocaml_libvirt_storage_pool_get_uuid", + "ocaml_libvirt_storage_pool_free", + "ocaml_libvirt_storage_pool_destroy", + "ocaml_libvirt_storage_pool_define_xml", + "ocaml_libvirt_storage_pool_create_xml", + "ocaml_libvirt_storage_pool_lookup_by_uuid_string", + "ocaml_libvirt_storage_pool_lookup_by_uuid", + "ocaml_libvirt_storage_pool_lookup_by_name", + "ocaml_libvirt_storage_vol_free", + "ocaml_libvirt_storage_vol_destroy", + "ocaml_libvirt_storage_vol_create_xml", + "ocaml_libvirt_storage_vol_get_info", + "ocaml_libvirt_pool_of_volume", + "ocaml_libvirt_storage_vol_lookup_by_path", + "ocaml_libvirt_storage_vol_lookup_by_key", + "ocaml_libvirt_storage_vol_lookup_by_name", + "ocaml_libvirt_job_cancel", + "ocaml_libvirt_job_get_network", + "ocaml_libvirt_job_get_domain", + "ocaml_libvirt_job_get_info", + ); + +#---------------------------------------------------------------------- + +# Open the output file. + +my $filename = "libvirt_c.c"; +open F, ">$filename" or die "$filename: $!"; + +# Write the prologue. + +print F <<'END'; +/* WARNING: THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'. + * Any changes you make to this file may be overwritten. + */ + +/* OCaml bindings for libvirt. + * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + * http://libvirt.org/ + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +#include "config.h" + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include <libvirt/libvirt.h> +#include <libvirt/virterror.h> + +#include <caml/config.h> +#include <caml/alloc.h> +#include <caml/callback.h> +#include <caml/custom.h> +#include <caml/fail.h> +#include <caml/memory.h> +#include <caml/misc.h> +#include <caml/mlvalues.h> +#include <caml/signals.h> + +#include "libvirt_c_prologue.c" + +#include "libvirt_c_oneoffs.c" + +END + +#---------------------------------------------------------------------- + +sub camel_case_to_underscores +{ + my $name = shift; + + $name =~ s/([A-Z][a-z]+|XML|URI|OS)/$1,/g; + my @subs = split (/,/, $name); + @subs = map { lc($_) } @subs; + join "_", @subs +} + +# Helper functions dealing with signatures. + +sub short_name_to_c_type +{ + local $_ = shift; + + if ($_ eq "conn") { "virConnectPtr" } + elsif ($_ eq "dom") { "virDomainPtr" } + elsif ($_ eq "net") { "virNetworkPtr" } + elsif ($_ eq "pool") { "virStoragePoolPtr" } + elsif ($_ eq "vol") { "virStorageVolPtr" } + else { + die "unknown short name $_" + } +} + +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 eq "conn, int : int array") { + "int $c_name (virConnectPtr conn, int *ids, int maxids)" + } elsif ($sig eq "conn, int : string array") { + "int $c_name (virConnectPtr conn, char **const names, int maxnames)" + } elsif ($sig =~ /^(\w+), 0 : string$/) { + my $c_type = short_name_to_c_type ($1); + "char *$c_name ($c_type $1, int flags)" + } elsif ($sig =~ /^(\w+), 0 : unit$/) { + my $c_type = short_name_to_c_type ($1); + "int $c_name ($c_type $1, int flags)" + } elsif ($sig =~ /^(\w+) : unit$/) { + my $c_type = short_name_to_c_type ($1); + "int $c_name ($c_type $1 dom)" + } else { + die "unknown signature $sig" + } +} + +sub gen_arg_names +{ + my $sig = shift; + + if ($sig =~ /^(\w+) : string$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : static string$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : int$/) { + ( "$1v" ) + } elsif ($sig eq "conn, int : int array") { + ( "connv", "iv" ) + } elsif ($sig eq "conn, int : string array") { + ( "connv", "iv" ) + } elsif ($sig =~ /^(\w+), 0 : string$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), 0 : unit$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : unit$/) { + ( "$1v" ) + } else { + die "unknown signature $sig" + } +} + +sub gen_unpack_args +{ + local $_ = shift; + + if ($_ eq "conn") { + "virConnectPtr conn = Connect_val (connv);" + } elsif ($_ eq "dom") { + "virDomainPtr dom = Domain_val (domv);\n". + " virConnectPtr conn = Connect_domv (domv);" + } elsif ($_ eq "net") { + "virNetworkPtr net = Network_val (netv);\n". + " virConnectPtr conn = Connect_netv (netv);" + } elsif ($_ eq "pool") { + "virStoragePoolPtr pool = Pool_val (poolv);\n". + " virConnectPtr conn = Connect_polv (poolv);" + } elsif ($_ eq "vol") { + "virStorageVolPtr vol = Volume_val (volv);\n". + " virConnectPtr conn = Connect_volv (volv);" + } else { + die "unknown short name $_" + } +} + +sub gen_c_code +{ + my $sig = shift; + my $c_name = shift; + + if ($sig =~ /^(\w+) : string$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : static string$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + const char *r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + rv = caml_copy_string (r); + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : int$/) { + "\ + " . gen_unpack_args ($1) . " + int r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_int (r)); +" + } elsif ($sig eq "conn, int : int array") { + "\ + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + int ids[i], r; + + NONBLOCKING (r = $c_name (conn, ids, i)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) + Store_field (rv, i, Val_int (ids[i])); + + CAMLreturn (rv); +" + } elsif ($sig eq "conn, int : string array") { + "\ + CAMLlocal2 (rv, strv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + char *names[i]; + int r; + + NONBLOCKING (r = $c_name (conn, names, i)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) { + strv = caml_copy_string (names[i]); + Store_field (rv, i, strv); + free (names[i]); + } + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0 : string$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : unit$/) { + "\ + " . gen_unpack_args ($1) . " + int r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" + } elsif ($sig =~ /^(\w+), 0 : unit$/) { + "\ + " . gen_unpack_args ($1) . " + int r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" + } else { + die "unknown signature $sig" + } +} + +# Generate each function. + +foreach my $function (@functions) { + my $c_name = $function->{name}; + my $is_weak = $function->{weak}; + my $sig = $function->{sig}; + + my $is_pool_func = $c_name =~ /^virStoragePool/; + my $is_vol_func = $c_name =~ /^virStorageVol/; + + # Generate an equivalent C-external name for the function, unless + # one is defined already. + my $c_external_name; + if (exists ($function->{c_external_name})) { + $c_external_name = $function->{c_external_name}; + } elsif ($c_name =~ /^vir/) { + $c_external_name = substr $c_name, 3; + $c_external_name = camel_case_to_underscores ($c_external_name); + $c_external_name = "ocaml_libvirt_" . $c_external_name; + } else { + die "cannot convert c_name $c_name to c_external_name" + } + + # 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; + my $arg_names_as_values = join (", ", map { "value $_" } @arg_names); + + # Generate the start of the function, arguments. + print F <<END; +CAMLprim value +$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"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#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; +} + +END +} + +#---------------------------------------------------------------------- + +# Unimplemented functions. + +printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented); + +foreach my $c_external_name (@unimplemented) { + print F <<END +CAMLprim value +$c_external_name () +{ + failwith ("$c_external_name is unimplemented"); +} + +END +} + +#---------------------------------------------------------------------- + +# Write the epilogue. + +print F <<'END'; +#include "libvirt_c_epilogue.c" + +/* EOF */ +END + +close F; +print "$0: written $filename\n" + diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml index 6582874..598cd7d 100755..100644 --- a/libvirt/libvirt.ml +++ b/libvirt/libvirt.ml @@ -32,6 +32,8 @@ let uuid_string_length = 36 type rw = [`R|`W] type ro = [`R] +type ('a, 'b) job_t + module Connect = struct type 'rw t @@ -64,6 +66,11 @@ struct external list_networks : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_networks" external num_of_defined_networks : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_networks" external list_defined_networks : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_networks" + external num_of_pools : [>`R] t -> int = "ocaml_libvirt_connect_num_of_storage_pools" + external list_pools : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_storage_pools" + external num_of_defined_pools : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_storage_pools" + external list_defined_pools : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_storage_pools" + external get_node_info : [>`R] t -> node_info = "ocaml_libvirt_connect_get_node_info" external node_get_free_memory : [> `R] t -> int64 = "ocaml_libvirt_connect_node_get_free_memory" external node_get_cells_free_memory : [> `R] t -> int -> int -> int64 array = "ocaml_libvirt_connect_node_get_cells_free_memory" @@ -92,8 +99,7 @@ end module Domain = struct - type 'rw dom - type 'rw t = 'rw dom * 'rw Connect.t + type 'rw t type state = | InfoNoState | InfoRunning | InfoBlocked | InfoPaused @@ -144,6 +150,7 @@ struct } external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux" + external create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_connect_create_linux_job" external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id" external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid" external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string" @@ -153,8 +160,11 @@ struct external suspend : [>`W] t -> unit = "ocaml_libvirt_domain_suspend" external resume : [>`W] t -> unit = "ocaml_libvirt_domain_resume" external save : [>`W] t -> filename -> unit = "ocaml_libvirt_domain_save" + external save_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_save_job" external restore : [>`W] Connect.t -> filename -> unit = "ocaml_libvirt_domain_restore" + external restore_job : [>`W] Connect.t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_restore_job" external core_dump : [>`W] t -> filename -> unit = "ocaml_libvirt_domain_core_dump" + external core_dump_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_core_dump_job" external shutdown : [>`W] t -> unit = "ocaml_libvirt_domain_shutdown" external reboot : [>`W] t -> unit = "ocaml_libvirt_domain_reboot" external get_name : [>`R] t -> string = "ocaml_libvirt_domain_get_name" @@ -173,6 +183,7 @@ struct external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_define_xml" external undefine : [>`W] t -> unit = "ocaml_libvirt_domain_undefine" external create : [>`W] t -> unit = "ocaml_libvirt_domain_create" + external create_job : [>`W] t -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_create_job" external get_autostart : [>`R] t -> bool = "ocaml_libvirt_domain_get_autostart" external set_autostart : [>`W] t -> bool -> unit = "ocaml_libvirt_domain_set_autostart" external set_vcpus : [>`W] t -> int -> unit = "ocaml_libvirt_domain_set_vcpus" @@ -190,16 +201,17 @@ end module Network = struct - type 'rw net - type 'rw t = 'rw net * 'rw Connect.t + type 'rw t external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_network_lookup_by_name" external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_network_lookup_by_uuid" external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_network_lookup_by_uuid_string" external create_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_network_create_xml" + external create_xml_job : [>`W] Connect.t -> xml -> ([`Network], rw) job_t = "ocaml_libvirt_network_create_xml_job" external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_network_define_xml" external undefine : [>`W] t -> unit = "ocaml_libvirt_network_undefine" external create : [>`W] t -> unit = "ocaml_libvirt_network_create" + external create_job : [>`W] t -> ([`Network_nocreate], rw) job_t = "ocaml_libvirt_network_create_job" external destroy : [>`W] t -> unit = "ocaml_libvirt_network_destroy" external free : [>`R] t -> unit = "ocaml_libvirt_network_free" external get_name : [>`R] t -> string = "ocaml_libvirt_network_get_name" @@ -213,6 +225,80 @@ struct external const : [>`R] t -> ro t = "%identity" end +module Pool = +struct + type 'rw t + type pool_state = Inactive | Active + type pool_info = { + capacity : int64; + allocation : int64; + } + + external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_name" + external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_uuid" + external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_uuid_string" + external create_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_storage_pool_create_xml" + external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_storage_pool_define_xml" + external undefine : [>`W] t -> unit = "ocaml_libvirt_storage_pool_undefine" + external create : [>`W] t -> unit = "ocaml_libvirt_storage_pool_create" + external destroy : [>`W] t -> unit = "ocaml_libvirt_storage_pool_destroy" + external shutdown : [>`W] t -> unit = "ocaml_libvirt_storage_pool_shutdown" + external free : [>`R] t -> unit = "ocaml_libvirt_storage_pool_free" + external refresh : [`R] t -> unit = "ocaml_libvirt_storage_pool_refresh" + external get_name : [`R] t -> string = "ocaml_libvirt_storage_pool_get_name" + external get_uuid : [`R] t -> uuid = "ocaml_libvirt_storage_pool_get_uuid" + external get_uuid_string : [`R] t -> string = "ocaml_libvirt_storage_pool_get_uuid_string" + external get_info : [`R] t -> pool_info = "ocaml_libvirt_storage_pool_get_info" + external get_xml_desc : [`R] t -> xml = "ocaml_libvirt_storage_pool_get_xml_desc" + external get_autostart : [`R] t -> bool = "ocaml_libvirt_storage_pool_get_autostart" + external set_autostart : [`W] t -> bool -> unit = "ocaml_libvirt_storage_pool_set_autostart" + external const : [>`R] t -> ro t = "%identity" +end + +module Volume = +struct + type 'rw t + type vol_type = File | Block | Virtual + type vol_info = { + typ : vol_type; + capacity : int64; + allocation : int64; + } + + external lookup_by_name : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_name" + external lookup_by_key : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_key" + external lookup_by_path : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_path" + external pool_of_volume : 'a t -> 'a Pool.t = "ocaml_libvirt_pool_of_volume" + external get_name : [`R] t -> string = "ocaml_libvirt_storage_vol_get_name" + external get_key : [`R] t -> string = "ocaml_libvirt_storage_vol_get_key" + external get_path : [`R] t -> string = "ocaml_libvirt_storage_vol_get_path" + external get_info : [`R] t -> vol_info = "ocaml_libvirt_storage_vol_get_info" + external get_xml_desc : [`R] t -> xml = "ocaml_libvirt_storage_vol_get_xml_desc" + external create_xml : [`W] Pool.t -> xml -> unit = "ocaml_libvirt_storage_vol_create_xml" + external destroy : [`W] t -> unit = "ocaml_libvirt_storage_vol_destroy" + external free : [>`R] t -> unit = "ocaml_libvirt_storage_vol_free" + external const : [>`R] t -> ro t = "%identity" +end + +module Job = +struct + type ('jobclass, 'rw) t = ('jobclass, 'rw) job_t + type job_type = Bounded | Unbounded + type job_state = Running | Complete | Failed | Cancelled + type job_info = { + typ : job_type; + state : job_state; + running_time : int; + remaining_time : int; + percent_complete : int + } + external get_info : ('a,'b) t -> job_info = "ocaml_libvirt_job_get_info" + external get_domain : ([`Domain], 'a) t -> 'a Domain.t = "ocaml_libvirt_job_get_domain" + external get_network : ([`Network], 'a) t -> 'a Network.t = "ocaml_libvirt_job_get_network" + external cancel : ('a,'b) t -> unit = "ocaml_libvirt_job_cancel" + external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" +end + module Virterror = struct type code = diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index 0ccaf92..61beee5 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -242,6 +242,9 @@ v} See also the source of [mlvirsh]. *) +type ('a, 'b) job_t +(** Forward definition of {!Job.t} to avoid recursive module dependencies. *) + (** {3 Connections} *) module Connect : @@ -327,6 +330,15 @@ sig Call {!num_of_defined_networks} first to get a value for [max]. *) + val num_of_pools : [>`R] t -> int + (** Returns the number of storage pools. *) + val list_pools : [>`R] t -> int -> string array + (** Return list of storage pools. *) + val num_of_defined_pools : [>`R] t -> int + (** Returns the number of storage pools. *) + val list_defined_pools : [>`R] t -> int -> string array + (** Return list of storage pools. *) + (* The name of this function is inconsistent, but the inconsistency * is really in libvirt itself. *) @@ -437,6 +449,8 @@ sig (** Create a new guest domain (not necessarily a Linux one) from the given XML. *) + val create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t + (** Asynchronous domain creation. *) val lookup_by_id : 'a Connect.t -> int -> 'a t (** Lookup a domain by ID. *) val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t @@ -461,10 +475,16 @@ sig (** Resume a domain. *) val save : [>`W] t -> filename -> unit (** Suspend a domain, then save it to the file. *) + val save_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t + (** Asynchronous domain suspend. *) val restore : [>`W] Connect.t -> filename -> unit (** Restore a domain from a file. *) + val restore_job : [>`W] Connect.t -> filename -> ([`Domain_nocreate], rw) job_t + (** Asynchronous domain restore. *) val core_dump : [>`W] t -> filename -> unit (** Force a domain to core dump to the named file. *) + val core_dump_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t + (** Asynchronous core dump. *) val shutdown : [>`W] t -> unit (** Shutdown a domain. *) val reboot : [>`W] t -> unit @@ -506,6 +526,8 @@ sig (** Undefine a domain - removes its configuration. *) val create : [>`W] t -> unit (** Launch a defined (inactive) domain. *) + val create_job : [>`W] t -> ([`Domain_nocreate], rw) job_t + (** Asynchronous launch domain. *) val get_autostart : [>`R] t -> bool (** Get the autostart flag for a domain. *) val set_autostart : [>`W] t -> bool -> unit @@ -571,12 +593,16 @@ sig (** Lookup a network by UUID string. *) val create_xml : [>`W] Connect.t -> xml -> rw t (** Create a network. *) + val create_xml_job : [>`W] Connect.t -> xml -> ([`Network], rw) job_t + (** Asynchronous create network. *) val define_xml : [>`W] Connect.t -> xml -> rw t (** Define but don't activate a network. *) val undefine : [>`W] t -> unit (** Undefine configuration of a network. *) val create : [>`W] t -> unit (** Start up a defined (inactive) network. *) + val create_job : [>`W] t -> ([`Network_nocreate], rw) job_t + (** Asynchronous start network. *) val destroy : [>`W] t -> unit (** Destroy a network. *) val free : [>`R] t -> unit @@ -611,6 +637,179 @@ end network object. *) +(** {3 Storage pools} *) + +module Pool : +sig + type 'rw t + (** Storage pool handle. *) + + type pool_state = Inactive | Active + (** State of the storage pool. *) + + type pool_info = { + capacity : int64; (** Logical size in bytes. *) + allocation : int64; (** Currently allocated in bytes. *) + } + + val lookup_by_name : 'a Connect.t -> string -> 'a t + val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t + val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t + (** Look up a storage pool by name, UUID or UUID string. *) + + val create_xml : [>`W] Connect.t -> xml -> rw t + (** Create a storage pool. *) + val define_xml : [>`W] Connect.t -> xml -> rw t + (** Define but don't activate a storage pool. *) + val undefine : [>`W] t -> unit + (** Undefine configuration of a storage pool. *) + val create : [>`W] t -> unit + (** Start up a defined (inactive) storage pool. *) + val destroy : [>`W] t -> unit + (** Destroy a storage pool. *) + val shutdown : [>`W] t -> unit + (** Shutdown a storage pool. *) + val free : [>`R] t -> unit + (** Free a storage pool object in memory. + + The storage pool object is automatically freed if it is garbage + collected. This function just forces it to be freed right + away. + *) + val refresh : [`R] t -> unit + (** Refresh the list of volumes in the storage pool. *) + + val get_name : [`R] t -> string + (** Name of the pool. *) + val get_uuid : [`R] t -> uuid + (** Get the UUID (as a packed byte array). *) + val get_uuid_string : [`R] t -> string + (** Get the UUID (as a printable string). *) + val get_info : [`R] t -> pool_info + (** Get information about the pool. *) + val get_xml_desc : [`R] t -> xml + (** Get the XML description. *) + val get_autostart : [`R] t -> bool + (** Get the autostart flag for the storage pool. *) + val set_autostart : [`W] t -> bool -> unit + (** Set the autostart flag for the storage pool. *) + + external const : [>`R] t -> ro t = "%identity" + (** [const conn] turns a read/write storage pool into a read-only + pool. Note that the opposite operation is impossible. + *) +end + (** Module dealing with storage pools. *) + +(** {3 Storage volumes} *) + +module Volume : +sig + type 'rw t + (** Storage volume handle. *) + + type vol_type = File | Block | Virtual + (** Type of a storage volume. *) + + type vol_info = { + typ : vol_type; (** Type of storage volume. *) + capacity : int64; (** Logical size in bytes. *) + allocation : int64; (** Currently allocated in bytes. *) + } + + val lookup_by_name : 'a Pool.t -> string -> 'a t + val lookup_by_key : 'a Pool.t -> string -> 'a t + val lookup_by_path : 'a Pool.t -> string -> 'a t + (** Look up a storage volume by name, key or path volume. *) + + val pool_of_volume : 'a t -> 'a Pool.t + (** Get the storage pool containing this volume. *) + + val get_name : [`R] t -> string + (** Name of the volume. *) + val get_key : [`R] t -> string + (** Key of the volume. *) + val get_path : [`R] t -> string + (** Path of the volume. *) + val get_info : [`R] t -> vol_info + (** Get information about the storage volume. *) + val get_xml_desc : [`R] t -> xml + (** Get the XML description. *) + + val create_xml : [`W] Pool.t -> xml -> unit + (** Create a storage volume. *) + val destroy : [`W] t -> unit + (** Destroy a storage volume. *) + val free : [>`R] t -> unit + (** Free a storage volume object in memory. + + The storage volume object is automatically freed if it is garbage + collected. This function just forces it to be freed right + away. + *) + + external const : [>`R] t -> ro t = "%identity" + (** [const conn] turns a read/write storage volume into a read-only + volume. Note that the opposite operation is impossible. + *) +end + (** Module dealing with storage volumes. *) + +(** {3 Jobs and asynchronous processing} *) + +module Job : +sig + type ('jobclass, 'rw) t = ('jobclass, 'rw) job_t + (** A background asynchronous job. + + Jobs represent a pending operation such as domain creation. + The possible types for a job are: + +{v +(`Domain, `W) Job.t Job creating a r/w domain +(`Domain_nocreate, `W) Job.t Job acting on an existing domain +(`Network, `W) Job.t Job creating a r/w network +(`Network_nocreate, `W) Job.t Job acting on an existing network +v} + *) + + type job_type = Bounded | Unbounded + (** A Bounded job is one where we can estimate time to completion. *) + + type job_state = Running | Complete | Failed | Cancelled + (** State of the job. *) + + type job_info = { + typ : job_type; (** Job type *) + state : job_state; (** Job state *) + running_time : int; (** Actual running time (seconds) *) + (** The following fields are only available in Bounded jobs: *) + remaining_time : int; (** Estimated time left (seconds) *) + percent_complete : int (** Estimated percent complete *) + } + + val get_info : ('a,'b) t -> job_info + (** Get information and status about the job. *) + + val get_domain : ([`Domain], 'a) t -> 'a Domain.t + (** Get the completed domain from a job. + + You should only call it on a job in state Complete. *) + + val get_network : ([`Network], 'a) t -> 'a Network.t + (** Get the completed network from a job. + + You should only call it on a job in state Complete. *) + + val cancel : ('a,'b) t -> unit + (** Cancel a job. *) + + external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" + (** [const conn] turns a read/write job into a read-only + job. Note that the opposite operation is impossible. + *) +end + (** {3 Error handling and exceptions} *) module Virterror : diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c index 4ae121c..27aa4c0 100755..100644 --- a/libvirt/libvirt_c.c +++ b/libvirt/libvirt_c.c @@ -1,5 +1,9 @@ +/* WARNING: THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'. + * Any changes you make to this file may be overwritten. + */ + /* OCaml bindings for libvirt. - * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. * http://libvirt.org/ * * This library is free software; you can redistribute it and/or @@ -36,361 +40,91 @@ #include <caml/mlvalues.h> #include <caml/signals.h> -static char *Optstring_val (value strv); -typedef value (*Val_ptr_t) (void *); -static value Val_opt (void *ptr, Val_ptr_t Val_ptr); -/*static value option_default (value option, value deflt);*/ -static void _raise_virterror (virConnectPtr conn, const char *fn); -static void not_supported (const char *fn); -static value Val_virterror (virErrorPtr err); - -/* Use this around synchronous libvirt API calls to release the OCaml - * lock, allowing other threads to run simultaneously. 'code' must not - * perform any caml_* calls, run any OCaml code, or raise any exception. - * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html - */ -#define NONBLOCKING(code) \ - do { \ - caml_enter_blocking_section (); \ - code; \ - caml_leave_blocking_section (); \ - } while (0) - -/* Check error condition from a libvirt function, and automatically raise - * an exception if one is found. - */ -#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 +#include "libvirt_c_prologue.c" -#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 */ +#include "libvirt_c_oneoffs.c" #ifdef HAVE_WEAK_SYMBOLS #ifdef HAVE_VIRCONNECTGETHOSTNAME -extern char *virConnectGetHostname (virConnectPtr conn) - __attribute__((weak)); -#endif -#ifdef HAVE_VIRCONNECTGETURI -extern char *virConnectGetURI (virConnectPtr conn) - __attribute__((weak)); -#endif -#ifdef HAVE_VIRDOMAINBLOCKSTATS -extern int virDomainBlockStats (virDomainPtr dom, - const char *path, - virDomainBlockStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS -extern int virDomainGetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int *nparams) - __attribute__((weak)); +extern char *virConnectGetHostname (virConnectPtr conn) __attribute__((weak)); #endif -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE -extern char *virDomainGetSchedulerType(virDomainPtr domain, - int *nparams) - __attribute__((weak)); #endif -#ifdef HAVE_VIRDOMAININTERFACESTATS -extern int virDomainInterfaceStats (virDomainPtr dom, - const char *path, - virDomainInterfaceStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#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 -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS -extern int virDomainSetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int nparams) - __attribute__((weak)); -#endif -#ifdef HAVE_VIRNODEGETFREEMEMORY -extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn) - __attribute__((weak)); -#endif -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY -extern int virNodeGetCellsFreeMemory (virConnectPtr conn, - unsigned long long *freeMems, - int startCell, int maxCells) - __attribute__((weak)); -#endif -#endif /* HAVE_WEAK_SYMBOLS */ - -/*----------------------------------------------------------------------*/ - -CAMLprim value -ocaml_libvirt_get_version (value driverv, value unit) -{ - CAMLparam2 (driverv, unit); - CAMLlocal1 (rv); - const char *driver = Optstring_val (driverv); - unsigned long libVer, typeVer = 0, *typeVer_ptr; - int r; - - typeVer_ptr = driver ? &typeVer : NULL; - NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr)); - CHECK_ERROR (r == -1, NULL, "virGetVersion"); - - rv = caml_alloc_tuple (2); - Store_field (rv, 0, Val_int (libVer)); - Store_field (rv, 1, Val_int (typeVer)); - CAMLreturn (rv); -} - -/*----------------------------------------------------------------------*/ - -/* Some notes about the use of custom blocks to store virConnectPtr, - * virDomainPtr and virNetworkPtr. - *------------------------------------------------------------------ - * - * Libvirt does some tricky reference counting to keep track of - * virConnectPtr's, virDomainPtr's and virNetworkPtr's. - * - * There is only one function which can return a virConnectPtr - * (virConnectOpen*) and that allocates a new one each time. - * - * virDomainPtr/virNetworkPtr's on the other hand can be returned - * repeatedly (for the same underlying domain/network), and we must - * keep track of each one and explicitly free it with virDomainFree - * or virNetworkFree. If we lose track of one then the reference - * counting in libvirt will keep it open. We therefore wrap these - * in a custom block with a finalizer function. - * - * We also have to allow the user to explicitly free them, in - * which case we set the pointer inside the custom block to NULL. - * The finalizer notices this and doesn't free the object. - * - * Domains and networks "belong to" a connection. We have to avoid - * the situation like this: - * - * let conn = Connect.open ... in - * let dom = Domain.lookup_by_id conn 0 in - * (* conn goes out of scope and is garbage collected *) - * printf "dom name = %s\n" (Domain.get_name dom) - * - * The reason is that when conn is garbage collected, virConnectClose - * is called and any subsequent operations on dom will fail (in fact - * will probably segfault). To stop this from happening, the OCaml - * wrappers store domains (and networks) as explicit (dom, conn) - * pairs. - * - * Further complication with virterror / exceptions: Virterror gives - * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we - * follow standard practice and wrap these up in blocks with - * finalizers then we'll end up double-freeing (in particular, calling - * virConnectClose at the wrong time). So for virterror, we have - * "special" wrapper functions (Val_connect_no_finalize, etc.). - */ - -/* Unwrap a custom block. */ -#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))) - -/* 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); - -/* ONLY for use by virterror wrappers. */ -static value Val_connect_no_finalize (virConnectPtr conn); -static value Val_dom_no_finalize (virDomainPtr dom); -static value Val_net_no_finalize (virNetworkPtr net); - -/* 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))) -#define Connect_domv(rv) (Connect_val(Field((rv),1))) -#define Connect_netv(rv) (Connect_val(Field((rv),1))) - -static value Val_domain (virDomainPtr dom, value connv); -static value Val_network (virNetworkPtr net, value connv); - -/* ONLY for use by virterror wrappers. */ -static value Val_domain_no_finalize (virDomainPtr dom, value connv); -static value Val_network_no_finalize (virNetworkPtr net, value connv); - -/*----------------------------------------------------------------------*/ - -/* Connection object. */ - -CAMLprim value -ocaml_libvirt_connect_open (value namev, value unit) -{ - CAMLparam2 (namev, unit); - CAMLlocal1 (rv); - const char *name = Optstring_val (namev); - virConnectPtr conn; - - NONBLOCKING (conn = virConnectOpen (name)); - CHECK_ERROR (!conn, NULL, "virConnectOpen"); - - rv = Val_connect (conn); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_connect_open_readonly (value namev, value unit) -{ - CAMLparam2 (namev, unit); - CAMLlocal1 (rv); - const char *name = Optstring_val (namev); - virConnectPtr conn; - - NONBLOCKING (conn = virConnectOpenReadOnly (name)); - CHECK_ERROR (!conn, NULL, "virConnectOpen"); - - rv = Val_connect (conn); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_connect_close (value connv) -{ - CAMLparam1 (connv); - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectClose (conn)); - CHECK_ERROR (r == -1, conn, "virConnectClose"); - - /* So that we don't double-free in the finalizer: */ - Connect_val (connv) = NULL; - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_connect_get_type (value connv) -{ - CAMLparam1 (connv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - const char *r; - - NONBLOCKING (r = virConnectGetType (conn)); - CHECK_ERROR (!r, conn, "virConnectGetType"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_connect_get_version (value connv) -{ - CAMLparam1 (connv); - virConnectPtr conn = Connect_val (connv); - unsigned long hvVer; - int r; - - NONBLOCKING (r = virConnectGetVersion (conn, &hvVer)); - CHECK_ERROR (r == -1, conn, "virConnectGetVersion"); - - CAMLreturn (Val_int (hvVer)); -} CAMLprim value ocaml_libvirt_connect_get_hostname (value connv) { -#ifdef HAVE_VIRCONNECTGETHOSTNAME CAMLparam1 (connv); +#ifndef HAVE_VIRCONNECTGETHOSTNAME + /* Symbol virConnectGetHostname not found at compile time. */ + not_supported ("virConnectGetHostname"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virConnectGetHostname + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virConnectGetHostname); + CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); char *r; - WEAK_SYMBOL_CHECK (virConnectGetHostname); NONBLOCKING (r = virConnectGetHostname (conn)); CHECK_ERROR (!r, conn, "virConnectGetHostname"); rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#else - not_supported ("virConnectGetHostname"); #endif } +#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) { -#ifdef HAVE_VIRCONNECTGETURI CAMLparam1 (connv); +#ifndef HAVE_VIRCONNECTGETURI + /* Symbol virConnectGetURI not found at compile time. */ + not_supported ("virConnectGetURI"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virConnectGetURI + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virConnectGetURI); + CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); char *r; - WEAK_SYMBOL_CHECK (virConnectGetURI); NONBLOCKING (r = virConnectGetURI (conn)); CHECK_ERROR (!r, conn, "virConnectGetURI"); rv = caml_copy_string (r); free (r); CAMLreturn (rv); -#else - not_supported ("virConnectGetURI"); #endif } CAMLprim value -ocaml_libvirt_connect_get_max_vcpus (value connv, value typev) +ocaml_libvirt_connect_get_type (value connv) { - CAMLparam2 (connv, typev); - virConnectPtr conn = Connect_val (connv); - const char *type = Optstring_val (typev); - int r; - - NONBLOCKING (r = virConnectGetMaxVcpus (conn, type)); - CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus"); - - CAMLreturn (Val_int (r)); -} + CAMLparam1 (connv); -CAMLprim value -ocaml_libvirt_connect_list_domains (value connv, value iv) -{ - CAMLparam2 (connv, iv); CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - int ids[i], r; - - NONBLOCKING (r = virConnectListDomains (conn, ids, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDomains"); + const char *r; - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) - Store_field (rv, i, Val_int (ids[i])); + NONBLOCKING (r = virConnectGetType (conn)); + CHECK_ERROR (!r, conn, "virConnectGetType"); + rv = caml_copy_string (r); CAMLreturn (rv); } @@ -398,6 +132,7 @@ CAMLprim value ocaml_libvirt_connect_num_of_domains (value connv) { CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); int r; @@ -408,18 +143,21 @@ ocaml_libvirt_connect_num_of_domains (value connv) } CAMLprim value -ocaml_libvirt_connect_get_capabilities (value connv) +ocaml_libvirt_connect_list_domains (value connv, value iv) { - CAMLparam1 (connv); + CAMLparam2 (connv, iv); + CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); - char *r; + int i = Int_val (iv); + int ids[i], r; - NONBLOCKING (r = virConnectGetCapabilities (conn)); - CHECK_ERROR (!r, conn, "virConnectGetCapabilities"); + NONBLOCKING (r = virConnectListDomains (conn, ids, i)); + CHECK_ERROR (r == -1, conn, "virConnectListDomains"); - rv = caml_copy_string (r); - free (r); + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) + Store_field (rv, i, Val_int (ids[i])); CAMLreturn (rv); } @@ -428,6 +166,7 @@ CAMLprim value ocaml_libvirt_connect_num_of_defined_domains (value connv) { CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); int r; @@ -441,6 +180,7 @@ CAMLprim value ocaml_libvirt_connect_list_defined_domains (value connv, value iv) { CAMLparam2 (connv, iv); + CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); int i = Int_val (iv); @@ -464,6 +204,7 @@ CAMLprim value ocaml_libvirt_connect_num_of_networks (value connv) { CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); int r; @@ -477,6 +218,7 @@ CAMLprim value ocaml_libvirt_connect_list_networks (value connv, value iv) { CAMLparam2 (connv, iv); + CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); int i = Int_val (iv); @@ -500,6 +242,7 @@ CAMLprim value ocaml_libvirt_connect_num_of_defined_networks (value connv) { CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); int r; @@ -513,6 +256,7 @@ CAMLprim value ocaml_libvirt_connect_list_defined_networks (value connv, value iv) { CAMLparam2 (connv, iv); + CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); int i = Int_val (iv); @@ -532,198 +276,225 @@ ocaml_libvirt_connect_list_defined_networks (value connv, value iv) CAMLreturn (rv); } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS +extern int virConnectNumOfStoragePools (virConnectPtr conn) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_connect_get_node_info (value connv) +ocaml_libvirt_connect_num_of_storage_pools (value connv) { CAMLparam1 (connv); - CAMLlocal2 (rv, v); +#ifndef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS + /* Symbol virConnectNumOfStoragePools not found at compile time. */ + not_supported ("virConnectNumOfStoragePools"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virConnectNumOfStoragePools + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virConnectNumOfStoragePools); + virConnectPtr conn = Connect_val (connv); - virNodeInfo info; int r; - NONBLOCKING (r = virNodeGetInfo (conn, &info)); - CHECK_ERROR (r == -1, conn, "virNodeGetInfo"); - - rv = caml_alloc (8, 0); - v = caml_copy_string (info.model); Store_field (rv, 0, v); - v = caml_copy_int64 (info.memory); Store_field (rv, 1, v); - Store_field (rv, 2, Val_int (info.cpus)); - Store_field (rv, 3, Val_int (info.mhz)); - Store_field (rv, 4, Val_int (info.nodes)); - Store_field (rv, 5, Val_int (info.sockets)); - Store_field (rv, 6, Val_int (info.cores)); - Store_field (rv, 7, Val_int (info.threads)); + NONBLOCKING (r = virConnectNumOfStoragePools (conn)); + CHECK_ERROR (r == -1, conn, "virConnectNumOfStoragePools"); - CAMLreturn (rv); + CAMLreturn (Val_int (r)); +#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"); +#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_node_get_cells_free_memory (value connv, - value startv, value maxv) +ocaml_libvirt_connect_list_storage_pools (value connv, value iv) { -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY - CAMLparam3 (connv, startv, maxv); - CAMLlocal2 (rv, iv); + CAMLparam2 (connv, iv); +#ifndef HAVE_VIRCONNECTLISTSTORAGEPOOLS + /* Symbol virConnectListStoragePools not found at compile time. */ + not_supported ("virConnectListStoragePools"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virConnectListStoragePools + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virConnectListStoragePools); + + CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); - int start = Int_val (startv); - int max = Int_val (maxv); - int r, i; - unsigned long long freemems[max]; + int i = Int_val (iv); + char *names[i]; + int r; - WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory); - NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max)); - CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory"); + NONBLOCKING (r = virConnectListStoragePools (conn, names, i)); + CHECK_ERROR (r == -1, conn, "virConnectListStoragePools"); rv = caml_alloc (r, 0); for (i = 0; i < r; ++i) { - iv = caml_copy_int64 ((int64) freemems[i]); - Store_field (rv, i, iv); + strv = caml_copy_string (names[i]); + Store_field (rv, i, strv); + free (names[i]); } CAMLreturn (rv); -#else - not_supported ("virNodeGetCellsFreeMemory"); #endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS +extern int virConnectNumOfDefinedStoragePools (virConnectPtr conn) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_domain_create_linux (value connv, value xmlv) +ocaml_libvirt_connect_num_of_defined_storage_pools (value connv) { - CAMLparam2 (connv, xmlv); - CAMLlocal1 (rv); + CAMLparam1 (connv); +#ifndef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS + /* Symbol virConnectNumOfDefinedStoragePools not found at compile time. */ + not_supported ("virConnectNumOfDefinedStoragePools"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virConnectNumOfDefinedStoragePools + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virConnectNumOfDefinedStoragePools); + virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virDomainPtr r; + int r; - NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateLinux"); + NONBLOCKING (r = virConnectNumOfDefinedStoragePools (conn)); + CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedStoragePools"); - rv = Val_domain (r, connv); - CAMLreturn (rv); + CAMLreturn (Val_int (r)); +#endif } +#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_domain_lookup_by_id (value connv, value iv) +ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv) { CAMLparam2 (connv, iv); - CAMLlocal1 (rv); +#ifndef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS + /* Symbol virConnectListDefinedStoragePools not found at compile time. */ + not_supported ("virConnectListDefinedStoragePools"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virConnectListDefinedStoragePools + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virConnectListDefinedStoragePools); + + CAMLlocal2 (rv, strv); virConnectPtr conn = Connect_val (connv); int i = Int_val (iv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByID (conn, i)); - CHECK_ERROR (!r, conn, "virDomainLookupByID"); - - rv = Val_domain (r, connv); - CAMLreturn (rv); -} + char *names[i]; + int r; -CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *uuid = String_val (uuidv); - virDomainPtr r; + NONBLOCKING (r = virConnectListDefinedStoragePools (conn, names, i)); + CHECK_ERROR (r == -1, conn, "virConnectListDefinedStoragePools"); - NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) { + strv = caml_copy_string (names[i]); + Store_field (rv, i, strv); + free (names[i]); + } - rv = Val_domain (r, connv); CAMLreturn (rv); +#endif } CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv) +ocaml_libvirt_connect_get_capabilities (value connv) { - CAMLparam2 (connv, uuidv); + CAMLparam1 (connv); + CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); - char *uuid = String_val (uuidv); - virDomainPtr r; + char *r; - NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString"); + NONBLOCKING (r = virConnectGetCapabilities (conn)); + CHECK_ERROR (!r, conn, "virConnectGetCapabilities"); - rv = Val_domain (r, connv); + rv = caml_copy_string (r); + free (r); CAMLreturn (rv); } CAMLprim value -ocaml_libvirt_domain_lookup_by_name (value connv, value namev) +ocaml_libvirt_domain_get_name (value domv) { - CAMLparam2 (connv, namev); + CAMLparam1 (domv); + CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *name = String_val (namev); - virDomainPtr r; + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + const char *r; - NONBLOCKING (r = virDomainLookupByName (conn, name)); - CHECK_ERROR (!r, conn, "virDomainLookupByName"); + NONBLOCKING (r = virDomainGetName (dom)); + CHECK_ERROR (!r, conn, "virDomainGetName"); - rv = Val_domain (r, connv); + rv = caml_copy_string (r); CAMLreturn (rv); } CAMLprim value -ocaml_libvirt_domain_destroy (value domv) +ocaml_libvirt_domain_get_os_type (value domv) { CAMLparam1 (domv); + + CAMLlocal1 (rv); virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainDestroy (dom)); - CHECK_ERROR (r == -1, conn, "virDomainDestroy"); + char *r; - /* So that we don't double-free in the finalizer: */ - Domain_val (domv) = NULL; + NONBLOCKING (r = virDomainGetOSType (dom)); + CHECK_ERROR (!r, conn, "virDomainGetOSType"); - CAMLreturn (Val_unit); + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); } CAMLprim value -ocaml_libvirt_domain_free (value domv) +ocaml_libvirt_domain_get_xml_desc (value domv) { CAMLparam1 (domv); + + CAMLlocal1 (rv); virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainFree (dom)); - CHECK_ERROR (r == -1, conn, "virDomainFree"); + char *r; - /* So that we don't double-free in the finalizer: */ - Domain_val (domv) = NULL; + NONBLOCKING (r = virDomainGetXMLDesc (dom, 0)); + CHECK_ERROR (!r, conn, "virDomainGetXMLDesc"); - CAMLreturn (Val_unit); + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); } CAMLprim value ocaml_libvirt_domain_suspend (value domv) { CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); int r; @@ -738,6 +509,7 @@ CAMLprim value ocaml_libvirt_domain_resume (value domv) { CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); int r; @@ -749,53 +521,10 @@ ocaml_libvirt_domain_resume (value domv) } CAMLprim value -ocaml_libvirt_domain_save (value domv, value pathv) -{ - CAMLparam2 (domv, pathv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - int r; - - NONBLOCKING (r = virDomainSave (dom, path)); - CHECK_ERROR (r == -1, conn, "virDomainSave"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_restore (value connv, value pathv) -{ - CAMLparam2 (connv, pathv); - virConnectPtr conn = Connect_val (connv); - char *path = String_val (pathv); - int r; - - NONBLOCKING (r = virDomainRestore (conn, path)); - CHECK_ERROR (r == -1, conn, "virDomainRestore"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_core_dump (value domv, value pathv) -{ - CAMLparam2 (domv, pathv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - int r; - - NONBLOCKING (r = virDomainCoreDump (dom, path, 0)); - CHECK_ERROR (r == -1, conn, "virDomainCoreDump"); - - CAMLreturn (Val_unit); -} - -CAMLprim value ocaml_libvirt_domain_shutdown (value domv) { CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); int r; @@ -810,6 +539,7 @@ CAMLprim value ocaml_libvirt_domain_reboot (value domv) { CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); int r; @@ -821,84 +551,64 @@ ocaml_libvirt_domain_reboot (value domv) } CAMLprim value -ocaml_libvirt_domain_get_name (value domv) +ocaml_libvirt_domain_undefine (value domv) { CAMLparam1 (domv); - CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); - const char *r; + int r; - NONBLOCKING (r = virDomainGetName (dom)); - CHECK_ERROR (!r, conn, "virDomainGetName"); + NONBLOCKING (r = virDomainUndefine (dom)); + CHECK_ERROR (r == -1, conn, "virDomainUndefine"); - rv = caml_copy_string (r); - CAMLreturn (rv); + CAMLreturn (Val_unit); } CAMLprim value -ocaml_libvirt_domain_get_uuid (value domv) +ocaml_libvirt_domain_create (value domv) { CAMLparam1 (domv); - CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); virConnectPtr conn = Connect_domv (domv); - unsigned char uuid[VIR_UUID_BUFLEN]; int r; - NONBLOCKING (r = virDomainGetUUID (dom, uuid)); - CHECK_ERROR (r == -1, conn, "virDomainGetUUID"); + NONBLOCKING (r = virDomainCreate (dom)); + CHECK_ERROR (r == -1, conn, "virDomainCreate"); - rv = caml_copy_string ((char *) uuid); - CAMLreturn (rv); + CAMLreturn (Val_unit); } CAMLprim value -ocaml_libvirt_domain_get_uuid_string (value domv) +ocaml_libvirt_network_get_name (value netv) { - CAMLparam1 (domv); + CAMLparam1 (netv); + CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + const char *r; - NONBLOCKING (r = virDomainGetUUIDString (dom, uuid)); - CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString"); + NONBLOCKING (r = virNetworkGetName (net)); + CHECK_ERROR (!r, conn, "virNetworkGetName"); - rv = caml_copy_string (uuid); + rv = caml_copy_string (r); CAMLreturn (rv); } CAMLprim value -ocaml_libvirt_domain_get_id (value domv) +ocaml_libvirt_network_get_xml_desc (value netv) { - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned int r; - - NONBLOCKING (r = virDomainGetID (dom)); - /* There's a bug in libvirt which means that if you try to get - * the ID of a defined-but-not-running domain, it returns -1, - * and there's no way to distinguish that from an error. - */ - CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID"); - - CAMLreturn (Val_int ((int) r)); -} + CAMLparam1 (netv); -CAMLprim value -ocaml_libvirt_domain_get_os_type (value domv) -{ - CAMLparam1 (domv); CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); char *r; - NONBLOCKING (r = virDomainGetOSType (dom)); - CHECK_ERROR (!r, conn, "virDomainGetOSType"); + NONBLOCKING (r = virNetworkGetXMLDesc (net, 0)); + CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc"); rv = caml_copy_string (r); free (r); @@ -906,1214 +616,586 @@ ocaml_libvirt_domain_get_os_type (value domv) } CAMLprim value -ocaml_libvirt_domain_get_max_memory (value domv) +ocaml_libvirt_network_get_bridge_name (value netv) { - CAMLparam1 (domv); + CAMLparam1 (netv); + CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned long r; + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + char *r; - NONBLOCKING (r = virDomainGetMaxMemory (dom)); - CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory"); + NONBLOCKING (r = virNetworkGetBridgeName (net)); + CHECK_ERROR (!r, conn, "virNetworkGetBridgeName"); - rv = caml_copy_int64 (r); + rv = caml_copy_string (r); + free (r); CAMLreturn (rv); } CAMLprim value -ocaml_libvirt_domain_set_max_memory (value domv, value memv) +ocaml_libvirt_network_undefine (value netv) { - CAMLparam2 (domv, memv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned long mem = Int64_val (memv); + CAMLparam1 (netv); + + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); int r; - NONBLOCKING (r = virDomainSetMaxMemory (dom, mem)); - CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory"); + NONBLOCKING (r = virNetworkUndefine (net)); + CHECK_ERROR (r == -1, conn, "virNetworkUndefine"); CAMLreturn (Val_unit); } CAMLprim value -ocaml_libvirt_domain_set_memory (value domv, value memv) +ocaml_libvirt_network_create (value netv) { - CAMLparam2 (domv, memv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned long mem = Int64_val (memv); + CAMLparam1 (netv); + + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); int r; - NONBLOCKING (r = virDomainSetMemory (dom, mem)); - CHECK_ERROR (r == -1, conn, "virDomainSetMemory"); + NONBLOCKING (r = virNetworkCreate (net)); + CHECK_ERROR (r == -1, conn, "virNetworkCreate"); CAMLreturn (Val_unit); } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLGETNAME +extern const char *virStoragePoolGetName (virStoragePoolPtr pool) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_domain_get_info (value domv) +ocaml_libvirt_storage_pool_get_name (value poolv) { - CAMLparam1 (domv); - CAMLlocal2 (rv, v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - virDomainInfo info; - int r; + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEPOOLGETNAME + /* Symbol virStoragePoolGetName not found at compile time. */ + not_supported ("virStoragePoolGetName"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolGetName + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolGetName); - NONBLOCKING (r = virDomainGetInfo (dom, &info)); - CHECK_ERROR (r == -1, conn, "virDomainGetInfo"); + CAMLlocal1 (rv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + const char *r; - rv = caml_alloc (5, 0); - Store_field (rv, 0, Val_int (info.state)); // These flags are compatible. - v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v); - v = caml_copy_int64 (info.memory); Store_field (rv, 2, v); - Store_field (rv, 3, Val_int (info.nrVirtCpu)); - v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v); + NONBLOCKING (r = virStoragePoolGetName (pool)); + CHECK_ERROR (!r, conn, "virStoragePoolGetName"); + rv = caml_copy_string (r); CAMLreturn (rv); +#endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLGETXMLDESC +extern char *virStoragePoolGetXMLDesc (virStoragePoolPtr pool, int flags) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_domain_get_xml_desc (value domv) +ocaml_libvirt_storage_pool_get_xml_desc (value poolv) { - CAMLparam1 (domv); + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEPOOLGETXMLDESC + /* Symbol virStoragePoolGetXMLDesc not found at compile time. */ + not_supported ("virStoragePoolGetXMLDesc"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolGetXMLDesc + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolGetXMLDesc); + CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); char *r; - NONBLOCKING (r = virDomainGetXMLDesc (dom, 0)); - CHECK_ERROR (!r, conn, "virDomainGetXMLDesc"); + NONBLOCKING (r = virStoragePoolGetXMLDesc (pool, 0)); + CHECK_ERROR (!r, conn, "virStoragePoolGetXMLDesc"); rv = caml_copy_string (r); free (r); CAMLreturn (rv); +#endif } +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLUNDEFINE +extern char *virStoragePoolUndefine (virStoragePoolPtr pool) __attribute__((weak)); +#endif +#endif + CAMLprim value -ocaml_libvirt_domain_get_scheduler_type (value domv) +ocaml_libvirt_storage_pool_undefine (value poolv) { -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE - CAMLparam1 (domv); - CAMLlocal2 (rv, strv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEPOOLUNDEFINE + /* Symbol virStoragePoolUndefine not found at compile time. */ + not_supported ("virStoragePoolUndefine"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolUndefine + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolUndefine); + + CAMLlocal1 (rv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); char *r; - int nparams; - WEAK_SYMBOL_CHECK (virDomainGetSchedulerType); - NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams)); - CHECK_ERROR (!r, conn, "virDomainGetSchedulerType"); + NONBLOCKING (r = virStoragePoolUndefine (pool)); + CHECK_ERROR (!r, conn, "virStoragePoolUndefine"); - rv = caml_alloc_tuple (2); - strv = caml_copy_string (r); Store_field (rv, 0, strv); + rv = caml_copy_string (r); free (r); - Store_field (rv, 1, nparams); CAMLreturn (rv); -#else - not_supported ("virDomainGetSchedulerType"); #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); - virConnectPtr conn = Connect_domv (domv); - int nparams = Int_val (nparamsv); - virSchedParameter params[nparams]; - int r, i; - - WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters); - NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams)); - CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters"); - - rv = caml_alloc (nparams, 0); - for (i = 0; i < nparams; ++i) { - v = caml_alloc_tuple (2); Store_field (rv, i, v); - v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2); - switch (params[i].type) { - case VIR_DOMAIN_SCHED_FIELD_INT: - v2 = caml_alloc (1, 0); - v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_UINT: - v2 = caml_alloc (1, 1); - v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_LLONG: - v2 = caml_alloc (1, 2); - v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_ULLONG: - v2 = caml_alloc (1, 3); - v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_DOUBLE: - v2 = caml_alloc (1, 4); - v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_BOOLEAN: - v2 = caml_alloc (1, 5); - Store_field (v2, 0, Val_int (params[i].value.b)); - break; - default: - caml_failwith ((char *)__FUNCTION__); - } - Store_field (v, 1, v2); - } - CAMLreturn (rv); -#else - not_supported ("virDomainGetSchedulerParameters"); +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLCREATE +extern char *virStoragePoolCreate (virStoragePoolPtr pool) __attribute__((weak)); +#endif #endif -} CAMLprim value -ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) +ocaml_libvirt_storage_pool_create (value poolv) { -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS - CAMLparam2 (domv, paramsv); - CAMLlocal1 (v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int nparams = Wosize_val (paramsv); - virSchedParameter params[nparams]; - int r, i; - char *name; - - for (i = 0; i < nparams; ++i) { - v = Field (paramsv, i); /* Points to the two-element tuple. */ - name = String_val (Field (v, 0)); - strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH); - params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0'; - v = Field (v, 1); /* Points to the sched_param_value block. */ - switch (Tag_val (v)) { - case 0: - params[i].type = VIR_DOMAIN_SCHED_FIELD_INT; - params[i].value.i = Int32_val (Field (v, 0)); - break; - case 1: - params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT; - params[i].value.ui = Int32_val (Field (v, 0)); - break; - case 2: - params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG; - params[i].value.l = Int64_val (Field (v, 0)); - break; - case 3: - params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG; - params[i].value.ul = Int64_val (Field (v, 0)); - break; - case 4: - params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE; - params[i].value.d = Double_val (Field (v, 0)); - break; - case 5: - params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN; - params[i].value.b = Int_val (Field (v, 0)); - break; - default: - caml_failwith ((char *)__FUNCTION__); - } - } - - WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters); - NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams)); - CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters"); - - CAMLreturn (Val_unit); + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEPOOLCREATE + /* Symbol virStoragePoolCreate not found at compile time. */ + not_supported ("virStoragePoolCreate"); + /* Suppresses a compiler warning. */ + (void) caml__frame; #else - not_supported ("virDomainSetSchedulerParameters"); -#endif -} + /* Check that the symbol virStoragePoolCreate + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolCreate); -CAMLprim value -ocaml_libvirt_domain_define_xml (value connv, value xmlv) -{ - CAMLparam2 (connv, xmlv); CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virDomainPtr r; + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + char *r; - NONBLOCKING (r = virDomainDefineXML (conn, xml)); - CHECK_ERROR (!r, conn, "virDomainDefineXML"); + NONBLOCKING (r = virStoragePoolCreate (pool)); + CHECK_ERROR (!r, conn, "virStoragePoolCreate"); - rv = Val_domain (r, connv); + rv = caml_copy_string (r); + free (r); CAMLreturn (rv); +#endif } -CAMLprim value -ocaml_libvirt_domain_undefine (value domv) -{ - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainUndefine (dom)); - CHECK_ERROR (r == -1, conn, "virDomainUndefine"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_create (value domv) -{ - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainCreate (dom)); - CHECK_ERROR (r == -1, conn, "virDomainCreate"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_get_autostart (value domv) -{ - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, autostart; - - NONBLOCKING (r = virDomainGetAutostart (dom, &autostart)); - CHECK_ERROR (r == -1, conn, "virDomainGetAutostart"); - - CAMLreturn (autostart ? Val_true : Val_false); -} +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLSHUTDOWN +extern char *virStoragePoolShutdown (virStoragePoolPtr pool) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_domain_set_autostart (value domv, value autostartv) +ocaml_libvirt_storage_pool_shutdown (value poolv) { - CAMLparam2 (domv, autostartv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, autostart = autostartv == Val_true ? 1 : 0; - - NONBLOCKING (r = virDomainSetAutostart (dom, autostart)); - CHECK_ERROR (r == -1, conn, "virDomainSetAutostart"); - - CAMLreturn (Val_unit); -} + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEPOOLSHUTDOWN + /* Symbol virStoragePoolShutdown not found at compile time. */ + not_supported ("virStoragePoolShutdown"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolShutdown + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolShutdown); -CAMLprim value -ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv) -{ - CAMLparam2 (domv, nvcpusv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, nvcpus = Int_val (nvcpusv); + CAMLlocal1 (rv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + char *r; - NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus)); - CHECK_ERROR (r == -1, conn, "virDomainSetVcpus"); + NONBLOCKING (r = virStoragePoolShutdown (pool)); + CHECK_ERROR (!r, conn, "virStoragePoolShutdown"); - CAMLreturn (Val_unit); + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +#endif } -CAMLprim value -ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv) -{ - CAMLparam3 (domv, vcpuv, cpumapv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int maplen = caml_string_length (cpumapv); - unsigned char *cpumap = (unsigned char *) String_val (cpumapv); - int vcpu = Int_val (vcpuv); - int r; - - NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen)); - CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); - - CAMLreturn (Val_unit); -} +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEPOOLREFRESH +extern char *virStoragePoolRefresh (virStoragePoolPtr pool, int flags) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) +ocaml_libvirt_storage_pool_refresh (value poolv) { - CAMLparam3 (domv, maxinfov, maplenv); - CAMLlocal5 (rv, infov, strv, v, v2); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int maxinfo = Int_val (maxinfov); - int maplen = Int_val (maplenv); - virVcpuInfo info[maxinfo]; - unsigned char cpumaps[maxinfo * maplen]; - int r, i; - - memset (info, 0, sizeof (virVcpuInfo) * maxinfo); - memset (cpumaps, 0, maxinfo * maplen); - - NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen)); - CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); - - /* Copy the virVcpuInfo structures. */ - infov = caml_alloc (maxinfo, 0); - for (i = 0; i < maxinfo; ++i) { - v2 = caml_alloc (4, 0); Store_field (infov, i, v2); - Store_field (v2, 0, Val_int (info[i].number)); - Store_field (v2, 1, Val_int (info[i].state)); - v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v); - Store_field (v2, 3, Val_int (info[i].cpu)); - } + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEPOOLREFRESH + /* Symbol virStoragePoolRefresh not found at compile time. */ + not_supported ("virStoragePoolRefresh"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStoragePoolRefresh + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStoragePoolRefresh); - /* Copy the bitmap. */ - strv = caml_alloc_string (maxinfo * maplen); - memcpy (String_val (strv), cpumaps, maxinfo * maplen); + CAMLlocal1 (rv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + char *r; - /* Allocate the tuple and return it. */ - rv = caml_alloc_tuple (3); - Store_field (rv, 0, Val_int (r)); /* number of CPUs. */ - Store_field (rv, 1, infov); - Store_field (rv, 2, strv); + NONBLOCKING (r = virStoragePoolRefresh (pool, 0)); + CHECK_ERROR (!r, conn, "virStoragePoolRefresh"); + rv = caml_copy_string (r); + free (r); CAMLreturn (rv); +#endif } -CAMLprim value -ocaml_libvirt_domain_get_max_vcpus (value domv) -{ - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainGetMaxVcpus (dom)); - CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus"); - - CAMLreturn (Val_int (r)); -} - -CAMLprim value -ocaml_libvirt_domain_attach_device (value domv, value xmlv) -{ - CAMLparam2 (domv, xmlv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *xml = String_val (xmlv); - int r; - - NONBLOCKING (r = virDomainAttachDevice (dom, xml)); - CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); - - CAMLreturn (Val_unit); -} +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEVOLGETXMLDESC +extern char *virStorageVolGetXMLDesc (virStoragePoolPtr pool, int flags) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_domain_detach_device (value domv, value xmlv) +ocaml_libvirt_storage_vol_get_xml_desc (value poolv) { - CAMLparam2 (domv, xmlv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *xml = String_val (xmlv); - int r; + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEVOLGETXMLDESC + /* Symbol virStorageVolGetXMLDesc not found at compile time. */ + not_supported ("virStorageVolGetXMLDesc"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStorageVolGetXMLDesc + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStorageVolGetXMLDesc); - NONBLOCKING (r = virDomainDetachDevice (dom, xml)); - CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); + CAMLlocal1 (rv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + char *r; - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) -{ -#ifdef HAVE_VIRDOMAINMIGRATE - CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv); - CAMLxparam2 (optbandwidthv, unitv); - CAMLlocal2 (flagv, rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - virConnectPtr dconn = Connect_val (dconnv); - int flags = 0; - const char *dname = Optstring_val (optdnamev); - const char *uri = Optstring_val (opturiv); - unsigned long bandwidth; - virDomainPtr r; - - /* Iterate over the list of flags. */ - for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) - { - flagv = Field (flagsv, 0); - if (flagv == Int_val(0)) - flags |= VIR_MIGRATE_LIVE; - } - - if (optbandwidthv == Val_int (0)) /* None */ - bandwidth = 0; - 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); + NONBLOCKING (r = virStorageVolGetXMLDesc (pool, 0)); + CHECK_ERROR (!r, conn, "virStorageVolGetXMLDesc"); + rv = caml_copy_string (r); + free (r); CAMLreturn (rv); - -#else /* virDomainMigrate not supported */ - not_supported ("virDomainMigrate"); #endif } -CAMLprim value -ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn) -{ - return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5], - argv[6]); -} +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEVOLGETPATH +extern char *virStorageVolGetPath (virStoragePoolPtr pool) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_domain_block_stats (value domv, value pathv) +ocaml_libvirt_storage_vol_get_path (value poolv) { -#if HAVE_VIRDOMAINBLOCKSTATS - CAMLparam2 (domv, pathv); - CAMLlocal2 (rv,v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - struct _virDomainBlockStats stats; - int r; + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEVOLGETPATH + /* Symbol virStorageVolGetPath not found at compile time. */ + not_supported ("virStorageVolGetPath"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStorageVolGetPath + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStorageVolGetPath); - WEAK_SYMBOL_CHECK (virDomainBlockStats); - NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats)); - CHECK_ERROR (r == -1, conn, "virDomainBlockStats"); + CAMLlocal1 (rv); + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + char *r; - rv = caml_alloc (5, 0); - v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v); - v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v); - v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v); - v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v); - v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v); + NONBLOCKING (r = virStorageVolGetPath (pool)); + CHECK_ERROR (!r, conn, "virStorageVolGetPath"); + rv = caml_copy_string (r); + free (r); CAMLreturn (rv); -#else - not_supported ("virDomainBlockStats"); #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); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - struct _virDomainInterfaceStats stats; - int r; - - WEAK_SYMBOL_CHECK (virDomainInterfaceStats); - NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats)); - CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats"); - - rv = caml_alloc (8, 0); - v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v); - v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v); - v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v); - v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v); - v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v); - v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v); - v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v); - v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v); - - CAMLreturn (rv); -#else - not_supported ("virDomainInterfaceStats"); +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEVOLGETKEY +extern const char *virStorageVolGetKey (virStoragePoolPtr pool) __attribute__((weak)); +#endif #endif -} CAMLprim value -ocaml_libvirt_network_lookup_by_name (value connv, value namev) +ocaml_libvirt_storage_vol_get_key (value poolv) { - CAMLparam2 (connv, namev); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *name = String_val (namev); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByName (conn, name)); - CHECK_ERROR (!r, conn, "virNetworkLookupByName"); - - rv = Val_network (r, connv); - CAMLreturn (rv); -} + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEVOLGETKEY + /* Symbol virStorageVolGetKey not found at compile time. */ + not_supported ("virStorageVolGetKey"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStorageVolGetKey + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStorageVolGetKey); -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *uuid = String_val (uuidv); - virNetworkPtr r; + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + const char *r; - NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); + NONBLOCKING (r = virStorageVolGetKey (pool)); + CHECK_ERROR (!r, conn, "virStorageVolGetKey"); - rv = Val_network (r, connv); + rv = caml_copy_string (r); CAMLreturn (rv); +#endif } -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *uuid = String_val (uuidv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString"); - - rv = Val_network (r, connv); - CAMLreturn (rv); -} +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRSTORAGEVOLGETNAME +extern const char *virStorageVolGetName (virStoragePoolPtr pool) __attribute__((weak)); +#endif +#endif CAMLprim value -ocaml_libvirt_network_create_xml (value connv, value xmlv) +ocaml_libvirt_storage_vol_get_name (value poolv) { - CAMLparam2 (connv, xmlv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkCreateXML (conn, xml)); - CHECK_ERROR (!r, conn, "virNetworkCreateXML"); - - rv = Val_network (r, connv); - CAMLreturn (rv); -} + CAMLparam1 (poolv); +#ifndef HAVE_VIRSTORAGEVOLGETNAME + /* Symbol virStorageVolGetName not found at compile time. */ + not_supported ("virStorageVolGetName"); + /* Suppresses a compiler warning. */ + (void) caml__frame; +#else + /* Check that the symbol virStorageVolGetName + * is in runtime version of libvirt. + */ + WEAK_SYMBOL_CHECK (virStorageVolGetName); -CAMLprim value -ocaml_libvirt_network_define_xml (value connv, value xmlv) -{ - CAMLparam2 (connv, xmlv); CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *xml = String_val (xmlv); - virNetworkPtr r; + virStoragePoolPtr pool = Pool_val (poolv); + virConnectPtr conn = Connect_polv (poolv); + const char *r; - NONBLOCKING (r = virNetworkDefineXML (conn, xml)); - CHECK_ERROR (!r, conn, "virNetworkDefineXML"); + NONBLOCKING (r = virStorageVolGetName (pool)); + CHECK_ERROR (!r, conn, "virStorageVolGetName"); - rv = Val_network (r, connv); + rv = caml_copy_string (r); CAMLreturn (rv); +#endif } CAMLprim value -ocaml_libvirt_network_undefine (value netv) +ocaml_libvirt_domain_create_job () { - CAMLparam1 (netv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkUndefine (net)); - CHECK_ERROR (r == -1, conn, "virNetworkUndefine"); - - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_domain_create_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_create (value netv) +ocaml_libvirt_domain_core_dump_job () { - CAMLparam1 (netv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkCreate (net)); - CHECK_ERROR (r == -1, conn, "virNetworkCreate"); - - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_domain_core_dump_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_destroy (value netv) +ocaml_libvirt_domain_restore_job () { - CAMLparam1 (netv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkDestroy (net)); - CHECK_ERROR (r == -1, conn, "virNetworkDestroy"); - - /* So that we don't double-free in the finalizer: */ - Network_val (netv) = NULL; - - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_domain_restore_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_free (value netv) +ocaml_libvirt_domain_save_job () { - CAMLparam1 (netv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkFree (net)); - CHECK_ERROR (r == -1, conn, "virNetworkFree"); - - /* So that we don't double-free in the finalizer: */ - Network_val (netv) = NULL; - - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_domain_save_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_get_name (value netv) +ocaml_libvirt_connect_create_linux_job () { - CAMLparam1 (netv); - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - const char *r; - - NONBLOCKING (r = virNetworkGetName (net)); - CHECK_ERROR (!r, conn, "virNetworkGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); + failwith ("ocaml_libvirt_connect_create_linux_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_get_uuid (value netv) +ocaml_libvirt_network_create_job () { - CAMLparam1 (netv); - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = virNetworkGetUUID (net, uuid)); - CHECK_ERROR (r == -1, conn, "virNetworkGetUUID"); - - rv = caml_copy_string ((char *) uuid); - CAMLreturn (rv); + failwith ("ocaml_libvirt_network_create_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_get_uuid_string (value netv) +ocaml_libvirt_network_create_xml_job () { - CAMLparam1 (netv); - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = virNetworkGetUUIDString (net, uuid)); - CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); + failwith ("ocaml_libvirt_network_create_xml_job is unimplemented"); } CAMLprim value -ocaml_libvirt_network_get_xml_desc (value netv) +ocaml_libvirt_storage_pool_set_autostart () { - CAMLparam1 (netv); - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - char *r; - - NONBLOCKING (r = virNetworkGetXMLDesc (net, 0)); - CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_pool_set_autostart is unimplemented"); } CAMLprim value -ocaml_libvirt_network_get_bridge_name (value netv) +ocaml_libvirt_storage_pool_get_autostart () { - CAMLparam1 (netv); - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - char *r; - - NONBLOCKING (r = virNetworkGetBridgeName (net)); - CHECK_ERROR (!r, conn, "virNetworkGetBridgeName"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_pool_get_autostart is unimplemented"); } CAMLprim value -ocaml_libvirt_network_get_autostart (value netv) +ocaml_libvirt_storage_pool_get_info () { - CAMLparam1 (netv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r, autostart; - - NONBLOCKING (r = virNetworkGetAutostart (net, &autostart)); - CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart"); - - CAMLreturn (autostart ? Val_true : Val_false); + failwith ("ocaml_libvirt_storage_pool_get_info is unimplemented"); } CAMLprim value -ocaml_libvirt_network_set_autostart (value netv, value autostartv) +ocaml_libvirt_storage_pool_get_uuid_string () { - CAMLparam2 (netv, autostartv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r, autostart = autostartv == Val_true ? 1 : 0; - - NONBLOCKING (r = virNetworkSetAutostart (net, autostart)); - CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart"); - - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_storage_pool_get_uuid_string is unimplemented"); } -/*----------------------------------------------------------------------*/ - CAMLprim value -ocaml_libvirt_virterror_get_last_error (value unitv) +ocaml_libvirt_storage_pool_get_uuid () { - CAMLparam1 (unitv); - CAMLlocal1 (rv); - virErrorPtr err = virGetLastError (); - - rv = Val_opt (err, (Val_ptr_t) Val_virterror); - - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_pool_get_uuid is unimplemented"); } CAMLprim value -ocaml_libvirt_virterror_get_last_conn_error (value connv) +ocaml_libvirt_storage_pool_free () { - CAMLparam1 (connv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - - rv = Val_opt (conn, (Val_ptr_t) Val_connect); - - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_pool_free is unimplemented"); } CAMLprim value -ocaml_libvirt_virterror_reset_last_error (value unitv) +ocaml_libvirt_storage_pool_destroy () { - CAMLparam1 (unitv); - virResetLastError (); - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_storage_pool_destroy is unimplemented"); } CAMLprim value -ocaml_libvirt_virterror_reset_last_conn_error (value connv) +ocaml_libvirt_storage_pool_define_xml () { - CAMLparam1 (connv); - virConnectPtr conn = Connect_val (connv); - virConnResetLastError (conn); - CAMLreturn (Val_unit); + failwith ("ocaml_libvirt_storage_pool_define_xml is unimplemented"); } -/*----------------------------------------------------------------------*/ - -/* Initialise the library. */ CAMLprim value -ocaml_libvirt_init (value unit) -{ - CAMLparam1 (unit); - CAMLlocal1 (rv); - int r; - - r = virInitialize (); - CHECK_ERROR (r == -1, NULL, "virInitialize"); - - CAMLreturn (Val_unit); -} - -/*----------------------------------------------------------------------*/ - -static char * -Optstring_val (value strv) +ocaml_libvirt_storage_pool_create_xml () { - if (strv == Val_int (0)) /* None */ - return NULL; - else /* Some string */ - return String_val (Field (strv, 0)); + failwith ("ocaml_libvirt_storage_pool_create_xml is unimplemented"); } -static value -Val_opt (void *ptr, Val_ptr_t Val_ptr) +CAMLprim value +ocaml_libvirt_storage_pool_lookup_by_uuid_string () { - CAMLparam0 (); - CAMLlocal2 (optv, ptrv); - - if (ptr) { /* Some ptr */ - optv = caml_alloc (1, 0); - ptrv = Val_ptr (ptr); - Store_field (optv, 0, ptrv); - } else /* None */ - optv = Val_int (0); - - CAMLreturn (optv); + failwith ("ocaml_libvirt_storage_pool_lookup_by_uuid_string is unimplemented"); } -#if 0 -static value -option_default (value option, value deflt) +CAMLprim value +ocaml_libvirt_storage_pool_lookup_by_uuid () { - if (option == Val_int (0)) /* "None" */ - return deflt; - else /* "Some 'a" */ - return Field (option, 0); + failwith ("ocaml_libvirt_storage_pool_lookup_by_uuid is unimplemented"); } -#endif -static void -_raise_virterror (virConnectPtr conn, const char *fn) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - virErrorPtr errp; - struct _virError err; - - errp = conn ? virConnGetLastError (conn) : virGetLastError (); - - if (!errp) { - /* Fake a _virError structure. */ - memset (&err, 0, sizeof err); - err.code = VIR_ERR_INTERNAL_ERROR; - err.domain = VIR_FROM_NONE; - err.level = VIR_ERR_ERROR; - err.message = (char *) fn; - errp = &err; - } - - rv = Val_virterror (errp); - caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv); - - /*NOTREACHED*/ - CAMLreturn0; -} - -/* Raise an error if a function is not supported. */ -static void -not_supported (const char *fn) +CAMLprim value +ocaml_libvirt_storage_pool_lookup_by_name () { - CAMLparam0 (); - CAMLlocal1 (fnv); - - fnv = caml_copy_string (fn); - caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv); - - /*NOTREACHED*/ - CAMLreturn0; + failwith ("ocaml_libvirt_storage_pool_lookup_by_name is unimplemented"); } -/* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums - * into values (longs because they are variants in OCaml). - * - * The enum values are part of the libvirt ABI so they cannot change, - * which means that we can convert these numbers directly into - * OCaml variants (which use the same ordering) very fast. - * - * The tricky part here is when we are linked to a newer version of - * libvirt than the one we were compiled against. If the newer libvirt - * generates an error code which we don't know about then we need - * to convert it into VIR_*_UNKNOWN (code). - */ - -#define MAX_VIR_CODE 44 /* VIR_ERR_INVALID_MAC */ -#define MAX_VIR_DOMAIN 16 /* VIR_FROM_STATS_LINUX */ -#define MAX_VIR_LEVEL VIR_ERR_ERROR - -static inline value -Val_err_number (virErrorNumber code) +CAMLprim value +ocaml_libvirt_storage_vol_free () { - CAMLparam0 (); - CAMLlocal1 (rv); - - if (0 <= code && code <= MAX_VIR_CODE) - rv = Val_int (code); - else { - rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */ - Store_field (rv, 0, Val_int (code)); - } - - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_free is unimplemented"); } -static inline value -Val_err_domain (virErrorDomain code) +CAMLprim value +ocaml_libvirt_storage_vol_destroy () { - CAMLparam0 (); - CAMLlocal1 (rv); - - if (0 <= code && code <= MAX_VIR_DOMAIN) - rv = Val_int (code); - else { - rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */ - Store_field (rv, 0, Val_int (code)); - } - - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_destroy is unimplemented"); } -static inline value -Val_err_level (virErrorLevel code) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - - if (0 <= code && code <= MAX_VIR_LEVEL) - rv = Val_int (code); - else { - rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */ - Store_field (rv, 0, Val_int (code)); - } - - CAMLreturn (rv); -} - -/* Convert a virterror to a value. */ -static value -Val_virterror (virErrorPtr err) -{ - CAMLparam0 (); - CAMLlocal3 (rv, connv, optv); - - rv = caml_alloc (12, 0); - Store_field (rv, 0, Val_err_number (err->code)); - Store_field (rv, 1, Val_err_domain (err->domain)); - Store_field (rv, 2, - Val_opt (err->message, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 3, Val_err_level (err->level)); - - /* conn, dom and net fields, all optional */ - if (err->conn) { - connv = Val_connect_no_finalize (err->conn); - optv = caml_alloc (1, 0); - Store_field (optv, 0, connv); - Store_field (rv, 4, optv); /* Some conn */ - - if (err->dom) { - optv = caml_alloc (1, 0); - Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv)); - Store_field (rv, 5, optv); /* Some (dom, conn) */ - } - else - Store_field (rv, 5, Val_int (0)); /* None */ - if (err->net) { - optv = caml_alloc (1, 0); - Store_field (optv, 0, Val_network_no_finalize (err->net, connv)); - Store_field (rv, 11, optv); /* Some (net, conn) */ - } else - Store_field (rv, 11, Val_int (0)); /* None */ - } else { - Store_field (rv, 4, Val_int (0)); /* None */ - Store_field (rv, 5, Val_int (0)); /* None */ - Store_field (rv, 11, Val_int (0)); /* None */ - } - - Store_field (rv, 6, - Val_opt (err->str1, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 7, - Val_opt (err->str2, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 8, - Val_opt (err->str3, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 9, caml_copy_int32 (err->int1)); - Store_field (rv, 10, caml_copy_int32 (err->int2)); - - CAMLreturn (rv); -} - -static void conn_finalize (value); -static void dom_finalize (value); -static void net_finalize (value); - -static struct custom_operations conn_custom_operations = { - "conn_custom_operations", - conn_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -static struct custom_operations dom_custom_operations = { - "dom_custom_operations", - dom_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default - -}; - -static struct custom_operations net_custom_operations = { - "net_custom_operations", - net_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -static value -Val_connect (virConnectPtr conn) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&conn_custom_operations, - sizeof (virConnectPtr), 0, 1); - Connect_val (rv) = conn; - CAMLreturn (rv); -} - -/* This wraps up the raw domain handle (Domain.dom). */ -static value -Val_dom (virDomainPtr dom) +CAMLprim value +ocaml_libvirt_storage_vol_create_xml () { - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&dom_custom_operations, - sizeof (virDomainPtr), 0, 1); - Dom_val (rv) = dom; - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_create_xml is unimplemented"); } -/* This wraps up the raw network handle (Network.net). */ -static value -Val_net (virNetworkPtr net) +CAMLprim value +ocaml_libvirt_storage_vol_get_info () { - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&net_custom_operations, - sizeof (virNetworkPtr), 0, 1); - Net_val (rv) = net; - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_get_info is unimplemented"); } -/* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use - * by virterror wrappers. - */ -static value -Val_connect_no_finalize (virConnectPtr conn) +CAMLprim value +ocaml_libvirt_pool_of_volume () { - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc (1, Abstract_tag); - Store_field (rv, 0, (value) conn); - CAMLreturn (rv); + failwith ("ocaml_libvirt_pool_of_volume is unimplemented"); } -static value -Val_dom_no_finalize (virDomainPtr dom) +CAMLprim value +ocaml_libvirt_storage_vol_lookup_by_path () { - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc (1, Abstract_tag); - Store_field (rv, 0, (value) dom); - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_lookup_by_path is unimplemented"); } -static value -Val_net_no_finalize (virNetworkPtr net) +CAMLprim value +ocaml_libvirt_storage_vol_lookup_by_key () { - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc (1, Abstract_tag); - Store_field (rv, 0, (value) net); - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_lookup_by_key is unimplemented"); } -/* This wraps up the (dom, conn) pair (Domain.t). */ -static value -Val_domain (virDomainPtr dom, value connv) +CAMLprim value +ocaml_libvirt_storage_vol_lookup_by_name () { - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_dom (dom); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); + failwith ("ocaml_libvirt_storage_vol_lookup_by_name is unimplemented"); } -/* This wraps up the (net, conn) pair (Network.t). */ -static value -Val_network (virNetworkPtr net, value connv) +CAMLprim value +ocaml_libvirt_job_cancel () { - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_net (net); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); + failwith ("ocaml_libvirt_job_cancel is unimplemented"); } -/* No-finalize versions of Val_domain, Val_network ONLY for use by - * virterror wrappers. - */ -static value -Val_domain_no_finalize (virDomainPtr dom, value connv) +CAMLprim value +ocaml_libvirt_job_get_network () { - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_dom_no_finalize (dom); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); + failwith ("ocaml_libvirt_job_get_network is unimplemented"); } -static value -Val_network_no_finalize (virNetworkPtr net, value connv) +CAMLprim value +ocaml_libvirt_job_get_domain () { - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_net_no_finalize (net); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); + failwith ("ocaml_libvirt_job_get_domain is unimplemented"); } -static void -conn_finalize (value connv) +CAMLprim value +ocaml_libvirt_job_get_info () { - virConnectPtr conn = Connect_val (connv); - if (conn) (void) virConnectClose (conn); + failwith ("ocaml_libvirt_job_get_info is unimplemented"); } -static void -dom_finalize (value domv) -{ - virDomainPtr dom = Dom_val (domv); - if (dom) (void) virDomainFree (dom); -} +#include "libvirt_c_epilogue.c" -static void -net_finalize (value netv) -{ - virNetworkPtr net = Net_val (netv); - if (net) (void) virNetworkFree (net); -} +/* EOF */ diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c new file mode 100644 index 0000000..fff76f9 --- /dev/null +++ b/libvirt/libvirt_c_epilogue.c @@ -0,0 +1,496 @@ +/* OCaml bindings for libvirt. + * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + * http://libvirt.org/ + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +/* Please read libvirt/README file. */ + +static char * +Optstring_val (value strv) +{ + if (strv == Val_int (0)) /* None */ + return NULL; + else /* Some string */ + return String_val (Field (strv, 0)); +} + +static value +Val_opt (void *ptr, Val_ptr_t Val_ptr) +{ + CAMLparam0 (); + CAMLlocal2 (optv, ptrv); + + if (ptr) { /* Some ptr */ + optv = caml_alloc (1, 0); + ptrv = Val_ptr (ptr); + Store_field (optv, 0, ptrv); + } else /* None */ + optv = Val_int (0); + + CAMLreturn (optv); +} + +#if 0 +static value +option_default (value option, value deflt) +{ + if (option == Val_int (0)) /* "None" */ + return deflt; + else /* "Some 'a" */ + return Field (option, 0); +} +#endif + +static void +_raise_virterror (virConnectPtr conn, const char *fn) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + virErrorPtr errp; + struct _virError err; + + errp = conn ? virConnGetLastError (conn) : virGetLastError (); + + if (!errp) { + /* Fake a _virError structure. */ + memset (&err, 0, sizeof err); + err.code = VIR_ERR_INTERNAL_ERROR; + err.domain = VIR_FROM_NONE; + err.level = VIR_ERR_ERROR; + err.message = (char *) fn; + errp = &err; + } + + rv = Val_virterror (errp); + caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv); + + /*NOTREACHED*/ + /* Suppresses a compiler warning. */ + (void) caml__frame; +} + +/* Raise an error if a function is not supported. */ +static void +not_supported (const char *fn) +{ + CAMLparam0 (); + CAMLlocal1 (fnv); + + fnv = caml_copy_string (fn); + caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv); + + /*NOTREACHED*/ + /* Suppresses a compiler warning. */ + (void) caml__frame; +} + +/* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums + * into values (longs because they are variants in OCaml). + * + * The enum values are part of the libvirt ABI so they cannot change, + * which means that we can convert these numbers directly into + * OCaml variants (which use the same ordering) very fast. + * + * The tricky part here is when we are linked to a newer version of + * libvirt than the one we were compiled against. If the newer libvirt + * generates an error code which we don't know about then we need + * to convert it into VIR_*_UNKNOWN (code). + */ + +#define MAX_VIR_CODE 44 /* VIR_ERR_INVALID_MAC */ +#define MAX_VIR_DOMAIN 16 /* VIR_FROM_STATS_LINUX */ +#define MAX_VIR_LEVEL VIR_ERR_ERROR + +static inline value +Val_err_number (virErrorNumber code) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + + if (0 <= code && code <= MAX_VIR_CODE) + rv = Val_int (code); + else { + rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */ + Store_field (rv, 0, Val_int (code)); + } + + CAMLreturn (rv); +} + +static inline value +Val_err_domain (virErrorDomain code) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + + if (0 <= code && code <= MAX_VIR_DOMAIN) + rv = Val_int (code); + else { + rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */ + Store_field (rv, 0, Val_int (code)); + } + + CAMLreturn (rv); +} + +static inline value +Val_err_level (virErrorLevel code) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + + if (0 <= code && code <= MAX_VIR_LEVEL) + rv = Val_int (code); + else { + rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */ + Store_field (rv, 0, Val_int (code)); + } + + CAMLreturn (rv); +} + +/* Convert a virterror to a value. */ +static value +Val_virterror (virErrorPtr err) +{ + CAMLparam0 (); + CAMLlocal3 (rv, connv, optv); + + rv = caml_alloc (12, 0); + Store_field (rv, 0, Val_err_number (err->code)); + Store_field (rv, 1, Val_err_domain (err->domain)); + Store_field (rv, 2, + Val_opt (err->message, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 3, Val_err_level (err->level)); + + /* conn, dom and net fields, all optional */ + if (err->conn) { + connv = Val_connect_no_finalize (err->conn); + optv = caml_alloc (1, 0); + Store_field (optv, 0, connv); + Store_field (rv, 4, optv); /* Some conn */ + + if (err->dom) { + optv = caml_alloc (1, 0); + Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv)); + Store_field (rv, 5, optv); /* Some (dom, conn) */ + } + else + Store_field (rv, 5, Val_int (0)); /* None */ + if (err->net) { + optv = caml_alloc (1, 0); + Store_field (optv, 0, Val_network_no_finalize (err->net, connv)); + Store_field (rv, 11, optv); /* Some (net, conn) */ + } else + Store_field (rv, 11, Val_int (0)); /* None */ + } else { + Store_field (rv, 4, Val_int (0)); /* None */ + Store_field (rv, 5, Val_int (0)); /* None */ + Store_field (rv, 11, Val_int (0)); /* None */ + } + + Store_field (rv, 6, + Val_opt (err->str1, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 7, + Val_opt (err->str2, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 8, + Val_opt (err->str3, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 9, caml_copy_int32 (err->int1)); + Store_field (rv, 10, caml_copy_int32 (err->int2)); + + CAMLreturn (rv); +} + +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", + conn_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +static struct custom_operations dom_custom_operations = { + "dom_custom_operations", + dom_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default + +}; + +static struct custom_operations net_custom_operations = { + "net_custom_operations", + net_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +#ifdef HAVE_VIRSTORAGEPOOLPTR +static struct custom_operations pol_custom_operations = { + "pol_custom_operations", + pol_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; +#endif + +#ifdef HAVE_VIRSTORAGEVOLPTR +static struct custom_operations vol_custom_operations = { + "vol_custom_operations", + vol_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; +#endif + +static value +Val_connect (virConnectPtr conn) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&conn_custom_operations, + sizeof (virConnectPtr), 0, 1); + Connect_val (rv) = conn; + CAMLreturn (rv); +} + +static value +Val_dom (virDomainPtr dom) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&dom_custom_operations, + sizeof (virDomainPtr), 0, 1); + Dom_val (rv) = dom; + CAMLreturn (rv); +} + +static value +Val_net (virNetworkPtr net) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&net_custom_operations, + sizeof (virNetworkPtr), 0, 1); + Net_val (rv) = net; + CAMLreturn (rv); +} + +#ifdef HAVE_VIRSTORAGEPOOLPTR +static value +Val_pol (virStoragePoolPtr pol) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&pol_custom_operations, + sizeof (virStoragePoolPtr), 0, 1); + Pol_val (rv) = pol; + CAMLreturn (rv); +} +#endif + +#ifdef HAVE_VIRSTORAGEVOLPTR +static value +Val_vol (virStorageVolPtr net) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&vol_custom_operations, + sizeof (virStorageVolPtr), 0, 1); + Vol_val (rv) = vol; + CAMLreturn (rv); +} +#endif + +/* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use + * by virterror wrappers. + */ +static value +Val_connect_no_finalize (virConnectPtr conn) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc (1, Abstract_tag); + Store_field (rv, 0, (value) conn); + CAMLreturn (rv); +} + +static value +Val_dom_no_finalize (virDomainPtr dom) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc (1, Abstract_tag); + Store_field (rv, 0, (value) dom); + CAMLreturn (rv); +} + +static value +Val_net_no_finalize (virNetworkPtr net) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc (1, Abstract_tag); + Store_field (rv, 0, (value) net); + CAMLreturn (rv); +} + +/* This wraps up the (dom, conn) pair (Domain.t). */ +static value +Val_domain (virDomainPtr dom, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_dom (dom); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +/* This wraps up the (net, conn) pair (Network.t). */ +static value +Val_network (virNetworkPtr net, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_net (net); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +#ifdef HAVE_VIRSTORAGEPOOLPTR +/* This wraps up the (pol, conn) pair (Pool.t). */ +static value +Val_pool (virStoragePoolPtr pol, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_pol (pol); + Store_field (rv, 0, v); + 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) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_vol (vol); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} +#endif + +/* No-finalize versions of Val_domain, Val_network ONLY for use by + * virterror wrappers. + */ +static value +Val_domain_no_finalize (virDomainPtr dom, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_dom_no_finalize (dom); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +static value +Val_network_no_finalize (virNetworkPtr net, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_net_no_finalize (net); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +static void +conn_finalize (value connv) +{ + virConnectPtr conn = Connect_val (connv); + if (conn) (void) virConnectClose (conn); +} + +static void +dom_finalize (value domv) +{ + virDomainPtr dom = Dom_val (domv); + if (dom) (void) virDomainFree (dom); +} + +static void +net_finalize (value netv) +{ + virNetworkPtr net = Net_val (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 new file mode 100644 index 0000000..6387b52 --- /dev/null +++ b/libvirt/libvirt_c_oneoffs.c @@ -0,0 +1,1171 @@ +/* OCaml bindings for libvirt. + * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + * http://libvirt.org/ + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +/* Please read libvirt/README file. */ + +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRDOMAINBLOCKSTATS +extern int virDomainBlockStats (virDomainPtr dom, + const char *path, + virDomainBlockStatsPtr stats, + size_t size) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS +extern int virDomainGetSchedulerParameters (virDomainPtr domain, + virSchedParameterPtr params, + int *nparams) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE +extern char *virDomainGetSchedulerType(virDomainPtr domain, + int *nparams) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAININTERFACESTATS +extern int virDomainInterfaceStats (virDomainPtr dom, + const char *path, + virDomainInterfaceStatsPtr stats, + size_t size) + __attribute__((weak)); +#endif +#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 +#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS +extern int virDomainSetSchedulerParameters (virDomainPtr domain, + virSchedParameterPtr params, + int nparams) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRNODEGETFREEMEMORY +extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY +extern int virNodeGetCellsFreeMemory (virConnectPtr conn, + unsigned long long *freeMems, + int startCell, int maxCells) + __attribute__((weak)); +#endif +#endif /* HAVE_WEAK_SYMBOLS */ + +/*----------------------------------------------------------------------*/ + +CAMLprim value +ocaml_libvirt_get_version (value driverv, value unit) +{ + CAMLparam2 (driverv, unit); + CAMLlocal1 (rv); + const char *driver = Optstring_val (driverv); + unsigned long libVer, typeVer = 0, *typeVer_ptr; + int r; + + typeVer_ptr = driver ? &typeVer : NULL; + NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr)); + CHECK_ERROR (r == -1, NULL, "virGetVersion"); + + rv = caml_alloc_tuple (2); + Store_field (rv, 0, Val_int (libVer)); + Store_field (rv, 1, Val_int (typeVer)); + CAMLreturn (rv); +} + +/*----------------------------------------------------------------------*/ + +/* Connection object. */ + +CAMLprim value +ocaml_libvirt_connect_open (value namev, value unit) +{ + CAMLparam2 (namev, unit); + CAMLlocal1 (rv); + const char *name = Optstring_val (namev); + virConnectPtr conn; + + NONBLOCKING (conn = virConnectOpen (name)); + CHECK_ERROR (!conn, NULL, "virConnectOpen"); + + rv = Val_connect (conn); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_open_readonly (value namev, value unit) +{ + CAMLparam2 (namev, unit); + CAMLlocal1 (rv); + const char *name = Optstring_val (namev); + virConnectPtr conn; + + NONBLOCKING (conn = virConnectOpenReadOnly (name)); + CHECK_ERROR (!conn, NULL, "virConnectOpen"); + + rv = Val_connect (conn); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_close (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + int r; + + NONBLOCKING (r = virConnectClose (conn)); + CHECK_ERROR (r == -1, conn, "virConnectClose"); + + /* So that we don't double-free in the finalizer: */ + Connect_val (connv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_connect_get_version (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + unsigned long hvVer; + int r; + + NONBLOCKING (r = virConnectGetVersion (conn, &hvVer)); + CHECK_ERROR (r == -1, conn, "virConnectGetVersion"); + + CAMLreturn (Val_int (hvVer)); +} + +CAMLprim value +ocaml_libvirt_connect_get_max_vcpus (value connv, value typev) +{ + CAMLparam2 (connv, typev); + virConnectPtr conn = Connect_val (connv); + const char *type = Optstring_val (typev); + int r; + + NONBLOCKING (r = virConnectGetMaxVcpus (conn, type)); + CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_connect_get_node_info (value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + virConnectPtr conn = Connect_val (connv); + virNodeInfo info; + int r; + + NONBLOCKING (r = virNodeGetInfo (conn, &info)); + CHECK_ERROR (r == -1, conn, "virNodeGetInfo"); + + rv = caml_alloc (8, 0); + v = caml_copy_string (info.model); Store_field (rv, 0, v); + v = caml_copy_int64 (info.memory); Store_field (rv, 1, v); + Store_field (rv, 2, Val_int (info.cpus)); + Store_field (rv, 3, Val_int (info.mhz)); + Store_field (rv, 4, Val_int (info.nodes)); + Store_field (rv, 5, Val_int (info.sockets)); + Store_field (rv, 6, Val_int (info.cores)); + Store_field (rv, 7, Val_int (info.threads)); + + CAMLreturn (rv); +} + +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 +} + +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); + int start = Int_val (startv); + int max = Int_val (maxv); + 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"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) { + iv = caml_copy_int64 ((int64) freemems[i]); + Store_field (rv, i, iv); + } + + CAMLreturn (rv); +#else + not_supported ("virNodeGetCellsFreeMemory"); +#endif +} + +CAMLprim value +ocaml_libvirt_domain_create_linux (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virDomainPtr r; + + NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0)); + CHECK_ERROR (!r, conn, "virDomainCreateLinux"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_id (value connv, value iv) +{ + CAMLparam2 (connv, iv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + virDomainPtr r; + + NONBLOCKING (r = virDomainLookupByID (conn, i)); + CHECK_ERROR (!r, conn, "virDomainLookupByID"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virDomainPtr r; + + NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid)); + CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virDomainPtr r; + + NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid)); + CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_name (value connv, value namev) +{ + CAMLparam2 (connv, namev); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *name = String_val (namev); + virDomainPtr r; + + NONBLOCKING (r = virDomainLookupByName (conn, name)); + CHECK_ERROR (!r, conn, "virDomainLookupByName"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_destroy (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + NONBLOCKING (r = virDomainDestroy (dom)); + CHECK_ERROR (r == -1, conn, "virDomainDestroy"); + + /* So that we don't double-free in the finalizer: */ + Domain_val (domv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_free (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + NONBLOCKING (r = virDomainFree (dom)); + CHECK_ERROR (r == -1, conn, "virDomainFree"); + + /* So that we don't double-free in the finalizer: */ + Domain_val (domv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_save (value domv, value pathv) +{ + CAMLparam2 (domv, pathv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + int r; + + NONBLOCKING (r = virDomainSave (dom, path)); + CHECK_ERROR (r == -1, conn, "virDomainSave"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_restore (value connv, value pathv) +{ + CAMLparam2 (connv, pathv); + virConnectPtr conn = Connect_val (connv); + char *path = String_val (pathv); + int r; + + NONBLOCKING (r = virDomainRestore (conn, path)); + CHECK_ERROR (r == -1, conn, "virDomainRestore"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_core_dump (value domv, value pathv) +{ + CAMLparam2 (domv, pathv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + int r; + + NONBLOCKING (r = virDomainCoreDump (dom, path, 0)); + CHECK_ERROR (r == -1, conn, "virDomainCoreDump"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_uuid (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned char uuid[VIR_UUID_BUFLEN]; + int r; + + NONBLOCKING (r = virDomainGetUUID (dom, uuid)); + CHECK_ERROR (r == -1, conn, "virDomainGetUUID"); + + rv = caml_copy_string ((char *) uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_uuid_string (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char uuid[VIR_UUID_STRING_BUFLEN]; + int r; + + NONBLOCKING (r = virDomainGetUUIDString (dom, uuid)); + CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString"); + + rv = caml_copy_string (uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_id (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned int r; + + NONBLOCKING (r = virDomainGetID (dom)); + /* There's a bug in libvirt which means that if you try to get + * the ID of a defined-but-not-running domain, it returns -1, + * and there's no way to distinguish that from an error. + */ + CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID"); + + CAMLreturn (Val_int ((int) r)); +} + +CAMLprim value +ocaml_libvirt_domain_get_max_memory (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned long r; + + NONBLOCKING (r = virDomainGetMaxMemory (dom)); + CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory"); + + rv = caml_copy_int64 (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_set_max_memory (value domv, value memv) +{ + CAMLparam2 (domv, memv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned long mem = Int64_val (memv); + int r; + + NONBLOCKING (r = virDomainSetMaxMemory (dom, mem)); + CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_set_memory (value domv, value memv) +{ + CAMLparam2 (domv, memv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned long mem = Int64_val (memv); + int r; + + NONBLOCKING (r = virDomainSetMemory (dom, mem)); + CHECK_ERROR (r == -1, conn, "virDomainSetMemory"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_info (value domv) +{ + CAMLparam1 (domv); + CAMLlocal2 (rv, v); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + virDomainInfo info; + int r; + + NONBLOCKING (r = virDomainGetInfo (dom, &info)); + CHECK_ERROR (r == -1, conn, "virDomainGetInfo"); + + rv = caml_alloc (5, 0); + Store_field (rv, 0, Val_int (info.state)); // These flags are compatible. + v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v); + v = caml_copy_int64 (info.memory); Store_field (rv, 2, v); + Store_field (rv, 3, Val_int (info.nrVirtCpu)); + v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_scheduler_type (value domv) +{ +#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE + CAMLparam1 (domv); + CAMLlocal2 (rv, strv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *r; + int nparams; + + WEAK_SYMBOL_CHECK (virDomainGetSchedulerType); + NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams)); + CHECK_ERROR (!r, conn, "virDomainGetSchedulerType"); + + rv = caml_alloc_tuple (2); + strv = caml_copy_string (r); Store_field (rv, 0, strv); + free (r); + Store_field (rv, 1, nparams); + CAMLreturn (rv); +#else + not_supported ("virDomainGetSchedulerType"); +#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); + virConnectPtr conn = Connect_domv (domv); + int nparams = Int_val (nparamsv); + virSchedParameter params[nparams]; + int r, i; + + WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters); + NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams)); + CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters"); + + rv = caml_alloc (nparams, 0); + for (i = 0; i < nparams; ++i) { + v = caml_alloc_tuple (2); Store_field (rv, i, v); + v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2); + switch (params[i].type) { + case VIR_DOMAIN_SCHED_FIELD_INT: + v2 = caml_alloc (1, 0); + v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_UINT: + v2 = caml_alloc (1, 1); + v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_LLONG: + v2 = caml_alloc (1, 2); + v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_ULLONG: + v2 = caml_alloc (1, 3); + v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_DOUBLE: + v2 = caml_alloc (1, 4); + v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_BOOLEAN: + v2 = caml_alloc (1, 5); + Store_field (v2, 0, Val_int (params[i].value.b)); + break; + default: + caml_failwith ((char *)__FUNCTION__); + } + Store_field (v, 1, v2); + } + CAMLreturn (rv); +#else + not_supported ("virDomainGetSchedulerParameters"); +#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); + virConnectPtr conn = Connect_domv (domv); + int nparams = Wosize_val (paramsv); + virSchedParameter params[nparams]; + int r, i; + char *name; + + for (i = 0; i < nparams; ++i) { + v = Field (paramsv, i); /* Points to the two-element tuple. */ + name = String_val (Field (v, 0)); + strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH); + params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0'; + v = Field (v, 1); /* Points to the sched_param_value block. */ + switch (Tag_val (v)) { + case 0: + params[i].type = VIR_DOMAIN_SCHED_FIELD_INT; + params[i].value.i = Int32_val (Field (v, 0)); + break; + case 1: + params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT; + params[i].value.ui = Int32_val (Field (v, 0)); + break; + case 2: + params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG; + params[i].value.l = Int64_val (Field (v, 0)); + break; + case 3: + params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG; + params[i].value.ul = Int64_val (Field (v, 0)); + break; + case 4: + params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE; + params[i].value.d = Double_val (Field (v, 0)); + break; + case 5: + params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN; + params[i].value.b = Int_val (Field (v, 0)); + break; + default: + caml_failwith ((char *)__FUNCTION__); + } + } + + 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 +ocaml_libvirt_domain_define_xml (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virDomainPtr r; + + NONBLOCKING (r = virDomainDefineXML (conn, xml)); + CHECK_ERROR (!r, conn, "virDomainDefineXML"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_autostart (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r, autostart; + + NONBLOCKING (r = virDomainGetAutostart (dom, &autostart)); + CHECK_ERROR (r == -1, conn, "virDomainGetAutostart"); + + CAMLreturn (autostart ? Val_true : Val_false); +} + +CAMLprim value +ocaml_libvirt_domain_set_autostart (value domv, value autostartv) +{ + CAMLparam2 (domv, autostartv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r, autostart = autostartv == Val_true ? 1 : 0; + + NONBLOCKING (r = virDomainSetAutostart (dom, autostart)); + CHECK_ERROR (r == -1, conn, "virDomainSetAutostart"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv) +{ + CAMLparam2 (domv, nvcpusv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r, nvcpus = Int_val (nvcpusv); + + NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus)); + CHECK_ERROR (r == -1, conn, "virDomainSetVcpus"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv) +{ + CAMLparam3 (domv, vcpuv, cpumapv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int maplen = caml_string_length (cpumapv); + unsigned char *cpumap = (unsigned char *) String_val (cpumapv); + int vcpu = Int_val (vcpuv); + int r; + + NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen)); + CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) +{ + CAMLparam3 (domv, maxinfov, maplenv); + CAMLlocal5 (rv, infov, strv, v, v2); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int maxinfo = Int_val (maxinfov); + int maplen = Int_val (maplenv); + virVcpuInfo info[maxinfo]; + unsigned char cpumaps[maxinfo * maplen]; + int r, i; + + memset (info, 0, sizeof (virVcpuInfo) * maxinfo); + memset (cpumaps, 0, maxinfo * maplen); + + NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen)); + CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); + + /* Copy the virVcpuInfo structures. */ + infov = caml_alloc (maxinfo, 0); + for (i = 0; i < maxinfo; ++i) { + v2 = caml_alloc (4, 0); Store_field (infov, i, v2); + Store_field (v2, 0, Val_int (info[i].number)); + Store_field (v2, 1, Val_int (info[i].state)); + v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v); + Store_field (v2, 3, Val_int (info[i].cpu)); + } + + /* Copy the bitmap. */ + strv = caml_alloc_string (maxinfo * maplen); + memcpy (String_val (strv), cpumaps, maxinfo * maplen); + + /* Allocate the tuple and return it. */ + rv = caml_alloc_tuple (3); + Store_field (rv, 0, Val_int (r)); /* number of CPUs. */ + Store_field (rv, 1, infov); + Store_field (rv, 2, strv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_max_vcpus (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + NONBLOCKING (r = virDomainGetMaxVcpus (dom)); + CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_domain_attach_device (value domv, value xmlv) +{ + CAMLparam2 (domv, xmlv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *xml = String_val (xmlv); + int r; + + NONBLOCKING (r = virDomainAttachDevice (dom, xml)); + CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_detach_device (value domv, value xmlv) +{ + CAMLparam2 (domv, xmlv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *xml = String_val (xmlv); + int r; + + NONBLOCKING (r = virDomainDetachDevice (dom, xml)); + CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) +{ +#ifdef HAVE_VIRDOMAINMIGRATE + CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv); + CAMLxparam2 (optbandwidthv, unitv); + CAMLlocal2 (flagv, rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + virConnectPtr dconn = Connect_val (dconnv); + int flags = 0; + const char *dname = Optstring_val (optdnamev); + const char *uri = Optstring_val (opturiv); + unsigned long bandwidth; + virDomainPtr r; + + /* Iterate over the list of flags. */ + for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) + { + flagv = Field (flagsv, 0); + if (flagv == Int_val(0)) + flags |= VIR_MIGRATE_LIVE; + } + + if (optbandwidthv == Val_int (0)) /* None */ + bandwidth = 0; + 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 +ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn) +{ + return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2], + argv[3], argv[4], argv[5], + argv[6]); +} + +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); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + struct _virDomainBlockStats stats; + int r; + + WEAK_SYMBOL_CHECK (virDomainBlockStats); + NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats)); + CHECK_ERROR (r == -1, conn, "virDomainBlockStats"); + + rv = caml_alloc (5, 0); + v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v); + v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v); + v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v); + v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v); + v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v); + + CAMLreturn (rv); +#else + not_supported ("virDomainBlockStats"); +#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); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + struct _virDomainInterfaceStats stats; + int r; + + WEAK_SYMBOL_CHECK (virDomainInterfaceStats); + NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats)); + CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats"); + + rv = caml_alloc (8, 0); + v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v); + v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v); + v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v); + v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v); + v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v); + v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v); + v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v); + v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v); + + CAMLreturn (rv); +#else + not_supported ("virDomainInterfaceStats"); +#endif +} + +CAMLprim value +ocaml_libvirt_network_lookup_by_name (value connv, value namev) +{ + CAMLparam2 (connv, namev); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *name = String_val (namev); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkLookupByName (conn, name)); + CHECK_ERROR (!r, conn, "virNetworkLookupByName"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid)); + CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid)); + CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_create_xml (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkCreateXML (conn, xml)); + CHECK_ERROR (!r, conn, "virNetworkCreateXML"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_define_xml (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virNetworkPtr r; + + NONBLOCKING (r = virNetworkDefineXML (conn, xml)); + CHECK_ERROR (!r, conn, "virNetworkDefineXML"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_destroy (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r; + + NONBLOCKING (r = virNetworkDestroy (net)); + CHECK_ERROR (r == -1, conn, "virNetworkDestroy"); + + /* So that we don't double-free in the finalizer: */ + Network_val (netv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_network_free (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r; + + NONBLOCKING (r = virNetworkFree (net)); + CHECK_ERROR (r == -1, conn, "virNetworkFree"); + + /* So that we don't double-free in the finalizer: */ + Network_val (netv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_network_get_uuid (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + unsigned char uuid[VIR_UUID_BUFLEN]; + int r; + + NONBLOCKING (r = virNetworkGetUUID (net, uuid)); + CHECK_ERROR (r == -1, conn, "virNetworkGetUUID"); + + rv = caml_copy_string ((char *) uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_uuid_string (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + char uuid[VIR_UUID_STRING_BUFLEN]; + int r; + + NONBLOCKING (r = virNetworkGetUUIDString (net, uuid)); + CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString"); + + rv = caml_copy_string (uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_autostart (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r, autostart; + + NONBLOCKING (r = virNetworkGetAutostart (net, &autostart)); + CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart"); + + CAMLreturn (autostart ? Val_true : Val_false); +} + +CAMLprim value +ocaml_libvirt_network_set_autostart (value netv, value autostartv) +{ + CAMLparam2 (netv, autostartv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r, autostart = autostartv == Val_true ? 1 : 0; + + NONBLOCKING (r = virNetworkSetAutostart (net, autostart)); + CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart"); + + CAMLreturn (Val_unit); +} + +/*----------------------------------------------------------------------*/ + +CAMLprim value +ocaml_libvirt_virterror_get_last_error (value unitv) +{ + CAMLparam1 (unitv); + CAMLlocal1 (rv); + virErrorPtr err = virGetLastError (); + + rv = Val_opt (err, (Val_ptr_t) Val_virterror); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_virterror_get_last_conn_error (value connv) +{ + CAMLparam1 (connv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + + rv = Val_opt (conn, (Val_ptr_t) Val_connect); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_virterror_reset_last_error (value unitv) +{ + CAMLparam1 (unitv); + virResetLastError (); + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_virterror_reset_last_conn_error (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + virConnResetLastError (conn); + CAMLreturn (Val_unit); +} + +/*----------------------------------------------------------------------*/ + +/* Initialise the library. */ +CAMLprim value +ocaml_libvirt_init (value unit) +{ + CAMLparam1 (unit); + CAMLlocal1 (rv); + int r; + + r = virInitialize (); + CHECK_ERROR (r == -1, NULL, "virInitialize"); + + CAMLreturn (Val_unit); +} diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c new file mode 100644 index 0000000..1e81d5a --- /dev/null +++ b/libvirt/libvirt_c_prologue.c @@ -0,0 +1,176 @@ +/* OCaml bindings for libvirt. + * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + * http://libvirt.org/ + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +/* Please read libvirt/README file. */ + +static char *Optstring_val (value strv); +typedef value (*Val_ptr_t) (void *); +static value Val_opt (void *ptr, Val_ptr_t Val_ptr); +/*static value option_default (value option, value deflt);*/ +static void _raise_virterror (virConnectPtr conn, const char *fn) Noreturn; +static void not_supported (const char *fn) Noreturn; +static value Val_virterror (virErrorPtr err); + +/* Use this around synchronous libvirt API calls to release the OCaml + * lock, allowing other threads to run simultaneously. 'code' must not + * perform any caml_* calls, run any OCaml code, or raise any exception. + * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html + */ +#define NONBLOCKING(code) \ + do { \ + caml_enter_blocking_section (); \ + code; \ + caml_leave_blocking_section (); \ + } while (0) + +/* Check error condition from a libvirt function, and automatically raise + * an exception if one is found. + */ +#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, + * virDomainPtr and virNetworkPtr. + *------------------------------------------------------------------ + * + * Libvirt does some tricky reference counting to keep track of + * virConnectPtr's, virDomainPtr's and virNetworkPtr's. + * + * There is only one function which can return a virConnectPtr + * (virConnectOpen*) and that allocates a new one each time. + * + * virDomainPtr/virNetworkPtr's on the other hand can be returned + * repeatedly (for the same underlying domain/network), and we must + * keep track of each one and explicitly free it with virDomainFree + * or virNetworkFree. If we lose track of one then the reference + * counting in libvirt will keep it open. We therefore wrap these + * in a custom block with a finalizer function. + * + * We also have to allow the user to explicitly free them, in + * which case we set the pointer inside the custom block to NULL. + * The finalizer notices this and doesn't free the object. + * + * Domains and networks "belong to" a connection. We have to avoid + * the situation like this: + * + * let conn = Connect.open ... in + * let dom = Domain.lookup_by_id conn 0 in + * (* conn goes out of scope and is garbage collected *) + * printf "dom name = %s\n" (Domain.get_name dom) + * + * The reason is that when conn is garbage collected, virConnectClose + * is called and any subsequent operations on dom will fail (in fact + * will probably segfault). To stop this from happening, the OCaml + * wrappers store domains (and networks) as explicit (dom, conn) + * pairs. + * + * Further complication with virterror / exceptions: Virterror gives + * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we + * follow standard practice and wrap these up in blocks with + * finalizers then we'll end up double-freeing (in particular, calling + * virConnectClose at the wrong time). So for virterror, we have + * "special" wrapper functions (Val_connect_no_finalize, etc.). + * + * Update 2008/01: Storage pools and volumes work the same way as + * domains and networks. + */ + +/* Unwrap a custom block. */ +#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 + +/* ONLY for use by virterror wrappers. */ +static value Val_connect_no_finalize (virConnectPtr conn); +static value Val_dom_no_finalize (virDomainPtr dom); +static value Val_net_no_finalize (virNetworkPtr net); + +/* 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 + +/* ONLY for use by virterror wrappers. */ +static value Val_domain_no_finalize (virDomainPtr dom, value connv); +static value Val_network_no_finalize (virNetworkPtr net, value connv); |