+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.
/* 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
/* 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
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],
[],
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
--- /dev/null
+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.
--- /dev/null
+#!/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"
+
type rw = [`R|`W]
type ro = [`R]
+type ('a, 'b) job_t
+
module Connect =
struct
type 'rw t
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"
module Domain =
struct
- type 'rw dom
- type 'rw t = 'rw dom * 'rw Connect.t
+ type 'rw t
type state =
| InfoNoState | InfoRunning | InfoBlocked | InfoPaused
}
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"
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"
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"
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"
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 =
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 :
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.
*)
(** 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
(** 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
(** 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
(** 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
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 :
+/* 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
#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));
-#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));
+extern char *virConnectGetHostname (virConnectPtr conn) __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);
}
ocaml_libvirt_connect_num_of_domains (value connv)
{
CAMLparam1 (connv);
+
virConnectPtr conn = Connect_val (connv);
int r;
}
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);
}
ocaml_libvirt_connect_num_of_defined_domains (value connv)
{
CAMLparam1 (connv);
+
virConnectPtr conn = Connect_val (connv);
int r;
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);
ocaml_libvirt_connect_num_of_networks (value connv)
{
CAMLparam1 (connv);
+
virConnectPtr conn = Connect_val (connv);
int r;
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);
ocaml_libvirt_connect_num_of_defined_networks (value connv)
{
CAMLparam1 (connv);
+
virConnectPtr conn = Connect_val (connv);
int r;
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);
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");
+ NONBLOCKING (r = virConnectNumOfStoragePools (conn));
+ CHECK_ERROR (r == -1, conn, "virConnectNumOfStoragePools");
- 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);
+ 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;
+ char *names[i];
+ int r;
- NONBLOCKING (r = virDomainLookupByID (conn, i));
- CHECK_ERROR (!r, conn, "virDomainLookupByID");
+ NONBLOCKING (r = virConnectListDefinedStoragePools (conn, names, i));
+ CHECK_ERROR (r == -1, conn, "virConnectListDefinedStoragePools");
+
+ 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 (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 = virDomainLookupByUUID (conn, (unsigned char *) uuid));
- CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
+ 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_uuid_string (value connv, value uuidv)
+ocaml_libvirt_domain_get_name (value domv)
{
- CAMLparam2 (connv, uuidv);
- CAMLlocal1 (rv);
- virConnectPtr conn = Connect_val (connv);
- char *uuid = String_val (uuidv);
- virDomainPtr r;
+ CAMLparam1 (domv);
- NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid));
- CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
+ CAMLlocal1 (rv);
+ virDomainPtr dom = Domain_val (domv);
+ virConnectPtr conn = Connect_domv (domv);
+ const char *r;
- 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");
+ 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;
ocaml_libvirt_domain_resume (value domv)
{
CAMLparam1 (domv);
+
virDomainPtr dom = Domain_val (domv);
virConnectPtr conn = Connect_domv (domv);
int r;
}
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;
ocaml_libvirt_domain_reboot (value domv)
{
CAMLparam1 (domv);
+
virDomainPtr dom = Domain_val (domv);
virConnectPtr conn = Connect_domv (domv);
int r;
}
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);
}
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__);
- }
- }
+ CAMLparam1 (poolv);
+#ifndef HAVE_VIRSTORAGEPOOLCREATE
+ /* Symbol virStoragePoolCreate not found at compile time. */
+ not_supported ("virStoragePoolCreate");
+ /* Suppresses a compiler warning. */
+ (void) caml__frame;
+#else
+ /* Check that the symbol virStoragePoolCreate
+ * is in runtime version of libvirt.
+ */
+ WEAK_SYMBOL_CHECK (virStoragePoolCreate);
+
+ CAMLlocal1 (rv);
+ virStoragePoolPtr pool = Pool_val (poolv);
+ virConnectPtr conn = Connect_polv (poolv);
+ char *r;
- WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
- NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
- CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
+ NONBLOCKING (r = virStoragePoolCreate (pool));
+ CHECK_ERROR (!r, conn, "virStoragePoolCreate");
- CAMLreturn (Val_unit);
-#else
- not_supported ("virDomainSetSchedulerParameters");
+ rv = caml_copy_string (r);
+ free (r);
+ CAMLreturn (rv);
#endif
}
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRSTORAGEPOOLSHUTDOWN
+extern char *virStoragePoolShutdown (virStoragePoolPtr pool) __attribute__((weak));
+#endif
+#endif
+
CAMLprim value
-ocaml_libvirt_domain_define_xml (value connv, value xmlv)
+ocaml_libvirt_storage_pool_shutdown (value poolv)
{
- CAMLparam2 (connv, xmlv);
+ 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);
+
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 = virStoragePoolShutdown (pool));
+ CHECK_ERROR (!r, conn, "virStoragePoolShutdown");
- rv = Val_domain (r, connv);
+ rv = caml_copy_string (r);
+ free (r);
CAMLreturn (rv);
+#endif
}
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRSTORAGEPOOLREFRESH
+extern char *virStoragePoolRefresh (virStoragePoolPtr pool, int flags) __attribute__((weak));
+#endif
+#endif
+
CAMLprim value
-ocaml_libvirt_domain_undefine (value domv)
+ocaml_libvirt_storage_pool_refresh (value poolv)
{
- CAMLparam1 (domv);
- virDomainPtr dom = Domain_val (domv);
- virConnectPtr conn = Connect_domv (domv);
- int r;
+ 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);
- NONBLOCKING (r = virDomainUndefine (dom));
- CHECK_ERROR (r == -1, conn, "virDomainUndefine");
+ CAMLlocal1 (rv);
+ virStoragePoolPtr pool = Pool_val (poolv);
+ virConnectPtr conn = Connect_polv (poolv);
+ char *r;
- CAMLreturn (Val_unit);
+ NONBLOCKING (r = virStoragePoolRefresh (pool, 0));
+ CHECK_ERROR (!r, conn, "virStoragePoolRefresh");
+
+ rv = caml_copy_string (r);
+ free (r);
+ CAMLreturn (rv);
+#endif
}
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRSTORAGEVOLGETXMLDESC
+extern char *virStorageVolGetXMLDesc (virStoragePoolPtr pool, int flags) __attribute__((weak));
+#endif
+#endif
+
CAMLprim value
-ocaml_libvirt_domain_create (value domv)
+ocaml_libvirt_storage_vol_get_xml_desc (value poolv)
{
- 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);
-}
-
-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));
- }
+ 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);
- /* 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 = virStorageVolGetXMLDesc (pool, 0));
+ CHECK_ERROR (!r, conn, "virStorageVolGetXMLDesc");
+ 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_VIRSTORAGEVOLGETPATH
+extern char *virStorageVolGetPath (virStoragePoolPtr pool) __attribute__((weak));
+#endif
+#endif
CAMLprim value
-ocaml_libvirt_domain_detach_device (value domv, value xmlv)
+ocaml_libvirt_storage_vol_get_path (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_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);
- 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 = virStorageVolGetPath (pool));
+ CHECK_ERROR (!r, conn, "virStorageVolGetPath");
+ 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_VIRSTORAGEVOLGETKEY
+extern const char *virStorageVolGetKey (virStoragePoolPtr pool) __attribute__((weak));
+#endif
+#endif
CAMLprim value
-ocaml_libvirt_domain_block_stats (value domv, value pathv)
+ocaml_libvirt_storage_vol_get_key (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_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);
- 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);
+ const 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 = virStorageVolGetKey (pool));
+ CHECK_ERROR (!r, conn, "virStorageVolGetKey");
+ rv = caml_copy_string (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_VIRSTORAGEVOLGETNAME
+extern const char *virStorageVolGetName (virStoragePoolPtr pool) __attribute__((weak));
+#endif
#endif
-}
CAMLprim value
-ocaml_libvirt_network_lookup_by_name (value connv, value namev)
+ocaml_libvirt_storage_vol_get_name (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_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_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 = 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_lookup_by_uuid_string (value connv, value uuidv)
+ocaml_libvirt_domain_create_job ()
{
- 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);
+ failwith ("ocaml_libvirt_domain_create_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_create_xml (value connv, value xmlv)
+ocaml_libvirt_domain_core_dump_job ()
{
- 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);
+ failwith ("ocaml_libvirt_domain_core_dump_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_define_xml (value connv, value xmlv)
+ocaml_libvirt_domain_restore_job ()
{
- 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);
+ failwith ("ocaml_libvirt_domain_restore_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_undefine (value netv)
+ocaml_libvirt_domain_save_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_save_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_create (value netv)
+ocaml_libvirt_connect_create_linux_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_connect_create_linux_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_destroy (value netv)
+ocaml_libvirt_network_create_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_network_create_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_free (value netv)
+ocaml_libvirt_network_create_xml_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_network_create_xml_job is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_get_name (value netv)
+ocaml_libvirt_storage_pool_set_autostart ()
{
- 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_storage_pool_set_autostart is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_get_uuid (value netv)
+ocaml_libvirt_storage_pool_get_autostart ()
{
- 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_storage_pool_get_autostart is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_get_uuid_string (value netv)
+ocaml_libvirt_storage_pool_get_info ()
{
- 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_storage_pool_get_info is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_get_xml_desc (value netv)
+ocaml_libvirt_storage_pool_get_uuid_string ()
{
- 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_get_uuid_string is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_get_bridge_name (value netv)
+ocaml_libvirt_storage_pool_get_uuid ()
{
- 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_uuid is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_get_autostart (value netv)
+ocaml_libvirt_storage_pool_free ()
{
- 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_free is unimplemented");
}
CAMLprim value
-ocaml_libvirt_network_set_autostart (value netv, value autostartv)
+ocaml_libvirt_storage_pool_destroy ()
{
- 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_destroy is unimplemented");
}
-/*----------------------------------------------------------------------*/
-
CAMLprim value
-ocaml_libvirt_virterror_get_last_error (value unitv)
+ocaml_libvirt_storage_pool_define_xml ()
{
- CAMLparam1 (unitv);
- CAMLlocal1 (rv);
- virErrorPtr err = virGetLastError ();
-
- rv = Val_opt (err, (Val_ptr_t) Val_virterror);
-
- CAMLreturn (rv);
+ failwith ("ocaml_libvirt_storage_pool_define_xml is unimplemented");
}
CAMLprim value
-ocaml_libvirt_virterror_get_last_conn_error (value connv)
+ocaml_libvirt_storage_pool_create_xml ()
{
- 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_create_xml is unimplemented");
}
CAMLprim value
-ocaml_libvirt_virterror_reset_last_error (value unitv)
+ocaml_libvirt_storage_pool_lookup_by_uuid_string ()
{
- CAMLparam1 (unitv);
- virResetLastError ();
- CAMLreturn (Val_unit);
+ failwith ("ocaml_libvirt_storage_pool_lookup_by_uuid_string is unimplemented");
}
CAMLprim value
-ocaml_libvirt_virterror_reset_last_conn_error (value connv)
+ocaml_libvirt_storage_pool_lookup_by_uuid ()
{
- CAMLparam1 (connv);
- virConnectPtr conn = Connect_val (connv);
- virConnResetLastError (conn);
- CAMLreturn (Val_unit);
+ failwith ("ocaml_libvirt_storage_pool_lookup_by_uuid 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)
-{
- 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*/
- CAMLreturn0;
-}
-
-/* Raise an error if a function is not supported. */
-static void
-not_supported (const char *fn)
+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)
-{
- 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)
+CAMLprim value
+ocaml_libvirt_storage_vol_destroy ()
{
- 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);
+ failwith ("ocaml_libvirt_storage_vol_destroy is unimplemented");
}
-/* 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 */
--- /dev/null
+/* 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
--- /dev/null
+/* 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);
+}
--- /dev/null
+/* 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);
git.annexia.org / virt-top.git / commitdiff