diff options
| author | rjones@thinkpad <rjones@thinkpad> | 2008-04-17 11:13:39 +0100 |
|---|---|---|
| committer | rjones@thinkpad <rjones@thinkpad> | 2008-04-17 11:13:39 +0100 |
| commit | 5fb80987ddf0f8af6cd479964f1c5bb8340c7ba8 (patch) | |
| tree | 6774d8d7c9fb2ec1b6f4b5913636f5e36af1dae2 /libvirt | |
| parent | f9d99e63272520c19bddc9e4b47731d57e5658e2 (diff) | |
| parent | f5f45d38269842b591a89ccaf2e6af7879d57aab (diff) | |
| download | virt-top-5fb80987ddf0f8af6cd479964f1c5bb8340c7ba8.tar.gz virt-top-5fb80987ddf0f8af6cd479964f1c5bb8340c7ba8.tar.xz virt-top-5fb80987ddf0f8af6cd479964f1c5bb8340c7ba8.zip | |
Merge.
Diffstat (limited to 'libvirt')
| -rw-r--r-- | libvirt/.depend | 4 | ||||
| -rw-r--r-- | libvirt/Makefile.in | 125 | ||||
| -rw-r--r-- | libvirt/README | 49 | ||||
| -rwxr-xr-x | libvirt/generator.pl | 1019 | ||||
| -rw-r--r-- | libvirt/libvirt.ml | 522 | ||||
| -rw-r--r-- | libvirt/libvirt.mli | 994 | ||||
| -rw-r--r-- | libvirt/libvirt_c.c | 3065 | ||||
| -rw-r--r-- | libvirt/libvirt_c_epilogue.c | 548 | ||||
| -rw-r--r-- | libvirt/libvirt_c_oneoffs.c | 822 | ||||
| -rw-r--r-- | libvirt/libvirt_c_prologue.c | 191 | ||||
| -rwxr-xr-x | libvirt/libvirt_version.ml.in | 21 | ||||
| -rwxr-xr-x | libvirt/libvirt_version.mli | 25 |
12 files changed, 0 insertions, 7385 deletions
diff --git a/libvirt/.depend b/libvirt/.depend deleted file mode 100644 index 5556d96..0000000 --- a/libvirt/.depend +++ /dev/null @@ -1,4 +0,0 @@ -libvirt.cmo: libvirt.cmi -libvirt.cmx: libvirt.cmi -libvirt_version.cmo: libvirt_version.cmi -libvirt_version.cmx: libvirt_version.cmi diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in deleted file mode 100644 index 4b203fd..0000000 --- a/libvirt/Makefile.in +++ /dev/null @@ -1,125 +0,0 @@ -# ocaml-libvirt -# Copyright (C) 2007 Red Hat Inc., Richard W.M. Jones -# -# 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 - -WIN32 = @WIN32@ - -CFLAGS = @CFLAGS@ \ - -I.. \ - -I"$(shell ocamlc -where)" \ - @DEBUG@ @WARNINGS@ @CFLAGS_FPIC@ -LDFLAGS = @LDFLAGS@ -# -L"$(shell ocamlc -where)" - -OCAMLC = @OCAMLC@ -OCAMLOPT = @OCAMLOPT@ -OCAMLFIND = @OCAMLFIND@ -OCAMLMKLIB = @OCAMLMKLIB@ - -ifneq ($(OCAMLFIND),) -OCAMLCPACKAGES := -package unix -OCAMLCFLAGS := -g -OCAMLCLIBS := -linkpkg -else -OCAMLCINCS := -OCAMLCFLAGS := -g -OCAMLCLIBS := unix.cma -endif - -OCAMLOPTFLAGS := -ifneq ($(OCAMLFIND),) -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTLIBS := $(OCAMLCLIBS) -else -OCAMLOPTINCS := $(OCAMLCINCS) -OCAMLOPTLIBS := unix.cmxa -endif - -export LIBRARY_PATH=. -export LD_LIBRARY_PATH=. - -BYTE_TARGETS := mllibvirt.cma -OPT_TARGETS := mllibvirt.cmxa - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -COBJS := libvirt.cmo libvirt_version.cmo -OPTOBJS := libvirt.cmx libvirt_version.cmx - -ifneq ($(OCAMLMKLIB),) -# Good, we can just use ocamlmklib -mllibvirt.cma: libvirt_c.o $(COBJS) - $(OCAMLMKLIB) -o mllibvirt $^ $(LDFLAGS) -lvirt - -mllibvirt.cmxa: libvirt_c.o $(OPTOBJS) - $(OCAMLMKLIB) -o mllibvirt $^ $(LDFLAGS) -lvirt - -else -ifeq ($(WIN32),yes) -# Ugh, MinGW doesn't have ocamlmklib. This technique is copied from the -# example in OCaml distribution, otherlibs/win32unix/Makefile.nt - -mllibvirt.cma: dllmllibvirt.dll libmllibvirt.a $(COBJS) - $(OCAMLC) -a -linkall -o $@ $(COBJS) \ - -dllib -lmllibvirt -cclib -lmllibvirt -cclib "$(LDFLAGS) -lvirt" - -mllibvirt.cmxa: libmllibvirt.a $(OPTOBJS) - $(OCAMLOPT) -a -linkall -o $@ $(OPTOBJS) \ - -cclib -lmllibvirt -cclib "$(LDFLAGS) -lvirt" - -dllmllibvirt.dll: libvirt_c.o - $(CC) -shared -o $@ $^ \ - $(LDFLAGS) "$(shell ocamlc -where)"/ocamlrun.a -lvirt - -libmllibvirt.a: libvirt_c.o - ar rc $@ $^ - ranlib $@ - -else -# Don't know how to build a library on this platform. -$(BYTE_TARGETS) $(OPT_TARGETS): - echo "Error: ocamlmklib missing, and no known way to build libraries on this platform" - exit 1 -endif -endif - -# Automatically generate the C code from a Perl script 'generator.pl'. -libvirt_c.c: generator.pl - perl -w $< - -# Status of automatically generated bindings. -autostatus: libvirt_c.c - @echo -n "Functions which have manual bindings: " - @grep ^ocaml_libvirt_ libvirt_c_oneoffs.c | wc -l - @echo -n "Functions which have automatic bindings: " - @grep ^ocaml_libvirt_ libvirt_c.c | wc -l - @echo -n "LOC in manual bindings: " - @wc -l < libvirt_c_oneoffs.c - @echo -n "LOC in automatic bindings: " - @wc -l < libvirt_c.c - -libvirt.cmo: libvirt.cmi -libvirt.cmi: libvirt.mli - -libvirt_version.cmo: libvirt_version.cmi -libvirt_version.cmi: libvirt_version.mli - -install: - ocamlfind install libvirt ../META *.so *.a *.cmx *.cma *.cmxa *.mli - -include ../Make.rules diff --git a/libvirt/README b/libvirt/README deleted file mode 100644 index be8300d..0000000 --- a/libvirt/README +++ /dev/null @@ -1,49 +0,0 @@ -README -====== - -The public interface is described in 'libvirt.mli'. You may prefer to -do 'make doc' at the top level source directory and then read the HTML -documentation starting at html/index.html. - -'libvirt.ml' describes how OCaml functions map to C functions. - -'libvirt_c*.c' are the C functions which map OCaml objects to C -objects and vice versa (see next section). - -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 majority of the functions are now generated automatically, but -there are a few one-off bindings (eg. one-of-a-type functions, -functions with particularly complex mappings). Our eventual aim to is -autogenerate as much as possible. Use 'make autostatus' in this -directory to find out how we're doing. - -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. - -The key to understanding the generator is to look at the generated -code (libvirt_c.c) first, and go from there back to parts of the -generator script. diff --git a/libvirt/generator.pl b/libvirt/generator.pl deleted file mode 100755 index 578029b..0000000 --- a/libvirt/generator.pl +++ /dev/null @@ -1,1019 +0,0 @@ -#!/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). -# -# Please read libvirt/README. - -use strict; - -#---------------------------------------------------------------------- - -# The functions in the libvirt API that we can generate. - -# The 'sig' (signature) doesn't have a meaning or any internal structure. -# It is interpreted by the generation functions below to indicate what -# "class" the function falls into, and to generate the right class of -# binding. -# -# Any function added since libvirt 0.2.1 must be marked weak. - -my @functions = ( - { name => "virConnectClose", sig => "conn : free" }, - { name => "virConnectGetHostname", sig => "conn : string", weak => 1 }, - { 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 => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, - { name => "virDomainCreateLinuxJob", - sig => "conn, string, 0U : job", weak => 1 }, - { name => "virDomainFree", sig => "dom : free" }, - { name => "virDomainDestroy", sig => "dom : free" }, - { name => "virDomainLookupByName", sig => "conn, string : dom" }, - { name => "virDomainLookupByID", sig => "conn, int : dom" }, - { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" }, - { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" }, - { name => "virDomainGetName", sig => "dom : static string" }, - { name => "virDomainGetOSType", sig => "dom : string" }, - { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" }, - { name => "virDomainGetUUID", sig => "dom : uuid" }, - { name => "virDomainGetUUIDString", sig => "dom : uuid string" }, - { name => "virDomainGetMaxVcpus", sig => "dom : int" }, - { name => "virDomainSave", sig => "dom, string : unit" }, - { name => "virDomainSaveJob", - sig => "dom, string : job from dom", weak => 1 }, - { name => "virDomainRestore", sig => "conn, string : unit" }, - { name => "virDomainRestoreJob", - sig => "conn, string : job", weak => 1 }, - { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" }, - { name => "virDomainCoreDumpJob", - sig => "dom, string, 0 : job from dom", weak => 1 }, - { name => "virDomainSuspend", sig => "dom : unit" }, - { name => "virDomainResume", sig => "dom : unit" }, - { name => "virDomainShutdown", sig => "dom : unit" }, - { name => "virDomainReboot", sig => "dom, 0 : unit" }, - { name => "virDomainDefineXML", sig => "conn, string : dom" }, - { name => "virDomainUndefine", sig => "dom : unit" }, - { name => "virDomainCreate", sig => "dom : unit" }, - { name => "virDomainCreateJob", - sig => "dom, 0U : job from dom", weak => 1 }, - { name => "virDomainAttachDevice", sig => "dom, string : unit" }, - { name => "virDomainDetachDevice", sig => "dom, string : unit" }, - { name => "virDomainGetAutostart", sig => "dom : bool" }, - { name => "virDomainSetAutostart", sig => "dom, bool : unit" }, - - { name => "virNetworkFree", sig => "net : free" }, - { name => "virNetworkDestroy", sig => "net : free" }, - { name => "virNetworkLookupByName", sig => "conn, string : net" }, - { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" }, - { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" }, - { name => "virNetworkGetName", sig => "net : static string" }, - { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" }, - { name => "virNetworkGetBridgeName", sig => "net : string" }, - { name => "virNetworkGetUUID", sig => "net : uuid" }, - { name => "virNetworkGetUUIDString", sig => "net : uuid string" }, - { name => "virNetworkUndefine", sig => "net : unit" }, - { name => "virNetworkCreateXML", sig => "conn, string : net" }, - { name => "virNetworkCreateXMLJob", - sig => "conn, string : job", weak => 1 }, - { name => "virNetworkDefineXML", sig => "conn, string : net" }, - { name => "virNetworkCreate", sig => "net : unit" }, - { name => "virNetworkCreateJob", - sig => "net : job from net", weak => 1 }, - { name => "virNetworkGetAutostart", sig => "net : bool" }, - { name => "virNetworkSetAutostart", sig => "net, bool : unit" }, - - { name => "virStoragePoolFree", sig => "pool : free", weak => 1 }, - { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 }, - { name => "virStoragePoolLookupByName", - sig => "conn, string : pool", weak => 1 }, - { name => "virStoragePoolLookupByUUID", - sig => "conn, uuid : pool", weak => 1 }, - { name => "virStoragePoolLookupByUUIDString", - sig => "conn, string : pool", weak => 1 }, - { name => "virStoragePoolGetName", - sig => "pool : static string", weak => 1 }, - { name => "virStoragePoolGetXMLDesc", - sig => "pool, 0U : string", weak => 1 }, - { name => "virStoragePoolGetUUID", - sig => "pool : uuid", weak => 1 }, - { name => "virStoragePoolGetUUIDString", - sig => "pool : uuid string", weak => 1 }, - { name => "virStoragePoolCreateXML", - sig => "conn, string, 0U : pool", weak => 1 }, - { name => "virStoragePoolDefineXML", - sig => "conn, string, 0U : pool", weak => 1 }, - { name => "virStoragePoolBuild", - sig => "pool, uint : unit", weak => 1 }, - { name => "virStoragePoolUndefine", - sig => "pool : unit", weak => 1 }, - { name => "virStoragePoolCreate", - sig => "pool, 0U : unit", weak => 1 }, - { name => "virStoragePoolDelete", - sig => "pool, uint : unit", weak => 1 }, - { name => "virStoragePoolRefresh", - sig => "pool, 0U : unit", weak => 1 }, - { name => "virStoragePoolGetAutostart", - sig => "pool : bool", weak => 1 }, - { name => "virStoragePoolSetAutostart", - sig => "pool, bool : unit", weak => 1 }, - { name => "virStoragePoolNumOfVolumes", - sig => "pool : int", weak => 1 }, - { name => "virStoragePoolListVolumes", - sig => "pool, int : string array", weak => 1 }, - - { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, - { name => "virStorageVolDelete", - sig => "vol, uint : unit", weak => 1 }, - { name => "virStorageVolLookupByName", - sig => "pool, string : vol from pool", weak => 1 }, - { name => "virStorageVolLookupByKey", - sig => "conn, string : vol", weak => 1 }, - { name => "virStorageVolLookupByPath", - sig => "conn, string : vol", weak => 1 }, - { name => "virStorageVolCreateXML", - sig => "pool, string, 0U : vol from pool", weak => 1 }, - { name => "virStorageVolGetXMLDesc", - sig => "vol, 0U : string", weak => 1 }, - { name => "virStorageVolGetPath", - sig => "vol : string", weak => 1 }, - { name => "virStorageVolGetKey", - sig => "vol : static string", weak => 1 }, - { name => "virStorageVolGetName", - sig => "vol : static string", weak => 1 }, - { name => "virStoragePoolLookupByVolume", - sig => "vol : pool from vol", weak => 1 }, - - { name => "virJobFree", - sig => "job : free", weak => 1 }, - { name => "virJobCancel", - sig => "job : unit", weak => 1 }, - { name => "virJobGetNetwork", - sig => "job : net from job", weak => 1 }, - { name => "virJobGetDomain", - sig => "job : dom from job", weak => 1 }, - - ); - -# Functions we haven't implemented anywhere yet but which are mentioned -# in 'libvirt.ml'. -# -# We create stubs for these, but eventually they need to either be -# moved ^^^ so they are auto-generated, or implementations of them -# written in 'libvirt_c_oneoffs.c'. - -my @unimplemented = ( - ); - -#---------------------------------------------------------------------- - -# Open the output file. - -my $filename = "libvirt_c.c"; -open F, ">$filename" or die "$filename: $!"; - -# Write the prologue. - -print F <<'END'; -/* !!! WARNING WARNING WARNING WARNING WARNING WARNING 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|UUID)/$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" } - elsif ($_ eq "job") { "virJobPtr" } - else { - die "unknown short name $_" - } -} - -# Generate a C signature for the original function. Used when building -# weak bindings. - -sub gen_c_signature -{ - my $sig = shift; - my $c_name = shift; - - if ($sig =~ /^(\w+) : string$/) { - my $c_type = short_name_to_c_type ($1); - "char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : static string$/) { - my $c_type = short_name_to_c_type ($1); - "const char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : int$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : uuid$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, unsigned char *)" - } elsif ($sig =~ /^(\w+) : uuid string$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char *)" - } elsif ($sig =~ /^(\w+) : bool$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int *r)" - } elsif ($sig =~ /^(\w+), bool : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int b)" - } elsif ($sig eq "conn, int : int array") { - "int $c_name (virConnectPtr conn, int *ids, int maxids)" - } elsif ($sig =~ /^(\w+), int : string array$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char **const names, int maxnames)" - } elsif ($sig =~ /^(\w+), 0(U?) : string$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "char *$c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : free$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+), string : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, const char *str, ${unsigned}int flags)" - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, const char *str, ${unsigned}int flags)" - } elsif ($sig =~ /^(\w+), (u?)int : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "int $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const unsigned char *str)" - } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1)" - } else { - die "unknown signature $sig" - } -} - -# OCaml argument names. - -sub gen_arg_names -{ - my $sig = shift; - - if ($sig =~ /^(\w+) : string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : static string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : int$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : uuid$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : uuid string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : bool$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), bool : unit$/) { - ( "$1v", "bv" ) - } elsif ($sig eq "conn, int : int array") { - ( "connv", "iv" ) - } elsif ($sig =~ /^(\w+), int : string array$/) { - ( "$1v", "iv" ) - } elsif ($sig =~ /^(\w+), 0U? : string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), 0U? : unit$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : unit$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : free$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), string : unit$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) { - ( "$1v", "iv" ) - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - ( "$1v", "uuidv" ) - } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { - ( "$1v" ) - } else { - die "unknown signature $sig" - } -} - -# Unpack the first (object) argument. - -sub gen_unpack_args -{ - local $_ = shift; - - 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);" - } elsif ($_ eq "job") { - "virJobPtr job = Job_val (jobv);\n". - " virConnectPtr conn = Connect_jobv (jobv);" - } else { - die "unknown short name $_" - } -} - -# Pack the result if it's an object. - -sub gen_pack_result -{ - local $_ = shift; - - if ($_ eq "dom") { "rv = Val_domain (r, connv);" } - elsif ($_ eq "net") { "rv = Val_network (r, connv);" } - elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" } - elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" } - elsif ($_ eq "job") { "rv = Val_job (r, connv);" } - else { - die "unknown short name $_" - } -} - -sub gen_free_arg -{ - local $_ = shift; - - if ($_ eq "conn") { "Connect_val (connv) = NULL;" } - elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" } - elsif ($_ eq "net") { "Network_val (netv) = NULL;" } - elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" } - elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" } - elsif ($_ eq "job") { "Job_val (jobv) = NULL;" } - else { - die "unknown short name $_" - } -} - -# Generate the C body for each signature (class of function). - -sub gen_c_code -{ - my $sig = shift; - 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 =~ /^(\w+) : uuid$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : uuid string$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : bool$/) { - "\ - " . gen_unpack_args ($1) . " - int r, b; - - NONBLOCKING (r = $c_name ($1, &b)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (b ? Val_true : Val_false); -" - } elsif ($sig =~ /^(\w+), bool : unit$/) { - "\ - " . gen_unpack_args ($1) . " - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = $c_name ($1, b)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } 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 =~ /^(\w+), int : string array$/) { - "\ - CAMLlocal2 (rv, strv); - " . gen_unpack_args ($1) . " - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = $c_name ($1, 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+), 0U? : 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+), 0U? : unit$/) { - "\ - " . gen_unpack_args ($1) . " - int r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } 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+) : free$/) { - "\ - " . gen_unpack_args ($1) . " - int r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - /* So that we don't double-free in the finalizer: */ - " . gen_free_arg ($1) . " - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), string : unit$/) { - "\ - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - int r; - - NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - int r; - - NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), (u?)int : unit$/) { - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "\ - " . gen_unpack_args ($1) . " - ${unsigned}int i = Int_val (iv); - int r; - - NONBLOCKING (r = $c_name ($1, i)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($3); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - ${unsigned}int i = Int_val (iv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, i)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($3) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - unsigned char *uuid = (unsigned char *) String_val (uuidv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } else { - die "unknown signature $sig" - } -} - -# Generate each function. - -foreach my $function (@functions) { - my $c_name = $function->{name}; - my $is_weak = $function->{weak}; - my $sig = $function->{sig}; - - #print "generating $c_name with sig \"$sig\" ...\n"; - - #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" - } - - print F <<END; -/* Automatically generated binding for $c_name. - * In generator.pl this function has signature "$sig". - */ - -END - - # Generate a full function prototype if the function is weak. - my $have_name = "HAVE_" . uc ($c_name); - if ($is_weak) { - my $c_sig = gen_c_signature ($sig, $c_name); - print F <<END; -#ifdef HAVE_WEAK_SYMBOLS -#ifdef $have_name -extern $c_sig __attribute__((weak)); -#endif -#endif - -END - } - - my @arg_names = gen_arg_names ($sig); - my $nr_arg_names = scalar @arg_names; - my $arg_names = join ", ", @arg_names; - 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. - -if (@unimplemented) { - printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented); - - print F <<'END'; -/* The following functions are unimplemented and always fail. - * See generator.pl '@unimplemented' - */ - -END - - foreach my $c_external_name (@unimplemented) { - print F <<END; -CAMLprim value -$c_external_name () -{ - failwith ("$c_external_name is unimplemented"); -} - -END - } # end foreach -} # end if @unimplemented - -#---------------------------------------------------------------------- - -# Write the epilogue. - -print F <<'END'; -#include "libvirt_c_epilogue.c" - -/* EOF */ -END - -close F; -print "$0: written $filename\n" - diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml deleted file mode 100644 index aefc6c4..0000000 --- a/libvirt/libvirt.ml +++ /dev/null @@ -1,522 +0,0 @@ -(* 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 -*) - -type uuid = string - -type xml = string - -type filename = string - -external get_version : ?driver:string -> unit -> int * int = "ocaml_libvirt_get_version" - -let uuid_length = 16 -let uuid_string_length = 36 - -(* http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/80683af867cce6bf8fff273973f70c95.en.html *) -type rw = [`R|`W] -type ro = [`R] - -type ('a, 'b) job_t - -module Connect = -struct - type 'rw t - - type node_info = { - model : string; - memory : int64; - cpus : int; - mhz : int; - nodes : int; - sockets : int; - cores : int; - threads : int; - } - - external connect : ?name:string -> unit -> rw t = "ocaml_libvirt_connect_open" - external connect_readonly : ?name:string -> unit -> ro t = "ocaml_libvirt_connect_open_readonly" - external close : [>`R] t -> unit = "ocaml_libvirt_connect_close" - external get_type : [>`R] t -> string = "ocaml_libvirt_connect_get_type" - external get_version : [>`R] t -> int = "ocaml_libvirt_connect_get_version" - external get_hostname : [>`R] t -> string = "ocaml_libvirt_connect_get_hostname" - external get_uri : [>`R] t -> string = "ocaml_libvirt_connect_get_uri" - external get_max_vcpus : [>`R] t -> ?type_:string -> unit -> int = "ocaml_libvirt_connect_get_max_vcpus" - external list_domains : [>`R] t -> int -> int array = "ocaml_libvirt_connect_list_domains" - external num_of_domains : [>`R] t -> int = "ocaml_libvirt_connect_num_of_domains" - external get_capabilities : [>`R] t -> xml = "ocaml_libvirt_connect_get_capabilities" - external num_of_defined_domains : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_domains" - external list_defined_domains : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_domains" - external num_of_networks : [>`R] t -> int = "ocaml_libvirt_connect_num_of_networks" - 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" - - (* See VIR_NODEINFO_MAXCPUS macro defined in <libvirt.h>. *) - let maxcpus_of_node_info { nodes = nodes; sockets = sockets; - cores = cores; threads = threads } = - nodes * sockets * cores * threads - - (* See VIR_CPU_MAPLEN macro defined in <libvirt.h>. *) - let cpumaplen nr_cpus = - (nr_cpus + 7) / 8 - - (* See VIR_USE_CPU, VIR_UNUSE_CPU, VIR_CPU_USABLE macros defined in <libvirt.h>. *) - let use_cpu cpumap cpu = - cpumap.[cpu/8] <- - Char.chr (Char.code cpumap.[cpu/8] lor (1 lsl (cpu mod 8))) - let unuse_cpu cpumap cpu = - cpumap.[cpu/8] <- - Char.chr (Char.code cpumap.[cpu/8] land (lnot (1 lsl (cpu mod 8)))) - let cpu_usable cpumaps maplen vcpu cpu = - Char.code cpumaps.[vcpu*maplen + cpu/8] land (1 lsl (cpu mod 8)) <> 0 - - external const : [>`R] t -> ro t = "%identity" -end - -module Domain = -struct - type 'rw t - - type state = - | InfoNoState | InfoRunning | InfoBlocked | InfoPaused - | InfoShutdown | InfoShutoff | InfoCrashed - - type info = { - state : state; - max_mem : int64; - memory : int64; - nr_virt_cpu : int; - cpu_time : int64; - } - - type vcpu_state = VcpuOffline | VcpuRunning | VcpuBlocked - - type vcpu_info = { - number : int; - vcpu_state : vcpu_state; - vcpu_time : int64; - cpu : int; - } - - type sched_param = string * sched_param_value - and sched_param_value = - | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32 - | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 - | SchedFieldFloat of float | SchedFieldBool of bool - - type migrate_flag = Live - - type block_stats = { - rd_req : int64; - rd_bytes : int64; - wr_req : int64; - wr_bytes : int64; - errs : int64; - } - - type interface_stats = { - rx_bytes : int64; - rx_packets : int64; - rx_errs : int64; - rx_drop : int64; - tx_bytes : int64; - tx_packets : int64; - tx_errs : int64; - tx_drop : int64; - } - - 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_domain_create_linux_job" - external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id" - external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid" - external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string" - external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_name" - external destroy : [>`W] t -> unit = "ocaml_libvirt_domain_destroy" - external free : [>`R] t -> unit = "ocaml_libvirt_domain_free" - 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 get_uuid : [>`R] t -> uuid = "ocaml_libvirt_domain_get_uuid" - external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_domain_get_uuid_string" - external get_id : [>`R] t -> int = "ocaml_libvirt_domain_get_id" - external get_os_type : [>`R] t -> string = "ocaml_libvirt_domain_get_os_type" - external get_max_memory : [>`R] t -> int64 = "ocaml_libvirt_domain_get_max_memory" - external set_max_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_max_memory" - external set_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_memory" - external get_info : [>`R] t -> info = "ocaml_libvirt_domain_get_info" - external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_domain_get_xml_desc" - external get_scheduler_type : [>`R] t -> string * int = "ocaml_libvirt_domain_get_scheduler_type" - external get_scheduler_parameters : [>`R] t -> int -> sched_param array = "ocaml_libvirt_domain_get_scheduler_parameters" - external set_scheduler_parameters : [>`W] t -> sched_param array -> unit = "ocaml_libvirt_domain_set_scheduler_parameters" - 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" - external pin_vcpu : [>`W] t -> int -> string -> unit = "ocaml_libvirt_domain_pin_vcpu" - external get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string = "ocaml_libvirt_domain_get_vcpus" - external get_max_vcpus : [>`R] t -> int = "ocaml_libvirt_domain_get_max_vcpus" - external attach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_attach_device" - external detach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_detach_device" - external migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t = "ocaml_libvirt_domain_migrate_bytecode" "ocaml_libvirt_domain_migrate_native" - external block_stats : [>`R] t -> string -> block_stats = "ocaml_libvirt_domain_block_stats" - external interface_stats : [>`R] t -> string -> interface_stats = "ocaml_libvirt_domain_interface_stats" - - external const : [>`R] t -> ro t = "%identity" -end - -module Network = -struct - 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 get_uuid : [>`R] t -> uuid = "ocaml_libvirt_network_get_uuid" - external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_network_get_uuid_string" - external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_network_get_xml_desc" - external get_bridge_name : [>`R] t -> string = "ocaml_libvirt_network_get_bridge_name" - external get_autostart : [>`R] t -> bool = "ocaml_libvirt_network_get_autostart" - external set_autostart : [>`W] t -> bool -> unit = "ocaml_libvirt_network_set_autostart" - - external const : [>`R] t -> ro t = "%identity" -end - -module Pool = -struct - type 'rw t - type pool_state = Inactive | Building | Running | Degraded - type pool_build_flags = New | Repair | Resize - type pool_delete_flags = Normal | Zeroed - type pool_info = { - state : pool_state; - capacity : int64; - allocation : int64; - available : 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 build : [>`W] t -> pool_build_flags -> unit = "ocaml_libvirt_storage_pool_build" - 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 delete : [>`W] t -> unit = "ocaml_libvirt_storage_pool_delete" - 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 num_of_volumes : [`R] t -> int = "ocaml_libvirt_storage_pool_num_of_volumes" - external list_volumes : [`R] t -> int -> string array = "ocaml_libvirt_storage_pool_list_volumes" - external const : [>`R] t -> ro t = "%identity" -end - -module Volume = -struct - type 'rw t - type vol_type = File | Block - type vol_delete_flags = Normal | Zeroed - 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 Connect.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_key" - external lookup_by_path : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_path" - external pool_of_volume : 'a t -> 'a Pool.t = "ocaml_libvirt_storage_pool_lookup_by_volume" - external get_name : [`R] t -> string = "ocaml_libvirt_storage_vol_get_name" - external get_key : [`R] t -> string = "ocaml_libvirt_storage_vol_get_key" - external get_path : [`R] t -> string = "ocaml_libvirt_storage_vol_get_path" - 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 delete : [`W] t -> unit = "ocaml_libvirt_storage_vol_delete" - 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 free : ('a, [>`R]) t -> unit = "ocaml_libvirt_job_free" - external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" -end - -module Virterror = -struct - type code = - | VIR_ERR_OK - | VIR_ERR_INTERNAL_ERROR - | VIR_ERR_NO_MEMORY - | VIR_ERR_NO_SUPPORT - | VIR_ERR_UNKNOWN_HOST - | VIR_ERR_NO_CONNECT - | VIR_ERR_INVALID_CONN - | VIR_ERR_INVALID_DOMAIN - | VIR_ERR_INVALID_ARG - | VIR_ERR_OPERATION_FAILED - | VIR_ERR_GET_FAILED - | VIR_ERR_POST_FAILED - | VIR_ERR_HTTP_ERROR - | VIR_ERR_SEXPR_SERIAL - | VIR_ERR_NO_XEN - | VIR_ERR_XEN_CALL - | VIR_ERR_OS_TYPE - | VIR_ERR_NO_KERNEL - | VIR_ERR_NO_ROOT - | VIR_ERR_NO_SOURCE - | VIR_ERR_NO_TARGET - | VIR_ERR_NO_NAME - | VIR_ERR_NO_OS - | VIR_ERR_NO_DEVICE - | VIR_ERR_NO_XENSTORE - | VIR_ERR_DRIVER_FULL - | VIR_ERR_CALL_FAILED - | VIR_ERR_XML_ERROR - | VIR_ERR_DOM_EXIST - | VIR_ERR_OPERATION_DENIED - | VIR_ERR_OPEN_FAILED - | VIR_ERR_READ_FAILED - | VIR_ERR_PARSE_FAILED - | VIR_ERR_CONF_SYNTAX - | VIR_ERR_WRITE_FAILED - | VIR_ERR_XML_DETAIL - | VIR_ERR_INVALID_NETWORK - | VIR_ERR_NETWORK_EXIST - | VIR_ERR_SYSTEM_ERROR - | VIR_ERR_RPC - | VIR_ERR_GNUTLS_ERROR - | VIR_WAR_NO_NETWORK - | VIR_ERR_NO_DOMAIN - | VIR_ERR_NO_NETWORK - | VIR_ERR_INVALID_MAC - | VIR_ERR_AUTH_FAILED - | VIR_ERR_INVALID_STORAGE_POOL - | VIR_ERR_INVALID_STORAGE_VOL - | VIR_WAR_NO_STORAGE - | VIR_ERR_NO_STORAGE_POOL - | VIR_ERR_NO_STORAGE_VOL - | VIR_ERR_UNKNOWN of int - - let string_of_code = function - | VIR_ERR_OK -> "VIR_ERR_OK" - | VIR_ERR_INTERNAL_ERROR -> "VIR_ERR_INTERNAL_ERROR" - | VIR_ERR_NO_MEMORY -> "VIR_ERR_NO_MEMORY" - | VIR_ERR_NO_SUPPORT -> "VIR_ERR_NO_SUPPORT" - | VIR_ERR_UNKNOWN_HOST -> "VIR_ERR_UNKNOWN_HOST" - | VIR_ERR_NO_CONNECT -> "VIR_ERR_NO_CONNECT" - | VIR_ERR_INVALID_CONN -> "VIR_ERR_INVALID_CONN" - | VIR_ERR_INVALID_DOMAIN -> "VIR_ERR_INVALID_DOMAIN" - | VIR_ERR_INVALID_ARG -> "VIR_ERR_INVALID_ARG" - | VIR_ERR_OPERATION_FAILED -> "VIR_ERR_OPERATION_FAILED" - | VIR_ERR_GET_FAILED -> "VIR_ERR_GET_FAILED" - | VIR_ERR_POST_FAILED -> "VIR_ERR_POST_FAILED" - | VIR_ERR_HTTP_ERROR -> "VIR_ERR_HTTP_ERROR" - | VIR_ERR_SEXPR_SERIAL -> "VIR_ERR_SEXPR_SERIAL" - | VIR_ERR_NO_XEN -> "VIR_ERR_NO_XEN" - | VIR_ERR_XEN_CALL -> "VIR_ERR_XEN_CALL" - | VIR_ERR_OS_TYPE -> "VIR_ERR_OS_TYPE" - | VIR_ERR_NO_KERNEL -> "VIR_ERR_NO_KERNEL" - | VIR_ERR_NO_ROOT -> "VIR_ERR_NO_ROOT" - | VIR_ERR_NO_SOURCE -> "VIR_ERR_NO_SOURCE" - | VIR_ERR_NO_TARGET -> "VIR_ERR_NO_TARGET" - | VIR_ERR_NO_NAME -> "VIR_ERR_NO_NAME" - | VIR_ERR_NO_OS -> "VIR_ERR_NO_OS" - | VIR_ERR_NO_DEVICE -> "VIR_ERR_NO_DEVICE" - | VIR_ERR_NO_XENSTORE -> "VIR_ERR_NO_XENSTORE" - | VIR_ERR_DRIVER_FULL -> "VIR_ERR_DRIVER_FULL" - | VIR_ERR_CALL_FAILED -> "VIR_ERR_CALL_FAILED" - | VIR_ERR_XML_ERROR -> "VIR_ERR_XML_ERROR" - | VIR_ERR_DOM_EXIST -> "VIR_ERR_DOM_EXIST" - | VIR_ERR_OPERATION_DENIED -> "VIR_ERR_OPERATION_DENIED" - | VIR_ERR_OPEN_FAILED -> "VIR_ERR_OPEN_FAILED" - | VIR_ERR_READ_FAILED -> "VIR_ERR_READ_FAILED" - | VIR_ERR_PARSE_FAILED -> "VIR_ERR_PARSE_FAILED" - | VIR_ERR_CONF_SYNTAX -> "VIR_ERR_CONF_SYNTAX" - | VIR_ERR_WRITE_FAILED -> "VIR_ERR_WRITE_FAILED" - | VIR_ERR_XML_DETAIL -> "VIR_ERR_XML_DETAIL" - | VIR_ERR_INVALID_NETWORK -> "VIR_ERR_INVALID_NETWORK" - | VIR_ERR_NETWORK_EXIST -> "VIR_ERR_NETWORK_EXIST" - | VIR_ERR_SYSTEM_ERROR -> "VIR_ERR_SYSTEM_ERROR" - | VIR_ERR_RPC -> "VIR_ERR_RPC" - | VIR_ERR_GNUTLS_ERROR -> "VIR_ERR_GNUTLS_ERROR" - | VIR_WAR_NO_NETWORK -> "VIR_WAR_NO_NETWORK" - | VIR_ERR_NO_DOMAIN -> "VIR_ERR_NO_DOMAIN" - | VIR_ERR_NO_NETWORK -> "VIR_ERR_NO_NETWORK" - | VIR_ERR_INVALID_MAC -> "VIR_ERR_INVALID_MAC" - | VIR_ERR_AUTH_FAILED -> "VIR_ERR_AUTH_FAILED" - | VIR_ERR_INVALID_STORAGE_POOL -> "VIR_ERR_INVALID_STORAGE_POOL" - | VIR_ERR_INVALID_STORAGE_VOL -> "VIR_ERR_INVALID_STORAGE_VOL" - | VIR_WAR_NO_STORAGE -> "VIR_WAR_NO_STORAGE" - | VIR_ERR_NO_STORAGE_POOL -> "VIR_ERR_NO_STORAGE_POOL" - | VIR_ERR_NO_STORAGE_VOL -> "VIR_ERR_NO_STORAGE_VOL" - | VIR_ERR_UNKNOWN i -> "VIR_ERR_" ^ string_of_int i - - type domain = - | VIR_FROM_NONE - | VIR_FROM_XEN - | VIR_FROM_XEND - | VIR_FROM_XENSTORE - | VIR_FROM_SEXPR - | VIR_FROM_XML - | VIR_FROM_DOM - | VIR_FROM_RPC - | VIR_FROM_PROXY - | VIR_FROM_CONF - | VIR_FROM_QEMU - | VIR_FROM_NET - | VIR_FROM_TEST - | VIR_FROM_REMOTE - | VIR_FROM_OPENVZ - | VIR_FROM_XENXM - | VIR_FROM_STATS_LINUX - | VIR_FROM_STORAGE - | VIR_FROM_UNKNOWN of int - - let string_of_domain = function - | VIR_FROM_NONE -> "VIR_FROM_NONE" - | VIR_FROM_XEN -> "VIR_FROM_XEN" - | VIR_FROM_XEND -> "VIR_FROM_XEND" - | VIR_FROM_XENSTORE -> "VIR_FROM_XENSTORE" - | VIR_FROM_SEXPR -> "VIR_FROM_SEXPR" - | VIR_FROM_XML -> "VIR_FROM_XML" - | VIR_FROM_DOM -> "VIR_FROM_DOM" - | VIR_FROM_RPC -> "VIR_FROM_RPC" - | VIR_FROM_PROXY -> "VIR_FROM_PROXY" - | VIR_FROM_CONF -> "VIR_FROM_CONF" - | VIR_FROM_QEMU -> "VIR_FROM_QEMU" - | VIR_FROM_NET -> "VIR_FROM_NET" - | VIR_FROM_TEST -> "VIR_FROM_TEST" - | VIR_FROM_REMOTE -> "VIR_FROM_REMOTE" - | VIR_FROM_OPENVZ -> "VIR_FROM_OPENVZ" - | VIR_FROM_XENXM -> "VIR_FROM_XENXM" - | VIR_FROM_STATS_LINUX -> "VIR_FROM_STATS_LINUX" - | VIR_FROM_STORAGE -> "VIR_FROM_STORAGE" - | VIR_FROM_UNKNOWN i -> "VIR_FROM_" ^ string_of_int i - - type level = - | VIR_ERR_NONE - | VIR_ERR_WARNING - | VIR_ERR_ERROR - | VIR_ERR_UNKNOWN_LEVEL of int - - let string_of_level = function - | VIR_ERR_NONE -> "VIR_ERR_NONE" - | VIR_ERR_WARNING -> "VIR_ERR_WARNING" - | VIR_ERR_ERROR -> "VIR_ERR_ERROR" - | VIR_ERR_UNKNOWN_LEVEL i -> "VIR_ERR_LEVEL_" ^ string_of_int i - - type t = { - code : code; - domain : domain; - message : string option; - level : level; - conn : ro Connect.t option; - dom : ro Domain.t option; - str1 : string option; - str2 : string option; - str3 : string option; - int1 : int32; - int2 : int32; - net : ro Network.t option; - } - - let to_string { code = code; domain = domain; message = message } = - let buf = Buffer.create 128 in - Buffer.add_string buf "libvirt: "; - Buffer.add_string buf (string_of_code code); - Buffer.add_string buf ": "; - Buffer.add_string buf (string_of_domain domain); - Buffer.add_string buf ": "; - (match message with Some msg -> Buffer.add_string buf msg | None -> ()); - Buffer.contents buf - - external get_last_error : unit -> t option = "ocaml_libvirt_virterror_get_last_error" - external get_last_conn_error : [>`R] Connect.t -> t option = "ocaml_libvirt_virterror_get_last_conn_error" - external reset_last_error : unit -> unit = "ocaml_libvirt_virterror_reset_last_error" - external reset_last_conn_error : [>`R] Connect.t -> unit = "ocaml_libvirt_virterror_reset_last_conn_error" - - let no_error () = - { code = VIR_ERR_OK; domain = VIR_FROM_NONE; message = None; - level = VIR_ERR_NONE; conn = None; dom = None; - str1 = None; str2 = None; str3 = None; - int1 = 0_l; int2 = 0_l; net = None } -end - -exception Virterror of Virterror.t -exception Not_supported of string - -(* Initialization. *) -external c_init : unit -> unit = "ocaml_libvirt_init" -let () = - Callback.register_exception - "ocaml_libvirt_virterror" (Virterror (Virterror.no_error ())); - Callback.register_exception - "ocaml_libvirt_not_supported" (Not_supported ""); - c_init () diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli deleted file mode 100644 index af372af..0000000 --- a/libvirt/libvirt.mli +++ /dev/null @@ -1,994 +0,0 @@ -(** 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 -*) - -(** - {2 Introduction and examples} - - This is a set of bindings for writing OCaml programs to - manage virtual machines through {{:http://libvirt.org/}libvirt}. - - {3 Using libvirt interactively} - - Using the interactive toplevel: - -{v -$ ocaml -I +libvirt - Objective Caml version 3.10.0 - -# #load "unix.cma";; -# #load "mllibvirt.cma";; -# let name = "test:///default";; -val name : string = "test:///default" -# let conn = Libvirt.Connect.connect_readonly ~name () ;; -val conn : Libvirt.ro Libvirt.Connect.t = <abstr> -# Libvirt.Connect.get_node_info conn;; - : Libvirt.Connect.node_info = -{Libvirt.Connect.model = "i686"; Libvirt.Connect.memory = 3145728L; - Libvirt.Connect.cpus = 16; Libvirt.Connect.mhz = 1400; - Libvirt.Connect.nodes = 2; Libvirt.Connect.sockets = 2; - Libvirt.Connect.cores = 2; Libvirt.Connect.threads = 2} -v} - - {3 Compiling libvirt programs} - - This command compiles a program to native code: - -{v -ocamlopt -I +libvirt mllibvirt.cmxa list_domains.ml -o list_domains -v} - - {3 Example: Connect to the hypervisor} - - The main modules are {!Libvirt.Connect}, {!Libvirt.Domain} and - {!Libvirt.Network} corresponding respectively to the - {{:http://libvirt.org/html/libvirt-libvirt.html}virConnect*, virDomain* and virNetwork* functions from libvirt}. - For brevity I usually rename these modules like this: - -{v -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network -v} - - To get a connection handle, assuming a Xen hypervisor: - -{v -let name = "xen:///" -let conn = C.connect_readonly ~name () -v} - - {3 Example: List running domains} - -{v -open Printf - -let n = C.num_of_domains conn in -let ids = C.list_domains conn n in -let domains = Array.map (D.lookup_by_id conn) ids in -Array.iter ( - fun dom -> - printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom) -) domains; -v} - - {3 Example: List inactive domains} - -{v -let n = C.num_of_defined_domains conn in -let names = C.list_defined_domains conn n in -Array.iter ( - fun name -> - printf "inactive %s\n%!" name -) names; -v} - - {3 Example: Print node info} - -{v -let node_info = C.get_node_info conn in -printf "model = %s\n" node_info.C.model; -printf "memory = %Ld K\n" node_info.C.memory; -printf "cpus = %d\n" node_info.C.cpus; -printf "mhz = %d\n" node_info.C.mhz; -printf "nodes = %d\n" node_info.C.nodes; -printf "sockets = %d\n" node_info.C.sockets; -printf "cores = %d\n" node_info.C.cores; -printf "threads = %d\n%!" node_info.C.threads; - -let hostname = C.get_hostname conn in -printf "hostname = %s\n%!" hostname; - -let uri = C.get_uri conn in -printf "uri = %s\n%!" uri -v} - -*) - - -(** {2 Programming issues} - - {3 General safety issues} - - Memory allocation / automatic garbage collection of all libvirt - objects should be completely safe (except in the specific - virterror case noted below). If you find any safety issues or if your - pure OCaml program ever segfaults, please contact the author. - - You can force a libvirt object to be freed early by calling - the [close] function on the object. This shouldn't affect - the safety of garbage collection and should only be used when - you want to explicitly free memory. Note that explicitly - closing a connection object does nothing if there are still - unclosed domain or network objects referencing it. - - Note that even though you hold open (eg) a domain object, that - doesn't mean that the domain (virtual machine) actually exists. - The domain could have been shut down or deleted by another user. - Thus domain objects can through odd exceptions at any time. - This is just the nature of virtualisation. - - Virterror has a specific design error which means that the - objects embedded in a virterror exception message are only - valid as long as the connection handle is still open. This - is a design flaw in the C code of libvirt and we cannot fix - or work around it in the OCaml bindings. - - {3 Backwards and forwards compatibility} - - OCaml-libvirt is backwards and forwards compatible with - any libvirt >= 0.2.1. One consequence of this is that - your program can dynamically link to a {i newer} version of - libvirt than it was compiled with, and it should still - work. - - When we link to an older version of libvirt.so, there may - be missing functions. If ocaml-libvirt was compiled with - gcc, then these are turned into OCaml {!Libvirt.Not_supported} - exceptions. - - We don't support libvirt < 0.2.1, and never will so don't ask us. - - {3 Threads} - - You can issue multiple concurrent libvirt requests in - different threads. However you must follow this rule: - Each thread must have its own separate libvirt connection, {i or} - you must implement your own mutex scheme to ensure that no - two threads can ever make concurrent calls using the same - libvirt connection. - - (Note that multithreaded code is not well tested. If you find - bugs please report them.) - - {3 Initialisation} - - Libvirt requires all callers to call virInitialize before - using the library. This is done automatically for you by - these bindings when the program starts up, and we believe - that the way this is done is safe. - - {2 Reference} -*) - -type uuid = string - (** This is a "raw" UUID, ie. a packed string of bytes. *) - -type xml = string - (** Type of XML (an uninterpreted string of bytes). Use PXP, expat, - xml-light, etc. if you want to do anything useful with the XML. - *) - -type filename = string - (** A filename. *) - -val get_version : ?driver:string -> unit -> int * int - (** [get_version ()] returns the library version in the first part - of the tuple, and [0] in the second part. - - [get_version ~driver ()] returns the library version in the first - part of the tuple, and the version of the driver called [driver] - in the second part. - - The version numbers are encoded as - 1,000,000 * major + 1,000 * minor + release. - *) - -val uuid_length : int - (** Length of packed UUIDs. *) - -val uuid_string_length : int - (** Length of UUID strings. *) - -type rw = [`R|`W] -type ro = [`R] - (** These - {{:http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/80683af867cce6bf8fff273973f70c95.en.html}phantom types} - are used to ensure the type-safety of read-only - versus read-write connections. - - All connection/domain/etc. objects are marked with - a phantom read-write or read-only type, and trying to - pass a read-only object into a function which could - mutate the object will cause a compile time error. - - Each module provides a function like {!Libvirt.Connect.const} - to demote a read-write object into a read-only object. The - opposite operation is, of course, not allowed. - - If you want to handle both read-write and read-only - connections at runtime, use a variant similar to this: -{v -type conn_t = - | No_connection - | Read_only of Libvirt.ro Libvirt.Connect.t - | Read_write of Libvirt.rw Libvirt.Connect.t -v} - See also the source of [mlvirsh]. - *) - -type ('a, 'b) job_t -(** Forward definition of {!Job.t} to avoid recursive module dependencies. *) - -(** {3 Connections} *) - -module Connect : -sig - type 'rw t - (** Connection. Read-only connections have type [ro Connect.t] and - read-write connections have type [rw Connect.t]. - *) - - type node_info = { - model : string; (** CPU model *) - memory : int64; (** memory size in kilobytes *) - cpus : int; (** number of active CPUs *) - mhz : int; (** expected CPU frequency *) - nodes : int; (** number of NUMA nodes (1 = UMA) *) - sockets : int; (** number of CPU sockets per node *) - cores : int; (** number of cores per socket *) - threads : int; (** number of threads per core *) - } - - val connect : ?name:string -> unit -> rw t - val connect_readonly : ?name:string -> unit -> ro t - (** [connect ~name ()] connects to the hypervisor with URI [name]. - - [connect ()] connects to the default hypervisor. - - [connect_readonly] is the same but connects in read-only mode. - *) - - val close : [>`R] t -> unit - (** [close conn] closes and frees the connection object in memory. - - The connection is automatically closed if it is garbage - collected. This function just forces it to be closed - and freed right away. - *) - - val get_type : [>`R] t -> string - (** Returns the name of the driver (hypervisor). *) - - val get_version : [>`R] t -> int - (** Returns the driver version - [major * 1_000_000 + minor * 1000 + release] - *) - val get_hostname : [>`R] t -> string - (** Returns the hostname of the physical server. *) - val get_uri : [>`R] t -> string - (** Returns the canonical connection URI. *) - val get_max_vcpus : [>`R] t -> ?type_:string -> unit -> int - (** Returns the maximum number of virtual CPUs - supported by a guest VM of a particular type. *) - val list_domains : [>`R] t -> int -> int array - (** [list_domains conn max] returns the running domain IDs, - up to a maximum of [max] entries. - Call {!num_of_domains} first to get a value for [max]. - *) - val num_of_domains : [>`R] t -> int - (** Returns the number of running domains. *) - val get_capabilities : [>`R] t -> xml - (** Returns the hypervisor capabilities (as XML). *) - val num_of_defined_domains : [>`R] t -> int - (** Returns the number of inactive (shutdown) domains. *) - val list_defined_domains : [>`R] t -> int -> string array - (** [list_defined_domains conn max] - returns the names of the inactive domains, up to - a maximum of [max] entries. - Call {!num_of_defined_domains} first to get a value for [max]. - *) - val num_of_networks : [>`R] t -> int - (** Returns the number of networks. *) - val list_networks : [>`R] t -> int -> string array - (** [list_networks conn max] - returns the names of the networks, up to a maximum - of [max] entries. - Call {!num_of_networks} first to get a value for [max]. - *) - val num_of_defined_networks : [>`R] t -> int - (** Returns the number of inactive networks. *) - val list_defined_networks : [>`R] t -> int -> string array - (** [list_defined_networks conn max] - returns the names of the inactive networks, up to a maximum - of [max] entries. - 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. - *) - val get_node_info : [>`R] t -> node_info - (** Return information about the physical server. *) - - val node_get_free_memory : [> `R] t -> int64 - (** - [node_get_free_memory conn] - returns the amount of free memory (not allocated to any guest) - in the machine. - *) - - val node_get_cells_free_memory : [> `R] t -> int -> int -> int64 array - (** - [node_get_cells_free_memory conn start max] - returns the amount of free memory on each NUMA cell in kilobytes. - [start] is the first cell for which we return free memory. - [max] is the maximum number of cells for which we return free memory. - Returns an array of up to [max] entries in length. - *) - - val maxcpus_of_node_info : node_info -> int - (** Calculate the total number of CPUs supported (but not necessarily - active) in the host. - *) - - val cpumaplen : int -> int - (** Calculate the length (in bytes) required to store the complete - CPU map between a single virtual and all physical CPUs of a domain. - *) - - val use_cpu : string -> int -> unit - (** [use_cpu cpumap cpu] marks [cpu] as usable in [cpumap]. *) - val unuse_cpu : string -> int -> unit - (** [unuse_cpu cpumap cpu] marks [cpu] as not usable in [cpumap]. *) - val cpu_usable : string -> int -> int -> int -> bool - (** [cpu_usable cpumaps maplen vcpu cpu] checks returns true iff the - [cpu] is usable by [vcpu]. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const conn] turns a read/write connection into a read-only - connection. Note that the opposite operation is impossible. - *) -end - (** Module dealing with connections. [Connect.t] is the - connection object. *) - -(** {3 Domains} *) - -module Domain : -sig - type 'rw t - (** Domain handle. Read-only handles have type [ro Domain.t] and - read-write handles have type [rw Domain.t]. - *) - - type state = - | InfoNoState | InfoRunning | InfoBlocked | InfoPaused - | InfoShutdown | InfoShutoff | InfoCrashed - - type info = { - state : state; (** running state *) - max_mem : int64; (** maximum memory in kilobytes *) - memory : int64; (** memory used in kilobytes *) - nr_virt_cpu : int; (** number of virtual CPUs *) - cpu_time : int64; (** CPU time used in nanoseconds *) - } - - type vcpu_state = VcpuOffline | VcpuRunning | VcpuBlocked - - type vcpu_info = { - number : int; (** virtual CPU number *) - vcpu_state : vcpu_state; (** state *) - vcpu_time : int64; (** CPU time used in nanoseconds *) - cpu : int; (** real CPU number, -1 if offline *) - } - - type sched_param = string * sched_param_value - and sched_param_value = - | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32 - | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 - | SchedFieldFloat of float | SchedFieldBool of bool - - type migrate_flag = Live - - type block_stats = { - rd_req : int64; - rd_bytes : int64; - wr_req : int64; - wr_bytes : int64; - errs : int64; - } - - type interface_stats = { - rx_bytes : int64; - rx_packets : int64; - rx_errs : int64; - rx_drop : int64; - tx_bytes : int64; - tx_packets : int64; - tx_errs : int64; - tx_drop : int64; - } - - val create_linux : [>`W] Connect.t -> xml -> rw t - (** 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 - (** Lookup a domain by UUID. This uses the packed byte array UUID. *) - val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t - (** Lookup a domain by (string) UUID. *) - val lookup_by_name : 'a Connect.t -> string -> 'a t - (** Lookup a domain by name. *) - val destroy : [>`W] t -> unit - (** Abruptly destroy a domain. *) - val free : [>`R] t -> unit - (** [free domain] frees the domain object in memory. - - The domain object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - val suspend : [>`W] t -> unit - (** Suspend a domain. *) - val resume : [>`W] t -> unit - (** 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 - (** Reboot a domain. *) - val get_name : [>`R] t -> string - (** Get the domain name. *) - val get_uuid : [>`R] t -> uuid - (** Get the domain UUID (as a packed byte array). *) - val get_uuid_string : [>`R] t -> string - (** Get the domain UUID (as a printable string). *) - val get_id : [>`R] t -> int - (** [getid dom] returns the ID of the domain. - - Do not call this on a defined but not running domain. Those - domains don't have IDs, and you'll get an error here. - *) - - val get_os_type : [>`R] t -> string - (** Get the operating system type. *) - val get_max_memory : [>`R] t -> int64 - (** Get the maximum memory allocation. *) - val set_max_memory : [>`W] t -> int64 -> unit - (** Set the maximum memory allocation. *) - val set_memory : [>`W] t -> int64 -> unit - (** Set the normal memory allocation. *) - val get_info : [>`R] t -> info - (** Get information about a domain. *) - val get_xml_desc : [>`R] t -> xml - (** Get the XML description of a domain. *) - val get_scheduler_type : [>`R] t -> string * int - (** Get the scheduler type. *) - val get_scheduler_parameters : [>`R] t -> int -> sched_param array - (** Get the array of scheduler parameters. *) - val set_scheduler_parameters : [>`W] t -> sched_param array -> unit - (** Set the array of scheduler parameters. *) - val define_xml : [>`W] Connect.t -> xml -> rw t - (** Define a new domain (but don't start it up) from the XML. *) - val undefine : [>`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 - (** Set the autostart flag for a domain. *) - val set_vcpus : [>`W] t -> int -> unit - (** Change the number of vCPUs available to a domain. *) - val pin_vcpu : [>`W] t -> int -> string -> unit - (** [pin_vcpu dom vcpu bitmap] pins a domain vCPU to a bitmap of physical - CPUs. See the libvirt documentation for details of the - layout of the bitmap. *) - val get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string - (** [get_vcpus dom maxinfo maplen] returns the pinning information - for a domain. See the libvirt documentation for details - of the array and bitmap returned from this function. - *) - val get_max_vcpus : [>`R] t -> int - (** Returns the maximum number of vCPUs supported for this domain. *) - val attach_device : [>`W] t -> xml -> unit - (** Attach a device (described by the device XML) to a domain. *) - val detach_device : [>`W] t -> xml -> unit - (** Detach a device (described by the device XML) from a domain. *) - - val migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> - ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t - (** [migrate dom dconn flags ()] migrates a domain to a - destination host described by [dconn]. - - The optional flag [?dname] is used to rename the domain. - - The optional flag [?uri] is used to route the migration. - - The optional flag [?bandwidth] is used to limit the bandwidth - used for migration (in Mbps). *) - - val block_stats : [>`R] t -> string -> block_stats - (** Returns block device stats. *) - val interface_stats : [>`R] t -> string -> interface_stats - (** Returns network interface stats. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const dom] turns a read/write domain handle into a read-only - domain handle. Note that the opposite operation is impossible. - *) -end - (** Module dealing with domains. [Domain.t] is the - domain object. *) - -(** {3 Networks} *) - -module Network : -sig - type 'rw t - (** Network handle. Read-only handles have type [ro Network.t] and - read-write handles have type [rw Network.t]. - *) - - val lookup_by_name : 'a Connect.t -> string -> 'a t - (** Lookup a network by name. *) - val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t - (** Lookup a network by (packed) UUID. *) - val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t - (** 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 - (** [free network] frees the network object in memory. - - The network object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - val get_name : [>`R] t -> string - (** Get network name. *) - val get_uuid : [>`R] t -> uuid - (** Get network packed UUID. *) - val get_uuid_string : [>`R] t -> string - (** Get network UUID as a printable string. *) - val get_xml_desc : [>`R] t -> xml - (** Get XML description of a network. *) - val get_bridge_name : [>`R] t -> string - (** Get bridge device name of a network. *) - val get_autostart : [>`R] t -> bool - (** Get the autostart flag for a network. *) - val set_autostart : [>`W] t -> bool -> unit - (** Set the autostart flag for a network. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const network] turns a read/write network handle into a read-only - network handle. Note that the opposite operation is impossible. - *) -end - (** Module dealing with networks. [Network.t] is the - network object. *) - -(** {3 Storage pools} *) - -module Pool : -sig - type 'rw t - (** Storage pool handle. *) - - type pool_state = Inactive | Building | Running | Degraded - (** State of the storage pool. *) - - type pool_build_flags = New | Repair | Resize - (** Flags for creating a storage pool. *) - - type pool_delete_flags = Normal | Zeroed - (** Flags for deleting a storage pool. *) - - type pool_info = { - state : pool_state; (** Pool state. *) - capacity : int64; (** Logical size in bytes. *) - allocation : int64; (** Currently allocated in bytes. *) - available : int64; (** Remaining free space 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 build : [>`W] t -> pool_build_flags -> unit - (** Build 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 delete : [>`W] t -> unit - (** Delete 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. *) - - val num_of_volumes : [`R] t -> int - (** Returns the number of storage volumes within the storage pool. *) - val list_volumes : [`R] t -> int -> string array - (** Return list of storage volumes. *) - - 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 - (** Type of a storage volume. *) - - type vol_delete_flags = Normal | Zeroed - (** Flags for deleting 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 Connect.t -> string -> 'a t - val lookup_by_path : 'a Connect.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 delete : [`W] t -> unit - (** Delete 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 new domain -(`Domain_nocreate, `W) Job.t Job acting on an existing domain -(`Network, `W) Job.t Job creating a new 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 (Bounded, Unbounded) *) - state : job_state; (** Job state (Running, etc.) *) - 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. *) - - val free : ('a, [>`R]) t -> unit - (** Free a job object in memory. - - The job object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" - (** [const conn] turns a read/write job into a read-only - job. Note that the opposite operation is impossible. - *) -end - (** Module dealing with asynchronous jobs. *) - -(** {3 Error handling and exceptions} *) - -module Virterror : -sig - type code = - | VIR_ERR_OK - | VIR_ERR_INTERNAL_ERROR - | VIR_ERR_NO_MEMORY - | VIR_ERR_NO_SUPPORT - | VIR_ERR_UNKNOWN_HOST - | VIR_ERR_NO_CONNECT - | VIR_ERR_INVALID_CONN - | VIR_ERR_INVALID_DOMAIN - | VIR_ERR_INVALID_ARG - | VIR_ERR_OPERATION_FAILED - | VIR_ERR_GET_FAILED - | VIR_ERR_POST_FAILED - | VIR_ERR_HTTP_ERROR - | VIR_ERR_SEXPR_SERIAL - | VIR_ERR_NO_XEN - | VIR_ERR_XEN_CALL - | VIR_ERR_OS_TYPE - | VIR_ERR_NO_KERNEL - | VIR_ERR_NO_ROOT - | VIR_ERR_NO_SOURCE - | VIR_ERR_NO_TARGET - | VIR_ERR_NO_NAME - | VIR_ERR_NO_OS - | VIR_ERR_NO_DEVICE - | VIR_ERR_NO_XENSTORE - | VIR_ERR_DRIVER_FULL - | VIR_ERR_CALL_FAILED - | VIR_ERR_XML_ERROR - | VIR_ERR_DOM_EXIST - | VIR_ERR_OPERATION_DENIED - | VIR_ERR_OPEN_FAILED - | VIR_ERR_READ_FAILED - | VIR_ERR_PARSE_FAILED - | VIR_ERR_CONF_SYNTAX - | VIR_ERR_WRITE_FAILED - | VIR_ERR_XML_DETAIL - | VIR_ERR_INVALID_NETWORK - | VIR_ERR_NETWORK_EXIST - | VIR_ERR_SYSTEM_ERROR - | VIR_ERR_RPC - | VIR_ERR_GNUTLS_ERROR - | VIR_WAR_NO_NETWORK - | VIR_ERR_NO_DOMAIN - | VIR_ERR_NO_NETWORK - | VIR_ERR_INVALID_MAC - | VIR_ERR_AUTH_FAILED - | VIR_ERR_INVALID_STORAGE_POOL - | VIR_ERR_INVALID_STORAGE_VOL - | VIR_WAR_NO_STORAGE - | VIR_ERR_NO_STORAGE_POOL - | VIR_ERR_NO_STORAGE_VOL - (* ^^ NB: If you add a variant you MUST edit - libvirt_c_epilogue.c:MAX_VIR_* *) - | VIR_ERR_UNKNOWN of int - (** See [<libvirt/virterror.h>] for meaning of these codes. *) - - val string_of_code : code -> string - - type domain = - | VIR_FROM_NONE - | VIR_FROM_XEN - | VIR_FROM_XEND - | VIR_FROM_XENSTORE - | VIR_FROM_SEXPR - | VIR_FROM_XML - | VIR_FROM_DOM - | VIR_FROM_RPC - | VIR_FROM_PROXY - | VIR_FROM_CONF - | VIR_FROM_QEMU - | VIR_FROM_NET - | VIR_FROM_TEST - | VIR_FROM_REMOTE - | VIR_FROM_OPENVZ - | VIR_FROM_XENXM - | VIR_FROM_STATS_LINUX - | VIR_FROM_STORAGE - (* ^^ NB: If you add a variant you MUST edit - libvirt_c_epilogue.c: MAX_VIR_* *) - | VIR_FROM_UNKNOWN of int - (** Subsystem / driver which produced the error. *) - - val string_of_domain : domain -> string - - type level = - | VIR_ERR_NONE - | VIR_ERR_WARNING - | VIR_ERR_ERROR - (* ^^ NB: If you add a variant you MUST edit libvirt_c.c: MAX_VIR_* *) - | VIR_ERR_UNKNOWN_LEVEL of int - (** No error, a warning or an error. *) - - val string_of_level : level -> string - - type t = { - code : code; (** Error code. *) - domain : domain; (** Origin of the error. *) - message : string option; (** Human-readable message. *) - level : level; (** Error or warning. *) - conn : ro Connect.t option; (** Associated connection. *) - dom : ro Domain.t option; (** Associated domain. *) - str1 : string option; (** Informational string. *) - str2 : string option; (** Informational string. *) - str3 : string option; (** Informational string. *) - int1 : int32; (** Informational integer. *) - int2 : int32; (** Informational integer. *) - net : ro Network.t option; (** Associated network. *) - } - (** An error object. *) - - val to_string : t -> string - (** Turn the exception into a printable string. *) - - val get_last_error : unit -> t option - val get_last_conn_error : [>`R] Connect.t -> t option - (** Get the last error at a global or connection level. - - Normally you do not need to use these functions because - the library automatically turns errors into exceptions. - *) - - val reset_last_error : unit -> unit - val reset_last_conn_error : [>`R] Connect.t -> unit - (** Reset the error at a global or connection level. - - Normally you do not need to use these functions. - *) - - val no_error : unit -> t - (** Creates an empty error message. - - Normally you do not need to use this function. - *) -end - (** Module dealing with errors. *) - -exception Virterror of Virterror.t -(** This exception can be raised by any library function that detects - an error. To get a printable error message, call - {!Virterror.to_string} on the content of this exception. -*) - -exception Not_supported of string -(** - Functions may raise - [Not_supported "virFoo"] - (where [virFoo] is the libvirt function name) if a function is - not supported at either compile or run time. This applies to - any libvirt function added after version 0.2.1. - - See also {{:http://libvirt.org/hvsupport.html}http://libvirt.org/hvsupport.html} -*) - diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c deleted file mode 100644 index 882f016..0000000 --- a/libvirt/libvirt_c.c +++ /dev/null @@ -1,3065 +0,0 @@ -/* !!! WARNING WARNING WARNING WARNING WARNING WARNING 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" - -/* Automatically generated binding for virConnectClose. - * In generator.pl this function has signature "conn : free". - */ - -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); -} - -/* Automatically generated binding for virConnectGetHostname. - * In generator.pl this function has signature "conn : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTGETHOSTNAME -extern char *virConnectGetHostname (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_get_hostname (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTGETHOSTNAME - /* Symbol virConnectGetHostname not found at compile time. */ - not_supported ("virConnectGetHostname"); - /* 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; - - NONBLOCKING (r = virConnectGetHostname (conn)); - CHECK_ERROR (!r, conn, "virConnectGetHostname"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectGetURI. - * In generator.pl this function has signature "conn : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTGETURI -extern char *virConnectGetURI (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_get_uri (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTGETURI - /* Symbol virConnectGetURI not found at compile time. */ - not_supported ("virConnectGetURI"); - /* 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; - - NONBLOCKING (r = virConnectGetURI (conn)); - CHECK_ERROR (!r, conn, "virConnectGetURI"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectGetType. - * In generator.pl this function has signature "conn : static string". - */ - -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); -} - -/* Automatically generated binding for virConnectNumOfDomains. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_domains (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDomains (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListDomains. - * In generator.pl this function has signature "conn, int : int array". - */ - -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"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) - Store_field (rv, i, Val_int (ids[i])); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virConnectNumOfDefinedDomains. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_defined_domains (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDefinedDomains (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListDefinedDomains. - * In generator.pl this function has signature "conn, int : string array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_defined_domains (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListDefinedDomains (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains"); - - 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); -} - -/* Automatically generated binding for virConnectNumOfNetworks. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_networks (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfNetworks (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListNetworks. - * In generator.pl this function has signature "conn, int : string array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_networks (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListNetworks (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListNetworks"); - - 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); -} - -/* Automatically generated binding for virConnectNumOfDefinedNetworks. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_defined_networks (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDefinedNetworks (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListDefinedNetworks. - * In generator.pl this function has signature "conn, int : string array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_defined_networks (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListDefinedNetworks (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks"); - - 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); -} - -/* Automatically generated binding for virConnectNumOfStoragePools. - * In generator.pl this function has signature "conn : int". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS -extern int virConnectNumOfStoragePools (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_num_of_storage_pools (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS - /* Symbol virConnectNumOfStoragePools not found at compile time. */ - not_supported ("virConnectNumOfStoragePools"); - /* 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); - int r; - - NONBLOCKING (r = virConnectNumOfStoragePools (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfStoragePools"); - - CAMLreturn (Val_int (r)); -#endif -} - -/* Automatically generated binding for virConnectListStoragePools. - * In generator.pl this function has signature "conn, int : string array". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTLISTSTORAGEPOOLS -extern int virConnectListStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_list_storage_pools (value connv, value iv) -{ - CAMLparam2 (connv, iv); -#ifndef HAVE_VIRCONNECTLISTSTORAGEPOOLS - /* Symbol virConnectListStoragePools not found at compile time. */ - not_supported ("virConnectListStoragePools"); - /* 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 i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListStoragePools (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListStoragePools"); - - 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); -#endif -} - -/* Automatically generated binding for virConnectNumOfDefinedStoragePools. - * In generator.pl this function has signature "conn : int". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS -extern int virConnectNumOfDefinedStoragePools (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_num_of_defined_storage_pools (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS - /* Symbol virConnectNumOfDefinedStoragePools not found at compile time. */ - not_supported ("virConnectNumOfDefinedStoragePools"); - /* 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); - int r; - - NONBLOCKING (r = virConnectNumOfDefinedStoragePools (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedStoragePools"); - - CAMLreturn (Val_int (r)); -#endif -} - -/* Automatically generated binding for virConnectListDefinedStoragePools. - * In generator.pl this function has signature "conn, int : string array". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS -extern int virConnectListDefinedStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv) -{ - CAMLparam2 (connv, iv); -#ifndef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS - /* Symbol virConnectListDefinedStoragePools not found at compile time. */ - not_supported ("virConnectListDefinedStoragePools"); - /* 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); - char *names[i]; - int r; - - 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]); - } - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectGetCapabilities. - * In generator.pl this function has signature "conn : string". - */ - -CAMLprim value -ocaml_libvirt_connect_get_capabilities (value connv) -{ - CAMLparam1 (connv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *r; - - NONBLOCKING (r = virConnectGetCapabilities (conn)); - CHECK_ERROR (!r, conn, "virConnectGetCapabilities"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainCreateLinux. - * In generator.pl this function has signature "conn, string, 0U : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_create_linux (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainCreateLinux (conn, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateLinux"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainCreateLinuxJob. - * In generator.pl this function has signature "conn, string, 0U : job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINCREATELINUXJOB -extern virJobPtr virDomainCreateLinuxJob (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_create_linux_job (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRDOMAINCREATELINUXJOB - /* Symbol virDomainCreateLinuxJob not found at compile time. */ - not_supported ("virDomainCreateLinuxJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainCreateLinuxJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainCreateLinuxJob); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainCreateLinuxJob (conn, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateLinuxJob"); - - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainFree. - * In generator.pl this function has signature "dom : free". - */ - -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); -} - -/* Automatically generated binding for virDomainDestroy. - * In generator.pl this function has signature "dom : free". - */ - -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); -} - -/* Automatically generated binding for virDomainLookupByName. - * In generator.pl this function has signature "conn, string : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_name (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByName (conn, str)); - CHECK_ERROR (!r, conn, "virDomainLookupByName"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainLookupByID. - * In generator.pl this function has signature "conn, int : dom". - */ - -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); -} - -/* Automatically generated binding for virDomainLookupByUUID. - * In generator.pl this function has signature "conn, uuid : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned char *uuid = (unsigned char *) String_val (uuidv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByUUID (conn, uuid)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainLookupByUUIDString. - * In generator.pl this function has signature "conn, string : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByUUIDString (conn, str)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetName. - * In generator.pl this function has signature "dom : static string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_name (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - const char *r; - - NONBLOCKING (r = virDomainGetName (dom)); - CHECK_ERROR (!r, conn, "virDomainGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetOSType. - * In generator.pl this function has signature "dom : string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_os_type (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *r; - - NONBLOCKING (r = virDomainGetOSType (dom)); - CHECK_ERROR (!r, conn, "virDomainGetOSType"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetXMLDesc. - * In generator.pl this function has signature "dom, 0 : string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_xml_desc (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *r; - - NONBLOCKING (r = virDomainGetXMLDesc (dom, 0)); - CHECK_ERROR (!r, conn, "virDomainGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetUUID. - * In generator.pl this function has signature "dom : uuid". - */ - -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"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetUUIDString. - * In generator.pl this function has signature "dom : uuid string". - */ - -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); -} - -/* Automatically generated binding for virDomainGetMaxVcpus. - * In generator.pl this function has signature "dom : int". - */ - -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)); -} - -/* Automatically generated binding for virDomainSave. - * In generator.pl this function has signature "dom, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_save (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainSave (dom, str)); - CHECK_ERROR (r == -1, conn, "virDomainSave"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainSaveJob. - * In generator.pl this function has signature "dom, string : job from dom". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINSAVEJOB -extern virJobPtr virDomainSaveJob (virDomainPtr dom, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_save_job (value domv, value strv) -{ - CAMLparam2 (domv, strv); -#ifndef HAVE_VIRDOMAINSAVEJOB - /* Symbol virDomainSaveJob not found at compile time. */ - not_supported ("virDomainSaveJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainSaveJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainSaveJob); - - CAMLlocal2 (rv, connv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainSaveJob (dom, str)); - CHECK_ERROR (!r, conn, "virDomainSaveJob"); - - connv = Field (domv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainRestore. - * In generator.pl this function has signature "conn, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_restore (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainRestore (conn, str)); - CHECK_ERROR (r == -1, conn, "virDomainRestore"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainRestoreJob. - * In generator.pl this function has signature "conn, string : job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINRESTOREJOB -extern virJobPtr virDomainRestoreJob (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_restore_job (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRDOMAINRESTOREJOB - /* Symbol virDomainRestoreJob not found at compile time. */ - not_supported ("virDomainRestoreJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainRestoreJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainRestoreJob); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainRestoreJob (conn, str)); - CHECK_ERROR (!r, conn, "virDomainRestoreJob"); - - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainCoreDump. - * In generator.pl this function has signature "dom, string, 0 : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_core_dump (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainCoreDump (dom, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCoreDump"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainCoreDumpJob. - * In generator.pl this function has signature "dom, string, 0 : job from dom". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINCOREDUMPJOB -extern virJobPtr virDomainCoreDumpJob (virDomainPtr dom, const char *str, int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_core_dump_job (value domv, value strv) -{ - CAMLparam2 (domv, strv); -#ifndef HAVE_VIRDOMAINCOREDUMPJOB - /* Symbol virDomainCoreDumpJob not found at compile time. */ - not_supported ("virDomainCoreDumpJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainCoreDumpJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainCoreDumpJob); - - CAMLlocal2 (rv, connv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainCoreDumpJob (dom, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCoreDumpJob"); - - connv = Field (domv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainSuspend. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_suspend (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainSuspend (dom)); - CHECK_ERROR (r == -1, conn, "virDomainSuspend"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainResume. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_resume (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainResume (dom)); - CHECK_ERROR (r == -1, conn, "virDomainResume"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainShutdown. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_shutdown (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainShutdown (dom)); - CHECK_ERROR (r == -1, conn, "virDomainShutdown"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainReboot. - * In generator.pl this function has signature "dom, 0 : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_reboot (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainReboot (dom, 0)); - CHECK_ERROR (r == -1, conn, "virDomainReboot"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainDefineXML. - * In generator.pl this function has signature "conn, string : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_define_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainDefineXML (conn, str)); - CHECK_ERROR (!r, conn, "virDomainDefineXML"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainUndefine. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_undefine (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainUndefine (dom)); - CHECK_ERROR (r == -1, conn, "virDomainUndefine"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainCreate. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_create (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainCreate (dom)); - CHECK_ERROR (r == -1, conn, "virDomainCreate"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainCreateJob. - * In generator.pl this function has signature "dom, 0U : job from dom". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINCREATEJOB -extern virJobPtr virDomainCreateJob (virDomainPtr dom, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_create_job (value domv) -{ - CAMLparam1 (domv); -#ifndef HAVE_VIRDOMAINCREATEJOB - /* Symbol virDomainCreateJob not found at compile time. */ - not_supported ("virDomainCreateJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainCreateJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainCreateJob); - - CAMLlocal2 (rv, connv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - virJobPtr r; - - NONBLOCKING (r = virDomainCreateJob (dom, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateJob"); - - connv = Field (domv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainAttachDevice. - * In generator.pl this function has signature "dom, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_attach_device (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainAttachDevice (dom, str)); - CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainDetachDevice. - * In generator.pl this function has signature "dom, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_detach_device (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainDetachDevice (dom, str)); - CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainGetAutostart. - * In generator.pl this function has signature "dom : bool". - */ - -CAMLprim value -ocaml_libvirt_domain_get_autostart (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, b; - - NONBLOCKING (r = virDomainGetAutostart (dom, &b)); - CHECK_ERROR (r == -1, conn, "virDomainGetAutostart"); - - CAMLreturn (b ? Val_true : Val_false); -} - -/* Automatically generated binding for virDomainSetAutostart. - * In generator.pl this function has signature "dom, bool : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_set_autostart (value domv, value bv) -{ - CAMLparam2 (domv, bv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = virDomainSetAutostart (dom, b)); - CHECK_ERROR (r == -1, conn, "virDomainSetAutostart"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virNetworkFree. - * In generator.pl this function has signature "net : free". - */ - -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); -} - -/* Automatically generated binding for virNetworkDestroy. - * In generator.pl this function has signature "net : free". - */ - -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); -} - -/* Automatically generated binding for virNetworkLookupByName. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_lookup_by_name (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByName (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkLookupByName"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkLookupByUUID. - * In generator.pl this function has signature "conn, uuid : net". - */ - -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned char *uuid = (unsigned char *) String_val (uuidv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByUUID (conn, uuid)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkLookupByUUIDString. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid_string (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByUUIDString (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetName. - * In generator.pl this function has signature "net : static string". - */ - -CAMLprim value -ocaml_libvirt_network_get_name (value netv) -{ - 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); -} - -/* Automatically generated binding for virNetworkGetXMLDesc. - * In generator.pl this function has signature "net, 0 : string". - */ - -CAMLprim value -ocaml_libvirt_network_get_xml_desc (value netv) -{ - 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); -} - -/* Automatically generated binding for virNetworkGetBridgeName. - * In generator.pl this function has signature "net : string". - */ - -CAMLprim value -ocaml_libvirt_network_get_bridge_name (value netv) -{ - 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); -} - -/* Automatically generated binding for virNetworkGetUUID. - * In generator.pl this function has signature "net : uuid". - */ - -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"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetUUIDString. - * In generator.pl this function has signature "net : uuid string". - */ - -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); -} - -/* Automatically generated binding for virNetworkUndefine. - * In generator.pl this function has signature "net : unit". - */ - -CAMLprim value -ocaml_libvirt_network_undefine (value netv) -{ - 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); -} - -/* Automatically generated binding for virNetworkCreateXML. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_create_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkCreateXML (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkCreateXML"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkCreateXMLJob. - * In generator.pl this function has signature "conn, string : job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNETWORKCREATEXMLJOB -extern virJobPtr virNetworkCreateXMLJob (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_network_create_xml_job (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRNETWORKCREATEXMLJOB - /* Symbol virNetworkCreateXMLJob not found at compile time. */ - not_supported ("virNetworkCreateXMLJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virNetworkCreateXMLJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virNetworkCreateXMLJob); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virNetworkCreateXMLJob (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkCreateXMLJob"); - - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virNetworkDefineXML. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_define_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkDefineXML (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkDefineXML"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkCreate. - * In generator.pl this function has signature "net : unit". - */ - -CAMLprim value -ocaml_libvirt_network_create (value netv) -{ - 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); -} - -/* Automatically generated binding for virNetworkCreateJob. - * In generator.pl this function has signature "net : job from net". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNETWORKCREATEJOB -extern virJobPtr virNetworkCreateJob (virNetworkPtr net) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_network_create_job (value netv) -{ - CAMLparam1 (netv); -#ifndef HAVE_VIRNETWORKCREATEJOB - /* Symbol virNetworkCreateJob not found at compile time. */ - not_supported ("virNetworkCreateJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virNetworkCreateJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virNetworkCreateJob); - - CAMLlocal2 (rv, connv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - virJobPtr r; - - NONBLOCKING (r = virNetworkCreateJob (net)); - CHECK_ERROR (!r, conn, "virNetworkCreateJob"); - - connv = Field (netv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virNetworkGetAutostart. - * In generator.pl this function has signature "net : bool". - */ - -CAMLprim value -ocaml_libvirt_network_get_autostart (value netv) -{ - CAMLparam1 (netv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r, b; - - NONBLOCKING (r = virNetworkGetAutostart (net, &b)); - CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart"); - - CAMLreturn (b ? Val_true : Val_false); -} - -/* Automatically generated binding for virNetworkSetAutostart. - * In generator.pl this function has signature "net, bool : unit". - */ - -CAMLprim value -ocaml_libvirt_network_set_autostart (value netv, value bv) -{ - CAMLparam2 (netv, bv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = virNetworkSetAutostart (net, b)); - CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virStoragePoolFree. - * In generator.pl this function has signature "pool : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLFREE -extern int virStoragePoolFree (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_free (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLFREE - /* Symbol virStoragePoolFree not found at compile time. */ - not_supported ("virStoragePoolFree"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolFree); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolFree (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolFree"); - - /* So that we don't double-free in the finalizer: */ - Pool_val (poolv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolDestroy. - * In generator.pl this function has signature "pool : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDESTROY -extern int virStoragePoolDestroy (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_destroy (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLDESTROY - /* Symbol virStoragePoolDestroy not found at compile time. */ - not_supported ("virStoragePoolDestroy"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolDestroy - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDestroy); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolDestroy (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolDestroy"); - - /* So that we don't double-free in the finalizer: */ - Pool_val (poolv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByName. - * In generator.pl this function has signature "conn, string : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME -extern virStoragePoolPtr virStoragePoolLookupByName (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME - /* Symbol virStoragePoolLookupByName not found at compile time. */ - not_supported ("virStoragePoolLookupByName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByName); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByName (conn, str)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByName"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByUUID. - * In generator.pl this function has signature "conn, uuid : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID -extern virStoragePoolPtr virStoragePoolLookupByUUID (virConnectPtr conn, const unsigned char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID - /* Symbol virStoragePoolLookupByUUID not found at compile time. */ - not_supported ("virStoragePoolLookupByUUID"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByUUID - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUID); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned char *uuid = (unsigned char *) String_val (uuidv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByUUID (conn, uuid)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByUUID"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByUUIDString. - * In generator.pl this function has signature "conn, string : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING -extern virStoragePoolPtr virStoragePoolLookupByUUIDString (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_uuid_string (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING - /* Symbol virStoragePoolLookupByUUIDString not found at compile time. */ - not_supported ("virStoragePoolLookupByUUIDString"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByUUIDString - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUIDString); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByUUIDString (conn, str)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByUUIDString"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetName. - * In generator.pl this function has signature "pool : static string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETNAME -extern const char *virStoragePoolGetName (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_name (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETNAME - /* Symbol virStoragePoolGetName not found at compile time. */ - not_supported ("virStoragePoolGetName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetName); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - const char *r; - - NONBLOCKING (r = virStoragePoolGetName (pool)); - CHECK_ERROR (!r, conn, "virStoragePoolGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetXMLDesc. - * In generator.pl this function has signature "pool, 0U : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETXMLDESC -extern char *virStoragePoolGetXMLDesc (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_xml_desc (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETXMLDESC - /* Symbol virStoragePoolGetXMLDesc not found at compile time. */ - not_supported ("virStoragePoolGetXMLDesc"); - /* 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); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char *r; - - NONBLOCKING (r = virStoragePoolGetXMLDesc (pool, 0)); - CHECK_ERROR (!r, conn, "virStoragePoolGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetUUID. - * In generator.pl this function has signature "pool : uuid". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETUUID -extern int virStoragePoolGetUUID (virStoragePoolPtr pool, unsigned char *) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_uuid (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETUUID - /* Symbol virStoragePoolGetUUID not found at compile time. */ - not_supported ("virStoragePoolGetUUID"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetUUID - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetUUID); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = virStoragePoolGetUUID (pool, uuid)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetUUID"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetUUIDString. - * In generator.pl this function has signature "pool : uuid string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETUUIDSTRING -extern int virStoragePoolGetUUIDString (virStoragePoolPtr pool, char *) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_uuid_string (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETUUIDSTRING - /* Symbol virStoragePoolGetUUIDString not found at compile time. */ - not_supported ("virStoragePoolGetUUIDString"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetUUIDString - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetUUIDString); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = virStoragePoolGetUUIDString (pool, uuid)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetUUIDString"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolCreateXML. - * In generator.pl this function has signature "conn, string, 0U : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLCREATEXML -extern virStoragePoolPtr virStoragePoolCreateXML (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_create_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLCREATEXML - /* Symbol virStoragePoolCreateXML not found at compile time. */ - not_supported ("virStoragePoolCreateXML"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolCreateXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolCreateXML); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolCreateXML (conn, str, 0)); - CHECK_ERROR (!r, conn, "virStoragePoolCreateXML"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolDefineXML. - * In generator.pl this function has signature "conn, string, 0U : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDEFINEXML -extern virStoragePoolPtr virStoragePoolDefineXML (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_define_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLDEFINEXML - /* Symbol virStoragePoolDefineXML not found at compile time. */ - not_supported ("virStoragePoolDefineXML"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolDefineXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDefineXML); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolDefineXML (conn, str, 0)); - CHECK_ERROR (!r, conn, "virStoragePoolDefineXML"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolBuild. - * In generator.pl this function has signature "pool, uint : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLBUILD -extern int virStoragePoolBuild (virStoragePoolPtr pool, unsigned int i) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_build (value poolv, value iv) -{ - CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLBUILD - /* Symbol virStoragePoolBuild not found at compile time. */ - not_supported ("virStoragePoolBuild"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolBuild - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolBuild); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - unsigned int i = Int_val (iv); - int r; - - NONBLOCKING (r = virStoragePoolBuild (pool, i)); - CHECK_ERROR (!r, conn, "virStoragePoolBuild"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolUndefine. - * In generator.pl this function has signature "pool : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLUNDEFINE -extern int virStoragePoolUndefine (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_undefine (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLUNDEFINE - /* Symbol virStoragePoolUndefine not found at compile time. */ - not_supported ("virStoragePoolUndefine"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolUndefine - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolUndefine); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolUndefine (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolUndefine"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolCreate. - * In generator.pl this function has signature "pool, 0U : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLCREATE -extern int virStoragePoolCreate (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_create (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLCREATE - /* Symbol virStoragePoolCreate not found at compile time. */ - not_supported ("virStoragePoolCreate"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolCreate - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolCreate); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolCreate (pool, 0)); - CHECK_ERROR (r == -1, conn, "virStoragePoolCreate"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolDelete. - * In generator.pl this function has signature "pool, uint : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDELETE -extern int virStoragePoolDelete (virStoragePoolPtr pool, unsigned int i) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_delete (value poolv, value iv) -{ - CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLDELETE - /* Symbol virStoragePoolDelete not found at compile time. */ - not_supported ("virStoragePoolDelete"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolDelete - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDelete); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - unsigned int i = Int_val (iv); - int r; - - NONBLOCKING (r = virStoragePoolDelete (pool, i)); - CHECK_ERROR (!r, conn, "virStoragePoolDelete"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolRefresh. - * In generator.pl this function has signature "pool, 0U : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLREFRESH -extern int virStoragePoolRefresh (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_refresh (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLREFRESH - /* Symbol virStoragePoolRefresh not found at compile time. */ - not_supported ("virStoragePoolRefresh"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolRefresh - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolRefresh); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolRefresh (pool, 0)); - CHECK_ERROR (r == -1, conn, "virStoragePoolRefresh"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolGetAutostart. - * In generator.pl this function has signature "pool : bool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETAUTOSTART -extern int virStoragePoolGetAutostart (virStoragePoolPtr pool, int *r) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_autostart (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETAUTOSTART - /* Symbol virStoragePoolGetAutostart not found at compile time. */ - not_supported ("virStoragePoolGetAutostart"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetAutostart - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetAutostart); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r, b; - - NONBLOCKING (r = virStoragePoolGetAutostart (pool, &b)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetAutostart"); - - CAMLreturn (b ? Val_true : Val_false); -#endif -} - -/* Automatically generated binding for virStoragePoolSetAutostart. - * In generator.pl this function has signature "pool, bool : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLSETAUTOSTART -extern int virStoragePoolSetAutostart (virStoragePoolPtr pool, int b) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv) -{ - CAMLparam2 (poolv, bv); -#ifndef HAVE_VIRSTORAGEPOOLSETAUTOSTART - /* Symbol virStoragePoolSetAutostart not found at compile time. */ - not_supported ("virStoragePoolSetAutostart"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolSetAutostart - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolSetAutostart); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = virStoragePoolSetAutostart (pool, b)); - CHECK_ERROR (r == -1, conn, "virStoragePoolSetAutostart"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolNumOfVolumes. - * In generator.pl this function has signature "pool : int". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES -extern int virStoragePoolNumOfVolumes (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_num_of_volumes (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES - /* Symbol virStoragePoolNumOfVolumes not found at compile time. */ - not_supported ("virStoragePoolNumOfVolumes"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolNumOfVolumes - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolNumOfVolumes); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolNumOfVolumes (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolNumOfVolumes"); - - CAMLreturn (Val_int (r)); -#endif -} - -/* Automatically generated binding for virStoragePoolListVolumes. - * In generator.pl this function has signature "pool, int : string array". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLISTVOLUMES -extern int virStoragePoolListVolumes (virStoragePoolPtr pool, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_list_volumes (value poolv, value iv) -{ - CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLLISTVOLUMES - /* Symbol virStoragePoolListVolumes not found at compile time. */ - not_supported ("virStoragePoolListVolumes"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolListVolumes - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolListVolumes); - - CAMLlocal2 (rv, strv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virStoragePoolListVolumes (pool, names, i)); - CHECK_ERROR (r == -1, conn, "virStoragePoolListVolumes"); - - 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); -#endif -} - -/* Automatically generated binding for virStorageVolFree. - * In generator.pl this function has signature "vol : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLFREE -extern int virStorageVolFree (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_free (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLFREE - /* Symbol virStorageVolFree not found at compile time. */ - not_supported ("virStorageVolFree"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolFree); - - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - int r; - - NONBLOCKING (r = virStorageVolFree (vol)); - CHECK_ERROR (r == -1, conn, "virStorageVolFree"); - - /* So that we don't double-free in the finalizer: */ - Volume_val (volv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStorageVolDelete. - * In generator.pl this function has signature "vol, uint : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLDELETE -extern int virStorageVolDelete (virStorageVolPtr vol, unsigned int i) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_delete (value volv, value iv) -{ - CAMLparam2 (volv, iv); -#ifndef HAVE_VIRSTORAGEVOLDELETE - /* Symbol virStorageVolDelete not found at compile time. */ - not_supported ("virStorageVolDelete"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolDelete - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolDelete); - - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - unsigned int i = Int_val (iv); - int r; - - NONBLOCKING (r = virStorageVolDelete (vol, i)); - CHECK_ERROR (!r, conn, "virStorageVolDelete"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStorageVolLookupByName. - * In generator.pl this function has signature "pool, string : vol from pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYNAME -extern virStorageVolPtr virStorageVolLookupByName (virStoragePoolPtr pool, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_lookup_by_name (value poolv, value strv) -{ - CAMLparam2 (poolv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYNAME - /* Symbol virStorageVolLookupByName not found at compile time. */ - not_supported ("virStorageVolLookupByName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolLookupByName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByName); - - CAMLlocal2 (rv, connv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolLookupByName (pool, str)); - CHECK_ERROR (!r, conn, "virStorageVolLookupByName"); - - connv = Field (poolv, 1); - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolLookupByKey. - * In generator.pl this function has signature "conn, string : vol". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYKEY -extern virStorageVolPtr virStorageVolLookupByKey (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_lookup_by_key (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYKEY - /* Symbol virStorageVolLookupByKey not found at compile time. */ - not_supported ("virStorageVolLookupByKey"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolLookupByKey - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByKey); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolLookupByKey (conn, str)); - CHECK_ERROR (!r, conn, "virStorageVolLookupByKey"); - - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolLookupByPath. - * In generator.pl this function has signature "conn, string : vol". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYPATH -extern virStorageVolPtr virStorageVolLookupByPath (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_lookup_by_path (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYPATH - /* Symbol virStorageVolLookupByPath not found at compile time. */ - not_supported ("virStorageVolLookupByPath"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolLookupByPath - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByPath); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolLookupByPath (conn, str)); - CHECK_ERROR (!r, conn, "virStorageVolLookupByPath"); - - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolCreateXML. - * In generator.pl this function has signature "pool, string, 0U : vol from pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLCREATEXML -extern virStorageVolPtr virStorageVolCreateXML (virStoragePoolPtr pool, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_create_xml (value poolv, value strv) -{ - CAMLparam2 (poolv, strv); -#ifndef HAVE_VIRSTORAGEVOLCREATEXML - /* Symbol virStorageVolCreateXML not found at compile time. */ - not_supported ("virStorageVolCreateXML"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolCreateXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolCreateXML); - - CAMLlocal2 (rv, connv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolCreateXML (pool, str, 0)); - CHECK_ERROR (!r, conn, "virStorageVolCreateXML"); - - connv = Field (poolv, 1); - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetXMLDesc. - * In generator.pl this function has signature "vol, 0U : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETXMLDESC -extern char *virStorageVolGetXMLDesc (virStorageVolPtr vol, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_xml_desc (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETXMLDESC - /* Symbol virStorageVolGetXMLDesc not found at compile time. */ - not_supported ("virStorageVolGetXMLDesc"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetXMLDesc - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetXMLDesc); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - char *r; - - NONBLOCKING (r = virStorageVolGetXMLDesc (vol, 0)); - CHECK_ERROR (!r, conn, "virStorageVolGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetPath. - * In generator.pl this function has signature "vol : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETPATH -extern char *virStorageVolGetPath (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_path (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETPATH - /* Symbol virStorageVolGetPath not found at compile time. */ - not_supported ("virStorageVolGetPath"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetPath - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetPath); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - char *r; - - NONBLOCKING (r = virStorageVolGetPath (vol)); - CHECK_ERROR (!r, conn, "virStorageVolGetPath"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetKey. - * In generator.pl this function has signature "vol : static string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETKEY -extern const char *virStorageVolGetKey (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_key (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETKEY - /* Symbol virStorageVolGetKey not found at compile time. */ - not_supported ("virStorageVolGetKey"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetKey - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetKey); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - const char *r; - - NONBLOCKING (r = virStorageVolGetKey (vol)); - CHECK_ERROR (!r, conn, "virStorageVolGetKey"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetName. - * In generator.pl this function has signature "vol : static string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETNAME -extern const char *virStorageVolGetName (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_name (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETNAME - /* Symbol virStorageVolGetName not found at compile time. */ - not_supported ("virStorageVolGetName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetName); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - const char *r; - - NONBLOCKING (r = virStorageVolGetName (vol)); - CHECK_ERROR (!r, conn, "virStorageVolGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByVolume. - * In generator.pl this function has signature "vol : pool from vol". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME -extern virStoragePoolPtr virStoragePoolLookupByVolume (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_volume (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME - /* Symbol virStoragePoolLookupByVolume not found at compile time. */ - not_supported ("virStoragePoolLookupByVolume"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByVolume - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByVolume); - - CAMLlocal2 (rv, connv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByVolume (vol)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByVolume"); - - connv = Field (volv, 1); - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virJobFree. - * In generator.pl this function has signature "job : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBFREE -extern int virJobFree (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_free (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBFREE - /* Symbol virJobFree not found at compile time. */ - not_supported ("virJobFree"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobFree); - - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - int r; - - NONBLOCKING (r = virJobFree (job)); - CHECK_ERROR (r == -1, conn, "virJobFree"); - - /* So that we don't double-free in the finalizer: */ - Job_val (jobv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virJobCancel. - * In generator.pl this function has signature "job : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBCANCEL -extern int virJobCancel (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_cancel (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBCANCEL - /* Symbol virJobCancel not found at compile time. */ - not_supported ("virJobCancel"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobCancel - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobCancel); - - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - int r; - - NONBLOCKING (r = virJobCancel (job)); - CHECK_ERROR (r == -1, conn, "virJobCancel"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virJobGetNetwork. - * In generator.pl this function has signature "job : net from job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBGETNETWORK -extern virNetworkPtr virJobGetNetwork (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_get_network (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBGETNETWORK - /* Symbol virJobGetNetwork not found at compile time. */ - not_supported ("virJobGetNetwork"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobGetNetwork - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobGetNetwork); - - CAMLlocal2 (rv, connv); - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - virNetworkPtr r; - - NONBLOCKING (r = virJobGetNetwork (job)); - CHECK_ERROR (!r, conn, "virJobGetNetwork"); - - connv = Field (jobv, 1); - rv = Val_network (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virJobGetDomain. - * In generator.pl this function has signature "job : dom from job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBGETDOMAIN -extern virDomainPtr virJobGetDomain (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_get_domain (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBGETDOMAIN - /* Symbol virJobGetDomain not found at compile time. */ - not_supported ("virJobGetDomain"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobGetDomain - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobGetDomain); - - CAMLlocal2 (rv, connv); - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - virDomainPtr r; - - NONBLOCKING (r = virJobGetDomain (job)); - CHECK_ERROR (!r, conn, "virJobGetDomain"); - - connv = Field (jobv, 1); - rv = Val_domain (r, connv); - - CAMLreturn (rv); -#endif -} - -#include "libvirt_c_epilogue.c" - -/* EOF */ diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c deleted file mode 100644 index 78bd23e..0000000 --- a/libvirt/libvirt_c_epilogue.c +++ /dev/null @@ -1,548 +0,0 @@ -/* 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 50 /* VIR_ERR_NO_STORAGE_VOL */ -#define MAX_VIR_DOMAIN 17 /* VIR_FROM_STORAGE */ -#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 -#ifdef HAVE_VIRJOBPTR -static void jb_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 - -#ifdef HAVE_VIRJOBPTR -static struct custom_operations jb_custom_operations = { - "jb_custom_operations", - jb_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; -#endif - -static value -Val_connect (virConnectPtr conn) -{ - 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 vol) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&vol_custom_operations, - sizeof (virStorageVolPtr), 0, 1); - Vol_val (rv) = vol; - CAMLreturn (rv); -} -#endif - -#ifdef HAVE_VIRJOBPTR -static value -Val_jb (virJobPtr jb) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&jb_custom_operations, - sizeof (virJobPtr), 0, 1); - Jb_val (rv) = jb; - CAMLreturn (rv); -} -#endif - -/* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use - * by virterror wrappers. - */ -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 - -#ifdef HAVE_VIRJOBPTR -/* This wraps up the (jb, conn) pair (Job.t). */ -static value -Val_job (virJobPtr jb, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_jb (jb); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} -#endif - -/* No-finalize versions of Val_domain, Val_network ONLY for use by - * virterror wrappers. - */ -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 - -#ifdef HAVE_VIRJOBPTR -static void -jb_finalize (value jbv) -{ - virJobPtr jb = Jb_val (jbv); - if (jb) (void) virJobFree (jb); -} -#endif diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c deleted file mode 100644 index 5df783e..0000000 --- a/libvirt/libvirt_c_oneoffs.c +++ /dev/null @@ -1,822 +0,0 @@ -/* 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. */ - -/*----------------------------------------------------------------------*/ - -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_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); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNODEGETFREEMEMORY -extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_node_get_free_memory (value connv) -{ -#ifdef HAVE_VIRNODEGETFREEMEMORY - CAMLparam1 (connv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned long long r; - - WEAK_SYMBOL_CHECK (virNodeGetFreeMemory); - NONBLOCKING (r = virNodeGetFreeMemory (conn)); - CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory"); - - rv = caml_copy_int64 ((int64) r); - CAMLreturn (rv); -#else - not_supported ("virNodeGetFreeMemory"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY -extern int virNodeGetCellsFreeMemory (virConnectPtr conn, - unsigned long long *freeMems, - int startCell, int maxCells) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_node_get_cells_free_memory (value connv, - value startv, value maxv) -{ -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY - CAMLparam3 (connv, startv, maxv); - CAMLlocal2 (rv, iv); - virConnectPtr conn = Connect_val (connv); - 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_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); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE -extern char *virDomainGetSchedulerType(virDomainPtr domain, - int *nparams) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_get_scheduler_type (value domv) -{ -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE - CAMLparam1 (domv); - CAMLlocal2 (rv, strv); - virDomainPtr dom = Domain_val (domv); - 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 -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS -extern int virDomainGetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int *nparams) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv) -{ -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS - CAMLparam2 (domv, nparamsv); - CAMLlocal4 (rv, v, v2, v3); - virDomainPtr dom = Domain_val (domv); - 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 -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS -extern int virDomainSetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int nparams) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) -{ -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS - CAMLparam2 (domv, paramsv); - CAMLlocal1 (v); - virDomainPtr dom = Domain_val (domv); - 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_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); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINMIGRATE -extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn, - unsigned long flags, const char *dname, - const char *uri, unsigned long bandwidth) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) -{ -#ifdef HAVE_VIRDOMAINMIGRATE - CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv); - CAMLxparam2 (optbandwidthv, unitv); - CAMLlocal2 (flagv, rv); - 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]); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINBLOCKSTATS -extern int virDomainBlockStats (virDomainPtr dom, - const char *path, - virDomainBlockStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_block_stats (value domv, value pathv) -{ -#if HAVE_VIRDOMAINBLOCKSTATS - CAMLparam2 (domv, pathv); - CAMLlocal2 (rv,v); - virDomainPtr dom = Domain_val (domv); - 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 -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAININTERFACESTATS -extern int virDomainInterfaceStats (virDomainPtr dom, - const char *path, - virDomainInterfaceStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_interface_stats (value domv, value pathv) -{ -#if HAVE_VIRDOMAININTERFACESTATS - CAMLparam2 (domv, pathv); - CAMLlocal2 (rv,v); - virDomainPtr dom = Domain_val (domv); - 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 -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETINFO -extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_info (value poolv) -{ -#if HAVE_VIRSTORAGEPOOLGETINFO - CAMLparam1 (poolv); - CAMLlocal2 (rv, v); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - virStoragePoolInfo info; - int r; - - WEAK_SYMBOL_CHECK (virStoragePoolGetInfo); - NONBLOCKING (r = virStoragePoolGetInfo (pool, &info)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo"); - - rv = caml_alloc (4, 0); - Store_field (rv, 0, Val_int (info.state)); - v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v); - v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v); - v = caml_copy_int64 (info.available); Store_field (rv, 3, v); - - CAMLreturn (rv); -#else - not_supported ("virStoragePoolGetInfo"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETINFO -extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_info (value volv) -{ -#if HAVE_VIRSTORAGEVOLGETINFO - CAMLparam1 (volv); - CAMLlocal2 (rv, v); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - virStorageVolInfo info; - int r; - - WEAK_SYMBOL_CHECK (virStorageVolGetInfo); - NONBLOCKING (r = virStorageVolGetInfo (vol, &info)); - CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo"); - - rv = caml_alloc (3, 0); - Store_field (rv, 0, Val_int (info.type)); - v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v); - v = caml_copy_int64 (info.allocation); Store_field (rv, 1, v); - - CAMLreturn (rv); -#else - not_supported ("virStorageVolGetInfo"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBGETINFO -extern int virJobGetInfo(virJobPtr job, virJobInfoPtr info) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_get_info (value jobv) -{ -#if HAVE_VIRJOBGETINFO - CAMLparam1 (jobv); - CAMLlocal1 (rv); - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - virJobInfo info; - int r; - - WEAK_SYMBOL_CHECK (virJobGetInfo); - NONBLOCKING (r = virJobGetInfo (job, &info)); - CHECK_ERROR (r == -1, conn, "virJobGetInfo"); - - rv = caml_alloc (5, 0); - Store_field (rv, 0, Val_int (info.type)); - Store_field (rv, 1, Val_int (info.state)); - Store_field (rv, 2, Val_int (info.runningTime)); - Store_field (rv, 3, Val_int (info.remainingTime)); - Store_field (rv, 4, Val_int (info.percentComplete)); - - CAMLreturn (rv); -#else - not_supported ("virJobGetInfo"); -#endif -} - -/*----------------------------------------------------------------------*/ - -CAMLprim value -ocaml_libvirt_virterror_get_last_error (value unitv) -{ - CAMLparam1 (unitv); - CAMLlocal1 (rv); - virErrorPtr err = virGetLastError (); - - rv = Val_opt (err, (Val_ptr_t) Val_virterror); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_virterror_get_last_conn_error (value connv) -{ - CAMLparam1 (connv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - - rv = Val_opt (conn, (Val_ptr_t) Val_connect); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_virterror_reset_last_error (value unitv) -{ - CAMLparam1 (unitv); - virResetLastError (); - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_virterror_reset_last_conn_error (value connv) -{ - CAMLparam1 (connv); - virConnectPtr conn = Connect_val (connv); - virConnResetLastError (conn); - CAMLreturn (Val_unit); -} - -/*----------------------------------------------------------------------*/ - -/* Initialise the library. */ -CAMLprim value -ocaml_libvirt_init (value unit) -{ - CAMLparam1 (unit); - CAMLlocal1 (rv); - int r; - - r = virInitialize (); - CHECK_ERROR (r == -1, NULL, "virInitialize"); - - CAMLreturn (Val_unit); -} diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c deleted file mode 100644 index 7fe9714..0000000 --- a/libvirt/libvirt_c_prologue.c +++ /dev/null @@ -1,191 +0,0 @@ -/* 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. And jobs. - */ - -/* 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 -#ifdef HAVE_VIRJOBPTR -#define Jb_val(rv) (*((virJobPtr *)Data_custom_val(rv))) -#endif - -/* Wrap up a pointer to something in a custom block. */ -static value Val_connect (virConnectPtr conn); -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 -#ifdef HAVE_VIRJOBPTR -static value Val_jb (virJobPtr jb); -#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 -#ifdef HAVE_VIRJOBPTR -#define Job_val(rv) (Jb_val(Field((rv),0))) -#endif -#define Connect_domv(rv) (Connect_val(Field((rv),1))) -#define Connect_netv(rv) (Connect_val(Field((rv),1))) -#ifdef HAVE_VIRSTORAGEPOOLPTR -#define Connect_polv(rv) (Connect_val(Field((rv),1))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -#define Connect_volv(rv) (Connect_val(Field((rv),1))) -#endif -#ifdef HAVE_VIRJOBPTR -#define Connect_jobv(rv) (Connect_val(Field((rv),1))) -#endif - -static value Val_domain (virDomainPtr dom, value connv); -static value Val_network (virNetworkPtr net, value connv); -#ifdef HAVE_VIRSTORAGEPOOLPTR -static value Val_pool (virStoragePoolPtr pol, value connv); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -static value Val_volume (virStorageVolPtr vol, value connv); -#endif -#ifdef HAVE_VIRJOBPTR -static value Val_job (virJobPtr jb, value connv); -#endif - -/* ONLY for use by virterror wrappers. */ -static value Val_domain_no_finalize (virDomainPtr dom, value connv); -static value Val_network_no_finalize (virNetworkPtr net, value connv); diff --git a/libvirt/libvirt_version.ml.in b/libvirt/libvirt_version.ml.in deleted file mode 100755 index ef7aea5..0000000 --- a/libvirt/libvirt_version.ml.in +++ /dev/null @@ -1,21 +0,0 @@ -(* Helper module containing the version of the OCaml bindings. - (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 - *) - -let package = "@PACKAGE_NAME@" -let version = "@PACKAGE_VERSION@" diff --git a/libvirt/libvirt_version.mli b/libvirt/libvirt_version.mli deleted file mode 100755 index b1755ba..0000000 --- a/libvirt/libvirt_version.mli +++ /dev/null @@ -1,25 +0,0 @@ -(** 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 -*) - -val package : string -val version : string -(** The name and version of the OCaml libvirt bindings. - - (To get the version of libvirt C library itself - use {!Libvirt.get_version}). *) |